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 --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 7031a829..a92d5cd 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -2784,9 +2784,11 @@
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 @@
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 0000000..8e9198c
--- /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
+
