Dear all,
here's an obvious fix for a recent regression: substring offset
calculations used a wrong type that crashed in gimplification.
Andre basically OK'ed it in the PR, but here it is nevertheless.
Regtested on x86_64-pc-linux-gnu. OK for mainline?
Thanks,
Harald
From 5bc92717b804483a17dd5095f8b6d4fd75a472b1 Mon Sep 17 00:00:00 2001
From: Harald Anlauf <anl...@gmx.de>
Date: Tue, 24 Jun 2025 20:46:38 +0200
Subject: [PATCH] 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 <jvdeli...@gcc.gnu.org>
Co-authored-by: Mikael Morin <mik...@gcc.gnu.org>
---
gcc/fortran/trans-expr.cc | 5 ++--
gcc/testsuite/gfortran.dg/pr120743.f90 | 38 ++++++++++++++++++++++++++
2 files changed, 41 insertions(+), 2 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/pr120743.f90
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
--
2.43.0
