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 --git a/gcc/fortran/expr.cc b/gcc/fortran/expr.cc
index 9d84e761576bf04ca137b67713d9aa40bfffc390..0753667e061d6b14f461a79764f4b531445905bb 100644 (file)
--- 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 34c8210f66a46cf5785fd5d109d3c9e06ca61915..d64edff8507923b96b5364596bede92a526a2820 100644 (file)
--- 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 (file)
index 0000000..5637f9f
--- /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