https://gcc.gnu.org/g:b2b139ddee763dd5fd71a3368e5e66399e3c52a3
commit r15-8079-gb2b139ddee763dd5fd71a3368e5e66399e3c52a3
Author: Harald Anlauf <anl...@gmx.de>
Date: Sat Mar 15 15:11:22 2025 +0100
Fortran: fix bogus dependency check in ALLOCATE statement [PR60560]
Restrict dependency check of ALLOCATE object to variables in the same
statement, but exclude check of length type parameter that might be
set in the declaration and could lead to a bogus cyclic dependency.
PR fortran/60560
gcc/fortran/ChangeLog:
* expr.cc (gfc_traverse_expr): Do not descend into length type
parameter for negative values of auxiliary parameter f.
* resolve.cc (gfc_find_var_in_expr): New helper function to check
dependence of an expression on given variable.
(resolve_allocate_expr): Use it to determine if array bounds in an
ALLOCATE statement depend explicitly on a variable.
gcc/testsuite/ChangeLog:
* gfortran.dg/allocate_error_8.f90: New test.
Diff:
---
gcc/fortran/expr.cc | 28 +++++++++++++++-----------
gcc/fortran/resolve.cc | 12 +++++++++--
gcc/testsuite/gfortran.dg/allocate_error_8.f90 | 17 ++++++++++++++++
3 files changed, 43 insertions(+), 14 deletions(-)
diff --git a/gcc/fortran/expr.cc b/gcc/fortran/expr.cc
index 9d84e761576b..0753667e061d 100644
--- a/gcc/fortran/expr.cc
+++ b/gcc/fortran/expr.cc
@@ -5488,11 +5488,14 @@ gfc_traverse_expr (gfc_expr *expr, gfc_symbol *sym,
if ((*func) (expr, sym, &f))
return true;
- if (expr->ts.type == BT_CHARACTER
- && expr->ts.u.cl
- && expr->ts.u.cl->length
- && expr->ts.u.cl->length->expr_type != EXPR_CONSTANT
- && gfc_traverse_expr (expr->ts.u.cl->length, sym, func, f))
+ /* Descend into length type parameter of character expressions only for
+ non-negative f. */
+ if (f >= 0
+ && expr->ts.type == BT_CHARACTER
+ && expr->ts.u.cl
+ && expr->ts.u.cl->length
+ && expr->ts.u.cl->length->expr_type != EXPR_CONSTANT
+ && gfc_traverse_expr (expr->ts.u.cl->length, sym, func, f))
return true;
switch (expr->expr_type)
@@ -5572,13 +5575,14 @@ gfc_traverse_expr (gfc_expr *expr, gfc_symbol *sym,
break;
case REF_COMPONENT:
- if (ref->u.c.component->ts.type == BT_CHARACTER
- && ref->u.c.component->ts.u.cl
- && ref->u.c.component->ts.u.cl->length
- && ref->u.c.component->ts.u.cl->length->expr_type
- != EXPR_CONSTANT
- && gfc_traverse_expr (ref->u.c.component->ts.u.cl->length,
- sym, func, f))
+ if (f >= 0
+ && ref->u.c.component->ts.type == BT_CHARACTER
+ && ref->u.c.component->ts.u.cl
+ && ref->u.c.component->ts.u.cl->length
+ && ref->u.c.component->ts.u.cl->length->expr_type
+ != EXPR_CONSTANT
+ && gfc_traverse_expr (ref->u.c.component->ts.u.cl->length,
+ sym, func, f))
return true;
if (ref->u.c.component->as)
diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index 34c8210f66a4..d64edff85079 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -8629,6 +8629,14 @@ gfc_find_sym_in_expr (gfc_symbol *sym, gfc_expr *e)
return gfc_traverse_expr (e, sym, sym_in_expr, 0);
}
+/* Same as gfc_find_sym_in_expr, but do not descend into length type parameter
+ of character expressions. */
+static bool
+gfc_find_var_in_expr (gfc_symbol *sym, gfc_expr *e)
+{
+ return gfc_traverse_expr (e, sym, sym_in_expr, -1);
+}
+
/* Given the expression node e for an allocatable/pointer of derived type to be
allocated, get the expression node to be initialized afterwards (needed for
@@ -9190,9 +9198,9 @@ check_symbols:
continue;
if ((ar->start[i] != NULL
- && gfc_find_sym_in_expr (sym, ar->start[i]))
+ && gfc_find_var_in_expr (sym, ar->start[i]))
|| (ar->end[i] != NULL
- && gfc_find_sym_in_expr (sym, ar->end[i])))
+ && gfc_find_var_in_expr (sym, ar->end[i])))
{
gfc_error ("%qs must not appear in the array specification at "
"%L in the same ALLOCATE statement where it is "
diff --git a/gcc/testsuite/gfortran.dg/allocate_error_8.f90
b/gcc/testsuite/gfortran.dg/allocate_error_8.f90
new file mode 100644
index 000000000000..5637f9fae4d9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/allocate_error_8.f90
@@ -0,0 +1,17 @@
+! { dg-do compile }
+! PR fortran/60560
+!
+! Original test case by Marco Restelli.
+
+module mstr
+ implicit none
+contains
+ subroutine sub(s)
+ character(len=*), allocatable, intent(out) :: s(:)
+ character(len=len(s)), allocatable :: s_tmp(:)
+ allocate(s_tmp(5))
+ allocate(s(size(s_tmp))) ! OK
+ allocate(s_tmp(5),s(size(s_tmp))) ! { dg-error "same ALLOCATE statement" }
+ allocate(s_tmp(5),s(len(s_tmp))) ! { dg-error "same ALLOCATE statement" }
+ end subroutine sub
+end module mstr
