From: Harald Anlauf <anlauf@gmx.de>
Date: Tue, 24 Jun 2025 18:46:38 +0000 (+0200)
Subject: Fortran: fix ICE in verify_gimple_in_seq with substrings [PR120743]
X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=5bc92717b804483a17dd5095f8b6d4fd75a472b1;p=thirdparty%2Fgcc.git

Fortran: fix ICE in verify_gimple_in_seq with substrings [PR120743]

	PR fortran/120743

gcc/fortran/ChangeLog:

	* trans-expr.cc (gfc_conv_substring): Substring indices are of
	type gfc_charlen_type_node.  Convert to size_type_node for
	pointer arithmetic only after offset adjustments have been made.

gcc/testsuite/ChangeLog:

	* gfortran.dg/pr120743.f90: New test.

Co-authored-by: Jerry DeLisle <jvdelisle@gcc.gnu.org>
Co-authored-by: Mikael Morin <mikael@gcc.gnu.org>
---

diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index c8a207609e4..3e0d763d2fb 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -2800,8 +2800,9 @@ gfc_conv_substring (gfc_se * se, gfc_ref * ref, int kind,
       else if (POINTER_TYPE_P (TREE_TYPE (tmp)))
 	{
 	  tree diff;
-	  diff = fold_build2 (MINUS_EXPR, size_type_node, start.expr,
-			      build_one_cst (size_type_node));
+	  diff = fold_build2 (MINUS_EXPR, gfc_charlen_type_node, start.expr,
+			      build_one_cst (gfc_charlen_type_node));
+	  diff = fold_convert (size_type_node, diff);
 	  se->expr
 	    = fold_build2 (POINTER_PLUS_EXPR, TREE_TYPE (tmp), tmp, diff);
 	}
diff --git a/gcc/testsuite/gfortran.dg/pr120743.f90 b/gcc/testsuite/gfortran.dg/pr120743.f90
new file mode 100644
index 00000000000..8682d0c8859
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr120743.f90
@@ -0,0 +1,38 @@
+! { dg-do compile }
+! PR fortran/120743 - ICE in verify_gimple_in_seq with substrings
+!
+! Testcase as reduced by Jerry DeLisle 
+
+module what
+  implicit none
+  CHARACTER(LEN=:), ALLOCATABLE :: attrlist
+contains
+  SUBROUTINE get_c_attr ( attrname, attrval_c )
+    !
+    ! returns attrval_c='' if not found
+    !
+    IMPLICIT NONE
+    CHARACTER(LEN=*), INTENT(IN) :: attrname
+    CHARACTER(LEN=*), INTENT(OUT) :: attrval_c
+    !
+    CHARACTER(LEN=1) :: quote
+    INTEGER :: j0, j1
+    LOGICAL :: found
+    !
+    ! search for attribute name in attrlist: attr1="val1" attr2="val2" ...
+    !
+    attrval_c = ''
+    if ( .not. allocated(attrlist) ) return
+    if ( len_trim(attrlist) < 1 ) return
+    !
+    j0 = 1
+    do while ( j0 < len_trim(attrlist) )
+       ! locate = and first quote
+       j1 = index ( attrlist(j0:), '=' )
+       quote = attrlist(j0+j1:j0+j1)
+       ! next line: something is not right
+       if ( quote /= '"' .and. quote /= "'" ) return
+    end do
+    !
+  END SUBROUTINE get_c_attr
+end module what