]> git.ipfire.org Git - thirdparty/gcc.git/commitdiff
Fortran: Fix missing substring ref for allocatable saved vars [PR120483]
authorAndre Vehreschild <vehre@gcc.gnu.org>
Mon, 2 Jun 2025 08:41:48 +0000 (10:41 +0200)
committerAndre Vehreschild <vehre@gcc.gnu.org>
Wed, 4 Jun 2025 07:22:08 +0000 (09:22 +0200)
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.

gcc/fortran/trans-expr.cc
gcc/testsuite/gfortran.dg/save_8.f90 [new file with mode: 0644]

index 8d9448eb9b6d11af4564fe4910726cb53445698e..74d4265f27d81270752eda736047838f0dc725dc 100644 (file)
@@ -2782,9 +2782,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,
@@ -2795,6 +2797,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 (file)
index 0000000..8e9198c
--- /dev/null
@@ -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
+