https://gcc.gnu.org/g:1549bb90c10c5e3ef1c5f2080cdb58dbaee25291
commit r15-9831-g1549bb90c10c5e3ef1c5f2080cdb58dbaee25291
Author: Andre Vehreschild <ve...@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 <tkoe...@gcc.gnu.org>
+! and Peter Güntert <pe...@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
+
