[PATCH v3 0/2] fortran: Fix specification checks [PR111781]

[PATCH v3 0/2] fortran: Fix specification checks [PR111781]

[Mikael Morin]

Hello,

these patches correct diagnostics dealing with variables in specification
expressions.
The first patch is a testsuite change, which fixes invalid specification
expressions that the second patch would diagnose.
The second patch removes a spurious diagnostic when a dummy procedure is
involved, and enables more valid ones, as visible in the testcases from the
first patch.

I haven't tested it again (same code as v2), but I plan to do it before the final push.
Ok for master?

Mikael

v2 -> v3 changes:

  - Correct first name in testcase comment
  - Clarify and correct log and changelog text from second patch
  - Target current stage (stage4) instead of next (stage1)

v1 -> v2 changes:

  - Fix condition guarding sym->result access.

 
Mikael Morin (2):
  testsuite: Declare fortran array bound variables
  fortran: Fix specification expression error with dummy procedures
    [PR111781]

 gcc/fortran/expr.cc                           |  8 +-
 gcc/fortran/gfortran.h                        |  4 +-
 gcc/fortran/resolve.cc                        | 77 +++++++++----------
 gcc/fortran/symbol.cc                         | 58 ++++++++++++++
 .../gfortran.dg/graphite/pr107865.f90         |  2 +-
 gcc/testsuite/gfortran.dg/pr101267.f90        |  2 +-
 gcc/testsuite/gfortran.dg/pr112404.f90        |  2 +-
 gcc/testsuite/gfortran.dg/pr78061.f           |  2 +-
 gcc/testsuite/gfortran.dg/pr79315.f90         |  6 +-
 gcc/testsuite/gfortran.dg/spec_expr_8.f90     | 24 ++++++
 gcc/testsuite/gfortran.dg/spec_expr_9.f90     | 19 +++++
 gcc/testsuite/gfortran.dg/vect/pr90681.f      |  2 +-
 gcc/testsuite/gfortran.dg/vect/pr97761.f90    |  2 +-
 gcc/testsuite/gfortran.dg/vect/pr99746.f90    |  2 +-
 14 files changed, 152 insertions(+), 58 deletions(-)
 create mode 100644 gcc/testsuite/gfortran.dg/spec_expr_8.f90
 create mode 100644 gcc/testsuite/gfortran.dg/spec_expr_9.f90

-- 
2.43.0

[PATCH v3 1/2] testsuite: Declare fortran array bound variables

[Mikael Morin]

This fixes invalid undeclared fortran array bound variables
in the testsuite.

gcc/testsuite/ChangeLog:

	* gfortran.dg/graphite/pr107865.f90: Declare array bound variable(s)
	as dummy argument(s).
	* gfortran.dg/pr101267.f90: Likewise.
	* gfortran.dg/pr112404.f90: Likewise.
	* gfortran.dg/pr78061.f: Likewise.
	* gfortran.dg/pr79315.f90: Likewise.
	* gfortran.dg/vect/pr90681.f: Likewise.
	* gfortran.dg/vect/pr97761.f90: Likewise.
	* gfortran.dg/vect/pr99746.f90: Likewise.
---
 gcc/testsuite/gfortran.dg/graphite/pr107865.f90 | 2 +-
 gcc/testsuite/gfortran.dg/pr101267.f90          | 2 +-
 gcc/testsuite/gfortran.dg/pr112404.f90          | 2 +-
 gcc/testsuite/gfortran.dg/pr78061.f             | 2 +-
 gcc/testsuite/gfortran.dg/pr79315.f90           | 6 +++++-
 gcc/testsuite/gfortran.dg/vect/pr90681.f        | 2 +-
 gcc/testsuite/gfortran.dg/vect/pr97761.f90      | 2 +-
 gcc/testsuite/gfortran.dg/vect/pr99746.f90      | 2 +-
 8 files changed, 12 insertions(+), 8 deletions(-)

diff --git a/gcc/testsuite/gfortran.dg/graphite/pr107865.f90 b/gcc/testsuite/gfortran.dg/graphite/pr107865.f90
index 6bddb17a1be..323d8092ad2 100644
--- a/gcc/testsuite/gfortran.dg/graphite/pr107865.f90
+++ b/gcc/testsuite/gfortran.dg/graphite/pr107865.f90
@@ -1,7 +1,7 @@
 ! { dg-do compile }
 ! { dg-options "-O1 -floop-parallelize-all -ftree-parallelize-loops=2" }
 
-      SUBROUTINE FNC (F)
+      SUBROUTINE FNC (F,N)
 
       IMPLICIT REAL (A-H)
       DIMENSION F(N)
diff --git a/gcc/testsuite/gfortran.dg/pr101267.f90 b/gcc/testsuite/gfortran.dg/pr101267.f90
index 12723cf9c22..99a6dcfa342 100644
--- a/gcc/testsuite/gfortran.dg/pr101267.f90
+++ b/gcc/testsuite/gfortran.dg/pr101267.f90
@@ -1,7 +1,7 @@
 ! { dg-do compile }
 ! { dg-options "-Ofast" }
 ! { dg-additional-options "-march=znver2" { target x86_64-*-* i?86-*-* } }
-   SUBROUTINE sfddagd( regime, znt,ite ,jte )
+   SUBROUTINE sfddagd( regime, znt,ite ,jte, ime, IN )
    REAL, DIMENSION( ime, IN) :: regime, znt
    REAL, DIMENSION( ite, jte) :: wndcor_u 
    LOGICAL wrf_dm_on_monitor
diff --git a/gcc/testsuite/gfortran.dg/pr112404.f90 b/gcc/testsuite/gfortran.dg/pr112404.f90
index 573fa28164a..4508bbc8738 100644
--- a/gcc/testsuite/gfortran.dg/pr112404.f90
+++ b/gcc/testsuite/gfortran.dg/pr112404.f90
@@ -1,7 +1,7 @@
 ! { dg-do compile }
 ! { dg-options "-Ofast" }
 ! { dg-additional-options "-mavx2" { target avx2 } }
-   SUBROUTINE sfddagd( regime, znt, ite, jte )
+   SUBROUTINE sfddagd( regime, znt, ite, jte, ime, IN )
    REAL, DIMENSION( ime, IN) :: regime, znt
    REAL, DIMENSION( ite, jte) :: wndcor_u 
    LOGICAL wrf_dm_on_monitor
diff --git a/gcc/testsuite/gfortran.dg/pr78061.f b/gcc/testsuite/gfortran.dg/pr78061.f
index 7e4dd3de8b5..9061dea74da 100644
--- a/gcc/testsuite/gfortran.dg/pr78061.f
+++ b/gcc/testsuite/gfortran.dg/pr78061.f
@@ -1,6 +1,6 @@
 ! { dg-do compile }
 ! { dg-options "-O3 -fsplit-loops" }
-      SUBROUTINE SSYMM(C)
+      SUBROUTINE SSYMM(C,LDC)
       REAL C(LDC,*)
       LOGICAL LSAME
       LOGICAL UPPER
diff --git a/gcc/testsuite/gfortran.dg/pr79315.f90 b/gcc/testsuite/gfortran.dg/pr79315.f90
index 8cd89691ce9..b754a2b3274 100644
--- a/gcc/testsuite/gfortran.dg/pr79315.f90
+++ b/gcc/testsuite/gfortran.dg/pr79315.f90
@@ -10,7 +10,11 @@ SUBROUTINE wsm32D(t, &
                      its,&
    ite, &
    kts, &
-   kte  &
+   kte, &
+   ims, &
+   ime, &
+   kms, &
+   kme  &
                       )
   REAL, DIMENSION( its:ite , kts:kte ),                           &
         INTENT(INOUT) ::                                          &
diff --git a/gcc/testsuite/gfortran.dg/vect/pr90681.f b/gcc/testsuite/gfortran.dg/vect/pr90681.f
index 03d3987b146..49f1d50ab8f 100644
--- a/gcc/testsuite/gfortran.dg/vect/pr90681.f
+++ b/gcc/testsuite/gfortran.dg/vect/pr90681.f
@@ -1,6 +1,6 @@
 C { dg-do compile }
 C { dg-additional-options "-march=armv8.2-a+sve" { target { aarch64*-*-* } } }
-      SUBROUTINE HMU (H1)
+      SUBROUTINE HMU (H1,NORBS)
       COMMON DD(107)
       DIMENSION H1(NORBS,*)
             DO 70 J1 = IA,I1
diff --git a/gcc/testsuite/gfortran.dg/vect/pr97761.f90 b/gcc/testsuite/gfortran.dg/vect/pr97761.f90
index 250e2bf016e..401ef06e422 100644
--- a/gcc/testsuite/gfortran.dg/vect/pr97761.f90
+++ b/gcc/testsuite/gfortran.dg/vect/pr97761.f90
@@ -1,7 +1,7 @@
 ! { dg-do compile }
 ! { dg-additional-options "-O1" }
 
-subroutine ni (ps)
+subroutine ni (ps, inout)
     type vector
        real  x, y
     end type 
diff --git a/gcc/testsuite/gfortran.dg/vect/pr99746.f90 b/gcc/testsuite/gfortran.dg/vect/pr99746.f90
index fe947ae7ccf..121d67d564d 100644
--- a/gcc/testsuite/gfortran.dg/vect/pr99746.f90
+++ b/gcc/testsuite/gfortran.dg/vect/pr99746.f90
@@ -1,6 +1,6 @@
 ! { dg-do compile }
 ! { dg-additional-options "-march=armv8.3-a" { target aarch64-*-* } }
-SUBROUTINE CLAREF(A, WANTZ, Z, ICOL1, ITMP1, ITMP2, T1, T2, V2)
+SUBROUTINE CLAREF(A, WANTZ, Z, ICOL1, ITMP1, ITMP2, T1, T2, V2, LDA)
 LOGICAL            BLOCK, WANTZ
 COMPLEX            T1, T2, V2
 COMPLEX            A(LDA, *), VECS, Z(LDA, *)
-- 
2.43.0

[PATCH v3 2/2] fortran: Fix specification expression error with dummy procedures [PR111781]

[Mikael Morin]

This fixes a spurious invalid variable in specification expression error.
The error was caused on the testcase from the PR by two different bugs.
First, the call to is_parent_of_current_ns was unable to recognize
correct host association and returned false.  Second, an ad-hoc
condition coming next was using a global variable previously improperly
restored to false (instead of restoring it to its initial value).  The
latter happened on the testcase because one dummy argument was a procedure,
and checking that argument what causing a check of all its arguments with
the (improper) reset of the flag at the end, and that preceded the check of
the next argument.

For the first bug, the wrong result of is_parent_of_current_ns is fixed by
correcting the namespaces that function deals with, both the one passed
as argument and the current one tracked in the gfc_current_ns global.  Two
new functions are introduced to select the right namespace.

Regarding the second bug, the problematic condition is removed, together
with the formal_arg_flag associated with it.  Indeed, that condition was
(wrongly) allowing local variables to be used in array bounds of dummy
arguments.

	PR fortran/111781

gcc/fortran/ChangeLog:

	* symbol.cc (gfc_get_procedure_ns, gfc_get_spec_ns): New functions.
	* gfortran.h (gfc_get_procedure_ns, gfc_get_spec ns): Declare them.
	(gfc_is_formal_arg): Remove.
	* expr.cc (check_restricted): Remove special case allowing local
	variable in dummy argument bound expressions.  Use gfc_get_spec_ns
	to get the right namespace.
	* resolve.cc (gfc_is_formal_arg, formal_arg_flag): Remove.
	(gfc_resolve_formal_arglist): Set gfc_current_ns.  Quit loop and
	restore gfc_current_ns instead of early returning.
	(resolve_symbol): Factor common array spec resolution code to...
	(resolve_symbol_array_spec): ... this new function.  Additionnally
	set and restore gfc_current_ns.

gcc/testsuite/ChangeLog:

	* gfortran.dg/spec_expr_8.f90: New test.
	* gfortran.dg/spec_expr_9.f90: New test.
---
 gcc/fortran/expr.cc                       |  8 +--
 gcc/fortran/gfortran.h                    |  4 +-
 gcc/fortran/resolve.cc                    | 77 +++++++++++------------
 gcc/fortran/symbol.cc                     | 58 +++++++++++++++++
 gcc/testsuite/gfortran.dg/spec_expr_8.f90 | 24 +++++++
 gcc/testsuite/gfortran.dg/spec_expr_9.f90 | 19 ++++++
 6 files changed, 140 insertions(+), 50 deletions(-)
 create mode 100644 gcc/testsuite/gfortran.dg/spec_expr_8.f90
 create mode 100644 gcc/testsuite/gfortran.dg/spec_expr_9.f90

diff --git a/gcc/fortran/expr.cc b/gcc/fortran/expr.cc
index e4b1e8307e3..9a042cd7040 100644
--- a/gcc/fortran/expr.cc
+++ b/gcc/fortran/expr.cc
@@ -3514,19 +3514,13 @@ check_restricted (gfc_expr *e)
       if (!check_references (e->ref, &check_restricted))
 	break;
 
-      /* gfc_is_formal_arg broadcasts that a formal argument list is being
-	 processed in resolve.cc(resolve_formal_arglist).  This is done so
-	 that host associated dummy array indices are accepted (PR23446).
-	 This mechanism also does the same for the specification expressions
-	 of array-valued functions.  */
       if (e->error
 	    || sym->attr.in_common
 	    || sym->attr.use_assoc
 	    || sym->attr.dummy
 	    || sym->attr.implied_index
 	    || sym->attr.flavor == FL_PARAMETER
-	    || is_parent_of_current_ns (sym->ns)
-	    || (gfc_is_formal_arg () && (sym->ns == gfc_current_ns)))
+	    || is_parent_of_current_ns (gfc_get_spec_ns (sym)))
 	{
 	  t = true;
 	  break;
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index c7039730fad..26aa56b3358 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -3612,6 +3612,9 @@ bool gfc_is_associate_pointer (gfc_symbol*);
 gfc_symbol * gfc_find_dt_in_generic (gfc_symbol *);
 gfc_formal_arglist *gfc_sym_get_dummy_args (gfc_symbol *);
 
+gfc_namespace * gfc_get_procedure_ns (gfc_symbol *);
+gfc_namespace * gfc_get_spec_ns (gfc_symbol *);
+
 /* intrinsic.cc -- true if working in an init-expr, false otherwise.  */
 extern bool gfc_init_expr_flag;
 
@@ -3821,7 +3824,6 @@ bool gfc_resolve_iterator (gfc_iterator *, bool, bool);
 bool find_forall_index (gfc_expr *, gfc_symbol *, int);
 bool gfc_resolve_index (gfc_expr *, int);
 bool gfc_resolve_dim_arg (gfc_expr *);
-bool gfc_is_formal_arg (void);
 bool gfc_resolve_substring (gfc_ref *, bool *);
 void gfc_resolve_substring_charlen (gfc_expr *);
 gfc_expr *gfc_expr_to_initialize (gfc_expr *);
diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index c5ae826bd6e..50d51b06c92 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -72,9 +72,6 @@ static bool first_actual_arg = false;
 
 static int omp_workshare_flag;
 
-/* True if we are processing a formal arglist. The corresponding function
-   resets the flag each time that it is read.  */
-static bool formal_arg_flag = false;
 
 /* True if we are resolving a specification expression.  */
 static bool specification_expr = false;
@@ -89,12 +86,6 @@ static bitmap_obstack labels_obstack;
 static bool inquiry_argument = false;
 
 
-bool
-gfc_is_formal_arg (void)
-{
-  return formal_arg_flag;
-}
-
 /* Is the symbol host associated?  */
 static bool
 is_sym_host_assoc (gfc_symbol *sym, gfc_namespace *ns)
@@ -285,7 +276,8 @@ gfc_resolve_formal_arglist (gfc_symbol *proc)
       sym->attr.always_explicit = 1;
     }
 
-  formal_arg_flag = true;
+  gfc_namespace *orig_current_ns = gfc_current_ns;
+  gfc_current_ns = gfc_get_procedure_ns (proc);
 
   for (f = proc->formal; f; f = f->next)
     {
@@ -306,17 +298,18 @@ gfc_resolve_formal_arglist (gfc_symbol *proc)
 		       &proc->declared_at);
 	  continue;
 	}
-      else if (sym->attr.procedure && sym->attr.if_source != IFSRC_DECL
+
+      if (sym->attr.procedure && sym->attr.if_source != IFSRC_DECL
 	       && !resolve_procedure_interface (sym))
-	return;
+	break;
 
       if (strcmp (proc->name, sym->name) == 0)
-        {
-          gfc_error ("Self-referential argument "
-                     "%qs at %L is not allowed", sym->name,
-                     &proc->declared_at);
-          return;
-        }
+	{
+	  gfc_error ("Self-referential argument "
+		     "%qs at %L is not allowed", sym->name,
+		     &proc->declared_at);
+	  break;
+	}
 
       if (sym->attr.if_source != IFSRC_UNKNOWN)
 	gfc_resolve_formal_arglist (sym);
@@ -533,7 +526,8 @@ gfc_resolve_formal_arglist (gfc_symbol *proc)
 	    }
 	}
     }
-  formal_arg_flag = false;
+
+  gfc_current_ns = orig_current_ns;
 }
 
 
@@ -16206,6 +16200,26 @@ resolve_pdt (gfc_symbol* sym)
 }
 
 
+/* Resolve the symbol's array spec.  */
+
+static bool
+resolve_symbol_array_spec (gfc_symbol *sym, int check_constant)
+{
+  gfc_namespace *orig_current_ns = gfc_current_ns;
+  gfc_current_ns = gfc_get_spec_ns (sym);
+
+  bool saved_specification_expr = specification_expr;
+  specification_expr = true;
+
+  bool result = gfc_resolve_array_spec (sym->as, check_constant);
+
+  specification_expr = saved_specification_expr;
+  gfc_current_ns = orig_current_ns;
+
+  return result;
+}
+
+
 /* Do anything necessary to resolve a symbol.  Right now, we just
    assume that an otherwise unknown symbol is a variable.  This sort
    of thing commonly happens for symbols in module.  */
@@ -16220,7 +16234,6 @@ resolve_symbol (gfc_symbol *sym)
   gfc_component *c;
   symbol_attribute class_attr;
   gfc_array_spec *as;
-  bool saved_specification_expr;
 
   if (sym->resolve_symbol_called >= 1)
     return;
@@ -16385,16 +16398,7 @@ resolve_symbol (gfc_symbol *sym)
 	}
     }
   else if (mp_flag && sym->attr.flavor == FL_PROCEDURE && sym->attr.function)
-    {
-      bool saved_specification_expr = specification_expr;
-      bool saved_formal_arg_flag = formal_arg_flag;
-
-      specification_expr = true;
-      formal_arg_flag = true;
-      gfc_resolve_array_spec (sym->result->as, false);
-      formal_arg_flag = saved_formal_arg_flag;
-      specification_expr = saved_specification_expr;
-    }
+    resolve_symbol_array_spec (sym->result, false);
 
   /* For a CLASS-valued function with a result variable, affirm that it has
      been resolved also when looking at the symbol 'sym'.  */
@@ -16961,18 +16965,7 @@ resolve_symbol (gfc_symbol *sym)
 
   check_constant = sym->attr.in_common && !sym->attr.pointer && !sym->error;
 
-  /* Set the formal_arg_flag so that check_conflict will not throw
-     an error for host associated variables in the specification
-     expression for an array_valued function.  */
-  if ((sym->attr.function || sym->attr.result) && sym->as)
-    formal_arg_flag = true;
-
-  saved_specification_expr = specification_expr;
-  specification_expr = true;
-  gfc_resolve_array_spec (sym->as, check_constant);
-  specification_expr = saved_specification_expr;
-
-  formal_arg_flag = false;
+  resolve_symbol_array_spec (sym, check_constant);
 
   /* Resolve formal namespaces.  */
   if (sym->formal_ns && sym->formal_ns != gfc_current_ns
diff --git a/gcc/fortran/symbol.cc b/gcc/fortran/symbol.cc
index 16adb2a7efb..3a3b6de5cec 100644
--- a/gcc/fortran/symbol.cc
+++ b/gcc/fortran/symbol.cc
@@ -5408,3 +5408,61 @@ gfc_sym_get_dummy_args (gfc_symbol *sym)
 
   return dummies;
 }
+
+
+/* Given a procedure, returns the associated namespace.
+   The resulting NS should match the condition NS->PROC_NAME == SYM.  */
+
+gfc_namespace *
+gfc_get_procedure_ns (gfc_symbol *sym)
+{
+  if (sym->formal_ns
+      && sym->formal_ns->proc_name == sym)
+    return sym->formal_ns;
+
+  /* The above should have worked in most cases.  If it hasn't, try some other
+     heuristics, eventually returning SYM->NS.  */
+  if (gfc_current_ns->proc_name == sym)
+    return gfc_current_ns;
+
+  /* For contained procedures, the symbol's NS field is the
+     hosting namespace, not the procedure namespace.  */
+  if (sym->attr.flavor == FL_PROCEDURE && sym->attr.contained)
+    for (gfc_namespace *ns = sym->ns->contained; ns; ns = ns->sibling)
+      if (ns->proc_name == sym)
+	return ns;
+
+  if (sym->formal)
+    for (gfc_formal_arglist *f = sym->formal; f != nullptr; f = f->next)
+      if (f->sym)
+	{
+	  gfc_namespace *ns = f->sym->ns;
+	  if (ns && ns->proc_name == sym)
+	    return ns;
+	}
+
+  return sym->ns;
+}
+
+
+/* Given a symbol, returns the namespace in which the symbol is specified.
+   In most cases, it is the namespace hosting the symbol.  This is the case
+   for variables.  For functions, however, it is the function namespace
+   itself.  This specification namespace is used to check conformance of
+   array spec bound expressions.  */
+
+gfc_namespace *
+gfc_get_spec_ns (gfc_symbol *sym)
+{
+  if (sym->attr.flavor == FL_PROCEDURE
+      && sym->attr.function)
+    {
+      if (sym->result == sym)
+	return gfc_get_procedure_ns (sym);
+      /* Generic and intrinsic functions can have a null result.  */
+      else if (sym->result != nullptr)
+	return sym->result->ns;
+    }
+
+  return sym->ns;
+}
diff --git a/gcc/testsuite/gfortran.dg/spec_expr_8.f90 b/gcc/testsuite/gfortran.dg/spec_expr_8.f90
new file mode 100644
index 00000000000..77e14156497
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/spec_expr_8.f90
@@ -0,0 +1,24 @@
+! { dg-do compile }
+!
+! PR fortran/111781
+! We used to reject the example below because the dummy procedure g was
+! setting the current namespace without properly restoring it, which broke
+! the specification expression check for the dimension of A later on.
+!
+! Contributed by Rasmus Vikhamar-Sandberg  <rasmus.vikhamar-sandberg@uit.no>
+
+program example
+    implicit none
+    integer :: n
+    
+contains
+    
+    subroutine f(g,A)
+        real, intent(out) :: A(n)
+        interface
+          pure real(8) function g(x)
+            real(8), intent(in) :: x
+          end function
+        end interface
+    end subroutine
+end program
diff --git a/gcc/testsuite/gfortran.dg/spec_expr_9.f90 b/gcc/testsuite/gfortran.dg/spec_expr_9.f90
new file mode 100644
index 00000000000..9024909b4e9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/spec_expr_9.f90
@@ -0,0 +1,19 @@
+! { dg-do compile }
+!
+! PR fortran/111781
+! Used to fail with Error: Variable ‘n’ cannot appear in the
+! expression at (1) for line 16.
+!
+program is_it_valid
+  dimension y(3)
+  integer :: n = 3
+  interface
+    function func(x)
+      import
+      dimension func(n)
+    end function
+  end interface
+  y=func(1.0)
+  print *, y
+  stop
+end
-- 
2.43.0

Re: [PATCH v3 1/2] testsuite: Declare fortran array bound variables

[Paul Richard Thomas]

[-- Attachment #1: Type: text/plain, Size: 5574 bytes --]

Hi Mikael,

This looks completely "obvious" to me. OK for mainline and, I would
suggest, 13-branch.

Thanks

Paul



On Tue, 19 Mar 2024 at 15:49, Mikael Morin <mikael@gcc.gnu.org> wrote:

> This fixes invalid undeclared fortran array bound variables
> in the testsuite.
>
> gcc/testsuite/ChangeLog:
>
>         * gfortran.dg/graphite/pr107865.f90: Declare array bound
> variable(s)
>         as dummy argument(s).
>         * gfortran.dg/pr101267.f90: Likewise.
>         * gfortran.dg/pr112404.f90: Likewise.
>         * gfortran.dg/pr78061.f: Likewise.
>         * gfortran.dg/pr79315.f90: Likewise.
>         * gfortran.dg/vect/pr90681.f: Likewise.
>         * gfortran.dg/vect/pr97761.f90: Likewise.
>         * gfortran.dg/vect/pr99746.f90: Likewise.
> ---
>  gcc/testsuite/gfortran.dg/graphite/pr107865.f90 | 2 +-
>  gcc/testsuite/gfortran.dg/pr101267.f90          | 2 +-
>  gcc/testsuite/gfortran.dg/pr112404.f90          | 2 +-
>  gcc/testsuite/gfortran.dg/pr78061.f             | 2 +-
>  gcc/testsuite/gfortran.dg/pr79315.f90           | 6 +++++-
>  gcc/testsuite/gfortran.dg/vect/pr90681.f        | 2 +-
>  gcc/testsuite/gfortran.dg/vect/pr97761.f90      | 2 +-
>  gcc/testsuite/gfortran.dg/vect/pr99746.f90      | 2 +-
>  8 files changed, 12 insertions(+), 8 deletions(-)
>
> diff --git a/gcc/testsuite/gfortran.dg/graphite/pr107865.f90
> b/gcc/testsuite/gfortran.dg/graphite/pr107865.f90
> index 6bddb17a1be..323d8092ad2 100644
> --- a/gcc/testsuite/gfortran.dg/graphite/pr107865.f90
> +++ b/gcc/testsuite/gfortran.dg/graphite/pr107865.f90
> @@ -1,7 +1,7 @@
>  ! { dg-do compile }
>  ! { dg-options "-O1 -floop-parallelize-all -ftree-parallelize-loops=2" }
>
> -      SUBROUTINE FNC (F)
> +      SUBROUTINE FNC (F,N)
>
>        IMPLICIT REAL (A-H)
>        DIMENSION F(N)
> diff --git a/gcc/testsuite/gfortran.dg/pr101267.f90
> b/gcc/testsuite/gfortran.dg/pr101267.f90
> index 12723cf9c22..99a6dcfa342 100644
> --- a/gcc/testsuite/gfortran.dg/pr101267.f90
> +++ b/gcc/testsuite/gfortran.dg/pr101267.f90
> @@ -1,7 +1,7 @@
>  ! { dg-do compile }
>  ! { dg-options "-Ofast" }
>  ! { dg-additional-options "-march=znver2" { target x86_64-*-* i?86-*-* } }
> -   SUBROUTINE sfddagd( regime, znt,ite ,jte )
> +   SUBROUTINE sfddagd( regime, znt,ite ,jte, ime, IN )
>     REAL, DIMENSION( ime, IN) :: regime, znt
>     REAL, DIMENSION( ite, jte) :: wndcor_u
>     LOGICAL wrf_dm_on_monitor
> diff --git a/gcc/testsuite/gfortran.dg/pr112404.f90
> b/gcc/testsuite/gfortran.dg/pr112404.f90
> index 573fa28164a..4508bbc8738 100644
> --- a/gcc/testsuite/gfortran.dg/pr112404.f90
> +++ b/gcc/testsuite/gfortran.dg/pr112404.f90
> @@ -1,7 +1,7 @@
>  ! { dg-do compile }
>  ! { dg-options "-Ofast" }
>  ! { dg-additional-options "-mavx2" { target avx2 } }
> -   SUBROUTINE sfddagd( regime, znt, ite, jte )
> +   SUBROUTINE sfddagd( regime, znt, ite, jte, ime, IN )
>     REAL, DIMENSION( ime, IN) :: regime, znt
>     REAL, DIMENSION( ite, jte) :: wndcor_u
>     LOGICAL wrf_dm_on_monitor
> diff --git a/gcc/testsuite/gfortran.dg/pr78061.f
> b/gcc/testsuite/gfortran.dg/pr78061.f
> index 7e4dd3de8b5..9061dea74da 100644
> --- a/gcc/testsuite/gfortran.dg/pr78061.f
> +++ b/gcc/testsuite/gfortran.dg/pr78061.f
> @@ -1,6 +1,6 @@
>  ! { dg-do compile }
>  ! { dg-options "-O3 -fsplit-loops" }
> -      SUBROUTINE SSYMM(C)
> +      SUBROUTINE SSYMM(C,LDC)
>        REAL C(LDC,*)
>        LOGICAL LSAME
>        LOGICAL UPPER
> diff --git a/gcc/testsuite/gfortran.dg/pr79315.f90
> b/gcc/testsuite/gfortran.dg/pr79315.f90
> index 8cd89691ce9..b754a2b3274 100644
> --- a/gcc/testsuite/gfortran.dg/pr79315.f90
> +++ b/gcc/testsuite/gfortran.dg/pr79315.f90
> @@ -10,7 +10,11 @@ SUBROUTINE wsm32D(t, &
>                       its,&
>     ite, &
>     kts, &
> -   kte  &
> +   kte, &
> +   ims, &
> +   ime, &
> +   kms, &
> +   kme  &
>                        )
>    REAL, DIMENSION( its:ite , kts:kte ),                           &
>          INTENT(INOUT) ::                                          &
> diff --git a/gcc/testsuite/gfortran.dg/vect/pr90681.f
> b/gcc/testsuite/gfortran.dg/vect/pr90681.f
> index 03d3987b146..49f1d50ab8f 100644
> --- a/gcc/testsuite/gfortran.dg/vect/pr90681.f
> +++ b/gcc/testsuite/gfortran.dg/vect/pr90681.f
> @@ -1,6 +1,6 @@
>  C { dg-do compile }
>  C { dg-additional-options "-march=armv8.2-a+sve" { target { aarch64*-*-*
> } } }
> -      SUBROUTINE HMU (H1)
> +      SUBROUTINE HMU (H1,NORBS)
>        COMMON DD(107)
>        DIMENSION H1(NORBS,*)
>              DO 70 J1 = IA,I1
> diff --git a/gcc/testsuite/gfortran.dg/vect/pr97761.f90
> b/gcc/testsuite/gfortran.dg/vect/pr97761.f90
> index 250e2bf016e..401ef06e422 100644
> --- a/gcc/testsuite/gfortran.dg/vect/pr97761.f90
> +++ b/gcc/testsuite/gfortran.dg/vect/pr97761.f90
> @@ -1,7 +1,7 @@
>  ! { dg-do compile }
>  ! { dg-additional-options "-O1" }
>
> -subroutine ni (ps)
> +subroutine ni (ps, inout)
>      type vector
>         real  x, y
>      end type
> diff --git a/gcc/testsuite/gfortran.dg/vect/pr99746.f90
> b/gcc/testsuite/gfortran.dg/vect/pr99746.f90
> index fe947ae7ccf..121d67d564d 100644
> --- a/gcc/testsuite/gfortran.dg/vect/pr99746.f90
> +++ b/gcc/testsuite/gfortran.dg/vect/pr99746.f90
> @@ -1,6 +1,6 @@
>  ! { dg-do compile }
>  ! { dg-additional-options "-march=armv8.3-a" { target aarch64-*-* } }
> -SUBROUTINE CLAREF(A, WANTZ, Z, ICOL1, ITMP1, ITMP2, T1, T2, V2)
> +SUBROUTINE CLAREF(A, WANTZ, Z, ICOL1, ITMP1, ITMP2, T1, T2, V2, LDA)
>  LOGICAL            BLOCK, WANTZ
>  COMPLEX            T1, T2, V2
>  COMPLEX            A(LDA, *), VECS, Z(LDA, *)
> --
> 2.43.0
>
>

Re: [PATCH v3 0/2] fortran: Fix specification checks [PR111781]

[Paul Richard Thomas]

[-- Attachment #1: Type: text/plain, Size: 2216 bytes --]

Hi Mikael,

Sorry, I am replying to these in the order that they appear in my intray :-)

OK for mainline and, if you wish, 13-branch.

Thanks

Paul


On Tue, 19 Mar 2024 at 15:49, Mikael Morin <mikael@gcc.gnu.org> wrote:

> Hello,
>
> these patches correct diagnostics dealing with variables in specification
> expressions.
> The first patch is a testsuite change, which fixes invalid specification
> expressions that the second patch would diagnose.
> The second patch removes a spurious diagnostic when a dummy procedure is
> involved, and enables more valid ones, as visible in the testcases from the
> first patch.
>
> I haven't tested it again (same code as v2), but I plan to do it before
> the final push.
> Ok for master?
>
> Mikael
>
> v2 -> v3 changes:
>
>   - Correct first name in testcase comment
>   - Clarify and correct log and changelog text from second patch
>   - Target current stage (stage4) instead of next (stage1)
>
> v1 -> v2 changes:
>
>   - Fix condition guarding sym->result access.
>
>
> Mikael Morin (2):
>   testsuite: Declare fortran array bound variables
>   fortran: Fix specification expression error with dummy procedures
>     [PR111781]
>
>  gcc/fortran/expr.cc                           |  8 +-
>  gcc/fortran/gfortran.h                        |  4 +-
>  gcc/fortran/resolve.cc                        | 77 +++++++++----------
>  gcc/fortran/symbol.cc                         | 58 ++++++++++++++
>  .../gfortran.dg/graphite/pr107865.f90         |  2 +-
>  gcc/testsuite/gfortran.dg/pr101267.f90        |  2 +-
>  gcc/testsuite/gfortran.dg/pr112404.f90        |  2 +-
>  gcc/testsuite/gfortran.dg/pr78061.f           |  2 +-
>  gcc/testsuite/gfortran.dg/pr79315.f90         |  6 +-
>  gcc/testsuite/gfortran.dg/spec_expr_8.f90     | 24 ++++++
>  gcc/testsuite/gfortran.dg/spec_expr_9.f90     | 19 +++++
>  gcc/testsuite/gfortran.dg/vect/pr90681.f      |  2 +-
>  gcc/testsuite/gfortran.dg/vect/pr97761.f90    |  2 +-
>  gcc/testsuite/gfortran.dg/vect/pr99746.f90    |  2 +-
>  14 files changed, 152 insertions(+), 58 deletions(-)
>  create mode 100644 gcc/testsuite/gfortran.dg/spec_expr_8.f90
>  create mode 100644 gcc/testsuite/gfortran.dg/spec_expr_9.f90
>
> --
> 2.43.0
>
>

Re: [PATCH v3 2/2] fortran: Fix specification expression error with dummy procedures [PR111781]

[Paul Richard Thomas]

[-- Attachment #1: Type: text/plain, Size: 14132 bytes --]

Hi Mikael,

This is very good. I am pleased to see global variables disappear and I
like the new helper functions.

As before, OK for mainline and, if you wish, 13-branch.

Thanks

Paul


On Tue, 19 Mar 2024 at 15:49, Mikael Morin <mikael@gcc.gnu.org> wrote:

> This fixes a spurious invalid variable in specification expression error.
> The error was caused on the testcase from the PR by two different bugs.
> First, the call to is_parent_of_current_ns was unable to recognize
> correct host association and returned false.  Second, an ad-hoc
> condition coming next was using a global variable previously improperly
> restored to false (instead of restoring it to its initial value).  The
> latter happened on the testcase because one dummy argument was a procedure,
> and checking that argument what causing a check of all its arguments with
> the (improper) reset of the flag at the end, and that preceded the check of
> the next argument.
>
> For the first bug, the wrong result of is_parent_of_current_ns is fixed by
> correcting the namespaces that function deals with, both the one passed
> as argument and the current one tracked in the gfc_current_ns global.  Two
> new functions are introduced to select the right namespace.
>
> Regarding the second bug, the problematic condition is removed, together
> with the formal_arg_flag associated with it.  Indeed, that condition was
> (wrongly) allowing local variables to be used in array bounds of dummy
> arguments.
>
>         PR fortran/111781
>
> gcc/fortran/ChangeLog:
>
>         * symbol.cc (gfc_get_procedure_ns, gfc_get_spec_ns): New functions.
>         * gfortran.h (gfc_get_procedure_ns, gfc_get_spec ns): Declare them.
>         (gfc_is_formal_arg): Remove.
>         * expr.cc (check_restricted): Remove special case allowing local
>         variable in dummy argument bound expressions.  Use gfc_get_spec_ns
>         to get the right namespace.
>         * resolve.cc (gfc_is_formal_arg, formal_arg_flag): Remove.
>         (gfc_resolve_formal_arglist): Set gfc_current_ns.  Quit loop and
>         restore gfc_current_ns instead of early returning.
>         (resolve_symbol): Factor common array spec resolution code to...
>         (resolve_symbol_array_spec): ... this new function.  Additionnally
>         set and restore gfc_current_ns.
>
> gcc/testsuite/ChangeLog:
>
>         * gfortran.dg/spec_expr_8.f90: New test.
>         * gfortran.dg/spec_expr_9.f90: New test.
> ---
>  gcc/fortran/expr.cc                       |  8 +--
>  gcc/fortran/gfortran.h                    |  4 +-
>  gcc/fortran/resolve.cc                    | 77 +++++++++++------------
>  gcc/fortran/symbol.cc                     | 58 +++++++++++++++++
>  gcc/testsuite/gfortran.dg/spec_expr_8.f90 | 24 +++++++
>  gcc/testsuite/gfortran.dg/spec_expr_9.f90 | 19 ++++++
>  6 files changed, 140 insertions(+), 50 deletions(-)
>  create mode 100644 gcc/testsuite/gfortran.dg/spec_expr_8.f90
>  create mode 100644 gcc/testsuite/gfortran.dg/spec_expr_9.f90
>
> diff --git a/gcc/fortran/expr.cc b/gcc/fortran/expr.cc
> index e4b1e8307e3..9a042cd7040 100644
> --- a/gcc/fortran/expr.cc
> +++ b/gcc/fortran/expr.cc
> @@ -3514,19 +3514,13 @@ check_restricted (gfc_expr *e)
>        if (!check_references (e->ref, &check_restricted))
>         break;
>
> -      /* gfc_is_formal_arg broadcasts that a formal argument list is being
> -        processed in resolve.cc(resolve_formal_arglist).  This is done so
> -        that host associated dummy array indices are accepted (PR23446).
> -        This mechanism also does the same for the specification
> expressions
> -        of array-valued functions.  */
>        if (e->error
>             || sym->attr.in_common
>             || sym->attr.use_assoc
>             || sym->attr.dummy
>             || sym->attr.implied_index
>             || sym->attr.flavor == FL_PARAMETER
> -           || is_parent_of_current_ns (sym->ns)
> -           || (gfc_is_formal_arg () && (sym->ns == gfc_current_ns)))
> +           || is_parent_of_current_ns (gfc_get_spec_ns (sym)))
>         {
>           t = true;
>           break;
> diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
> index c7039730fad..26aa56b3358 100644
> --- a/gcc/fortran/gfortran.h
> +++ b/gcc/fortran/gfortran.h
> @@ -3612,6 +3612,9 @@ bool gfc_is_associate_pointer (gfc_symbol*);
>  gfc_symbol * gfc_find_dt_in_generic (gfc_symbol *);
>  gfc_formal_arglist *gfc_sym_get_dummy_args (gfc_symbol *);
>
> +gfc_namespace * gfc_get_procedure_ns (gfc_symbol *);
> +gfc_namespace * gfc_get_spec_ns (gfc_symbol *);
> +
>  /* intrinsic.cc -- true if working in an init-expr, false otherwise.  */
>  extern bool gfc_init_expr_flag;
>
> @@ -3821,7 +3824,6 @@ bool gfc_resolve_iterator (gfc_iterator *, bool,
> bool);
>  bool find_forall_index (gfc_expr *, gfc_symbol *, int);
>  bool gfc_resolve_index (gfc_expr *, int);
>  bool gfc_resolve_dim_arg (gfc_expr *);
> -bool gfc_is_formal_arg (void);
>  bool gfc_resolve_substring (gfc_ref *, bool *);
>  void gfc_resolve_substring_charlen (gfc_expr *);
>  gfc_expr *gfc_expr_to_initialize (gfc_expr *);
> diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
> index c5ae826bd6e..50d51b06c92 100644
> --- a/gcc/fortran/resolve.cc
> +++ b/gcc/fortran/resolve.cc
> @@ -72,9 +72,6 @@ static bool first_actual_arg = false;
>
>  static int omp_workshare_flag;
>
> -/* True if we are processing a formal arglist. The corresponding function
> -   resets the flag each time that it is read.  */
> -static bool formal_arg_flag = false;
>
>  /* True if we are resolving a specification expression.  */
>  static bool specification_expr = false;
> @@ -89,12 +86,6 @@ static bitmap_obstack labels_obstack;
>  static bool inquiry_argument = false;
>
>
> -bool
> -gfc_is_formal_arg (void)
> -{
> -  return formal_arg_flag;
> -}
> -
>  /* Is the symbol host associated?  */
>  static bool
>  is_sym_host_assoc (gfc_symbol *sym, gfc_namespace *ns)
> @@ -285,7 +276,8 @@ gfc_resolve_formal_arglist (gfc_symbol *proc)
>        sym->attr.always_explicit = 1;
>      }
>
> -  formal_arg_flag = true;
> +  gfc_namespace *orig_current_ns = gfc_current_ns;
> +  gfc_current_ns = gfc_get_procedure_ns (proc);
>
>    for (f = proc->formal; f; f = f->next)
>      {
> @@ -306,17 +298,18 @@ gfc_resolve_formal_arglist (gfc_symbol *proc)
>                        &proc->declared_at);
>           continue;
>         }
> -      else if (sym->attr.procedure && sym->attr.if_source != IFSRC_DECL
> +
> +      if (sym->attr.procedure && sym->attr.if_source != IFSRC_DECL
>                && !resolve_procedure_interface (sym))
> -       return;
> +       break;
>
>        if (strcmp (proc->name, sym->name) == 0)
> -        {
> -          gfc_error ("Self-referential argument "
> -                     "%qs at %L is not allowed", sym->name,
> -                     &proc->declared_at);
> -          return;
> -        }
> +       {
> +         gfc_error ("Self-referential argument "
> +                    "%qs at %L is not allowed", sym->name,
> +                    &proc->declared_at);
> +         break;
> +       }
>
>        if (sym->attr.if_source != IFSRC_UNKNOWN)
>         gfc_resolve_formal_arglist (sym);
> @@ -533,7 +526,8 @@ gfc_resolve_formal_arglist (gfc_symbol *proc)
>             }
>         }
>      }
> -  formal_arg_flag = false;
> +
> +  gfc_current_ns = orig_current_ns;
>  }
>
>
> @@ -16206,6 +16200,26 @@ resolve_pdt (gfc_symbol* sym)
>  }
>
>
> +/* Resolve the symbol's array spec.  */
> +
> +static bool
> +resolve_symbol_array_spec (gfc_symbol *sym, int check_constant)
> +{
> +  gfc_namespace *orig_current_ns = gfc_current_ns;
> +  gfc_current_ns = gfc_get_spec_ns (sym);
> +
> +  bool saved_specification_expr = specification_expr;
> +  specification_expr = true;
> +
> +  bool result = gfc_resolve_array_spec (sym->as, check_constant);
> +
> +  specification_expr = saved_specification_expr;
> +  gfc_current_ns = orig_current_ns;
> +
> +  return result;
> +}
> +
> +
>  /* Do anything necessary to resolve a symbol.  Right now, we just
>     assume that an otherwise unknown symbol is a variable.  This sort
>     of thing commonly happens for symbols in module.  */
> @@ -16220,7 +16234,6 @@ resolve_symbol (gfc_symbol *sym)
>    gfc_component *c;
>    symbol_attribute class_attr;
>    gfc_array_spec *as;
> -  bool saved_specification_expr;
>
>    if (sym->resolve_symbol_called >= 1)
>      return;
> @@ -16385,16 +16398,7 @@ resolve_symbol (gfc_symbol *sym)
>         }
>      }
>    else if (mp_flag && sym->attr.flavor == FL_PROCEDURE &&
> sym->attr.function)
> -    {
> -      bool saved_specification_expr = specification_expr;
> -      bool saved_formal_arg_flag = formal_arg_flag;
> -
> -      specification_expr = true;
> -      formal_arg_flag = true;
> -      gfc_resolve_array_spec (sym->result->as, false);
> -      formal_arg_flag = saved_formal_arg_flag;
> -      specification_expr = saved_specification_expr;
> -    }
> +    resolve_symbol_array_spec (sym->result, false);
>
>    /* For a CLASS-valued function with a result variable, affirm that it
> has
>       been resolved also when looking at the symbol 'sym'.  */
> @@ -16961,18 +16965,7 @@ resolve_symbol (gfc_symbol *sym)
>
>    check_constant = sym->attr.in_common && !sym->attr.pointer &&
> !sym->error;
>
> -  /* Set the formal_arg_flag so that check_conflict will not throw
> -     an error for host associated variables in the specification
> -     expression for an array_valued function.  */
> -  if ((sym->attr.function || sym->attr.result) && sym->as)
> -    formal_arg_flag = true;
> -
> -  saved_specification_expr = specification_expr;
> -  specification_expr = true;
> -  gfc_resolve_array_spec (sym->as, check_constant);
> -  specification_expr = saved_specification_expr;
> -
> -  formal_arg_flag = false;
> +  resolve_symbol_array_spec (sym, check_constant);
>
>    /* Resolve formal namespaces.  */
>    if (sym->formal_ns && sym->formal_ns != gfc_current_ns
> diff --git a/gcc/fortran/symbol.cc b/gcc/fortran/symbol.cc
> index 16adb2a7efb..3a3b6de5cec 100644
> --- a/gcc/fortran/symbol.cc
> +++ b/gcc/fortran/symbol.cc
> @@ -5408,3 +5408,61 @@ gfc_sym_get_dummy_args (gfc_symbol *sym)
>
>    return dummies;
>  }
> +
> +
> +/* Given a procedure, returns the associated namespace.
> +   The resulting NS should match the condition NS->PROC_NAME == SYM.  */
> +
> +gfc_namespace *
> +gfc_get_procedure_ns (gfc_symbol *sym)
> +{
> +  if (sym->formal_ns
> +      && sym->formal_ns->proc_name == sym)
> +    return sym->formal_ns;
> +
> +  /* The above should have worked in most cases.  If it hasn't, try some
> other
> +     heuristics, eventually returning SYM->NS.  */
> +  if (gfc_current_ns->proc_name == sym)
> +    return gfc_current_ns;
> +
> +  /* For contained procedures, the symbol's NS field is the
> +     hosting namespace, not the procedure namespace.  */
> +  if (sym->attr.flavor == FL_PROCEDURE && sym->attr.contained)
> +    for (gfc_namespace *ns = sym->ns->contained; ns; ns = ns->sibling)
> +      if (ns->proc_name == sym)
> +       return ns;
> +
> +  if (sym->formal)
> +    for (gfc_formal_arglist *f = sym->formal; f != nullptr; f = f->next)
> +      if (f->sym)
> +       {
> +         gfc_namespace *ns = f->sym->ns;
> +         if (ns && ns->proc_name == sym)
> +           return ns;
> +       }
> +
> +  return sym->ns;
> +}
> +
> +
> +/* Given a symbol, returns the namespace in which the symbol is specified.
> +   In most cases, it is the namespace hosting the symbol.  This is the
> case
> +   for variables.  For functions, however, it is the function namespace
> +   itself.  This specification namespace is used to check conformance of
> +   array spec bound expressions.  */
> +
> +gfc_namespace *
> +gfc_get_spec_ns (gfc_symbol *sym)
> +{
> +  if (sym->attr.flavor == FL_PROCEDURE
> +      && sym->attr.function)
> +    {
> +      if (sym->result == sym)
> +       return gfc_get_procedure_ns (sym);
> +      /* Generic and intrinsic functions can have a null result.  */
> +      else if (sym->result != nullptr)
> +       return sym->result->ns;
> +    }
> +
> +  return sym->ns;
> +}
> diff --git a/gcc/testsuite/gfortran.dg/spec_expr_8.f90
> b/gcc/testsuite/gfortran.dg/spec_expr_8.f90
> new file mode 100644
> index 00000000000..77e14156497
> --- /dev/null
> +++ b/gcc/testsuite/gfortran.dg/spec_expr_8.f90
> @@ -0,0 +1,24 @@
> +! { dg-do compile }
> +!
> +! PR fortran/111781
> +! We used to reject the example below because the dummy procedure g was
> +! setting the current namespace without properly restoring it, which broke
> +! the specification expression check for the dimension of A later on.
> +!
> +! Contributed by Rasmus Vikhamar-Sandberg  <
> rasmus.vikhamar-sandberg@uit.no>
> +
> +program example
> +    implicit none
> +    integer :: n
> +
> +contains
> +
> +    subroutine f(g,A)
> +        real, intent(out) :: A(n)
> +        interface
> +          pure real(8) function g(x)
> +            real(8), intent(in) :: x
> +          end function
> +        end interface
> +    end subroutine
> +end program
> diff --git a/gcc/testsuite/gfortran.dg/spec_expr_9.f90
> b/gcc/testsuite/gfortran.dg/spec_expr_9.f90
> new file mode 100644
> index 00000000000..9024909b4e9
> --- /dev/null
> +++ b/gcc/testsuite/gfortran.dg/spec_expr_9.f90
> @@ -0,0 +1,19 @@
> +! { dg-do compile }
> +!
> +! PR fortran/111781
> +! Used to fail with Error: Variable ‘n’ cannot appear in the
> +! expression at (1) for line 16.
> +!
> +program is_it_valid
> +  dimension y(3)
> +  integer :: n = 3
> +  interface
> +    function func(x)
> +      import
> +      dimension func(n)
> +    end function
> +  end interface
> +  y=func(1.0)
> +  print *, y
> +  stop
> +end
> --
> 2.43.0
>
>