[gcc r15-9831] Fortran: Fix missing substring ref for allocatable saved vars [PR120483]

Andre Vehreschild vehre@gcc.gnu.org
Fri Jun 13 07:47:42 GMT 2025


https://gcc.gnu.org/g:1549bb90c10c5e3ef1c5f2080cdb58dbaee25291

commit r15-9831-g1549bb90c10c5e3ef1c5f2080cdb58dbaee25291
Author: Andre Vehreschild <vehre@gcc.gnu.org>
Date:   Mon Jun 2 10:41:48 2025 +0200

    Fortran: Fix missing substring ref for allocatable saved vars [PR120483]
    
            Compute a substring ref on an allocatable static character array
            using pointer arithmetic.  Using an array type corrupts type
            layouting and crashes omp generation.
    
            PR fortran/120483
    
    gcc/fortran/ChangeLog:
    
            * trans-expr.cc (gfc_conv_substring): Use pointer arithmetic on
            static allocatable char arrays.
    
    gcc/testsuite/ChangeLog:
    
            * gfortran.dg/save_8.f90: New test.
    
    (cherry picked from commit 5c9bdfd2748b8159856a37404ab7b34d977242ce)

Diff:
---
 gcc/fortran/trans-expr.cc            | 16 +++++++++++++---
 gcc/testsuite/gfortran.dg/save_8.f90 | 13 +++++++++++++
 2 files changed, 26 insertions(+), 3 deletions(-)

diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 7031a829759f..a92d5cd75b67 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -2784,9 +2784,11 @@ gfc_conv_substring (gfc_se * se, gfc_ref * ref, int kind,
 	start.expr = gfc_evaluate_now (start.expr, &se->pre);
 
       /* Change the start of the string.  */
-      if ((TREE_CODE (TREE_TYPE (se->expr)) == ARRAY_TYPE
-	   || TREE_CODE (TREE_TYPE (se->expr)) == INTEGER_TYPE)
-	  && TYPE_STRING_FLAG (TREE_TYPE (se->expr)))
+      if (((TREE_CODE (TREE_TYPE (se->expr)) == ARRAY_TYPE
+	    || TREE_CODE (TREE_TYPE (se->expr)) == INTEGER_TYPE)
+	   && TYPE_STRING_FLAG (TREE_TYPE (se->expr)))
+	  || (POINTER_TYPE_P (TREE_TYPE (se->expr))
+	      && TREE_CODE (TREE_TYPE (TREE_TYPE (se->expr))) != ARRAY_TYPE))
 	tmp = se->expr;
       else
 	tmp = build_fold_indirect_ref_loc (input_location,
@@ -2797,6 +2799,14 @@ gfc_conv_substring (gfc_se * se, gfc_ref * ref, int kind,
 	  tmp = gfc_build_array_ref (tmp, start.expr, NULL_TREE, true);
 	  se->expr = gfc_build_addr_expr (type, tmp);
 	}
+      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));
+	  se->expr
+	    = fold_build2 (POINTER_PLUS_EXPR, TREE_TYPE (tmp), tmp, diff);
+	}
     }
 
   /* Length = end + 1 - start.  */
diff --git a/gcc/testsuite/gfortran.dg/save_8.f90 b/gcc/testsuite/gfortran.dg/save_8.f90
new file mode 100644
index 000000000000..8e9198caeb18
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/save_8.f90
@@ -0,0 +1,13 @@
+!{ dg-do run }
+
+! Check PR120483 is fixed.
+! Contributed by Thomas Koenig  <tkoenig@gcc.gnu.org>
+!            and Peter Güntert  <peter@guentert.com> 
+
+program save_8
+  implicit none
+  character(len=:), allocatable, save :: s1
+  s1 = 'ABC'
+  if (s1(3:3) /= 'C') stop 1
+end program save_8
+


More information about the Gcc-cvs mailing list