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.

3 files changed, 43 insertions, 14 deletions

diff --git a/gcc/fortran/expr.cc b/gcc/fortran/expr.cc
index 9d84e76..0753667 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 34c8210..d64edff 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 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