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 c8a207609e4b532cdfb43a4286239992af09a4d7..3e0d763d2fb08a13eedaf436da31cb3e1e4f81a0 100644 (file)
--- 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 (file)
index 0000000..8682d0c
--- /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