Fortran] Reject invalid association target (PR93363)

	PR fortran/93363
	* resolve.c (resolve_assoc_var): Reject association to DT and
	function name.

	PR fortran/93363
	* gfortran.dg/associate_51.f90: Fix test case.
	* gfortran.dg/associate_53.f90: New.

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 0f6dab3b3c2e843638eda90f3ac67ceef6970b07..39aa22df298d8f8bc71bf0bcc2f3f0f290b682bb 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+2020-03-27  Tobias Burnus  <tobias@codesourcery.com>
+
+       PR fortran/93363
+       * resolve.c (resolve_assoc_var): Reject association to DT and
+       function name.
+
 2020-03-25  Steven G. Kargl  <kargl@gcc.gnu.org>
 
        PR fortran/93484

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 2dcb261fc7148327c07f86f74ab992e6c5881d03..b6277d236da7aef72dea98986065d2c00b99bd27 100644 (file)
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -8868,27 +8868,45 @@ resolve_assoc_var (gfc_symbol* sym, bool resolve_target)
   /* For variable targets, we get some attributes from the target.  */
   if (target->expr_type == EXPR_VARIABLE)
     {
-      gfc_symbol* tsym;
+      gfc_symbol *tsym, *dsym;
 
       gcc_assert (target->symtree);
       tsym = target->symtree->n.sym;
 
-      if (tsym->attr.subroutine
-         || tsym->attr.external
-         || (tsym->attr.function && tsym->result != tsym))
+      if (gfc_expr_attr (target).proc_pointer)
        {
-         gfc_error ("Associating entity %qs at %L is a procedure name",
+         gfc_error ("Associating entity %qs at %L is a procedure pointer",
                     tsym->name, &target->where);
          return;
        }
 
-      if (gfc_expr_attr (target).proc_pointer)
+      if (tsym->attr.flavor == FL_PROCEDURE && tsym->generic
+         && (dsym = gfc_find_dt_in_generic (tsym)) != NULL
+         && dsym->attr.flavor == FL_DERIVED)
        {
-         gfc_error ("Associating entity %qs at %L is a procedure pointer",
+         gfc_error ("Derived type %qs cannot be used as a variable at %L",
                     tsym->name, &target->where);
          return;
        }
 
+      if (tsym->attr.flavor == FL_PROCEDURE)
+       {
+         bool is_error = true;
+         if (tsym->attr.function && tsym->result == tsym)
+           for (gfc_namespace *ns = sym->ns; ns; ns = ns->parent)
+             if (tsym == ns->proc_name)
+               {
+                 is_error = false;
+                 break;
+               }
+         if (is_error)
+           {
+             gfc_error ("Associating entity %qs at %L is a procedure name",
+                        tsym->name, &target->where);
+             return;
+           }
+       }
+
       sym->attr.asynchronous = tsym->attr.asynchronous;
       sym->attr.volatile_ = tsym->attr.volatile_;
 

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 5f9b164d4863caa85375caa0e2be66fd92c5ab0d..8107f0089994a66a195e61a96c287c33d4499c32 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+2020-03-27  Tobias Burnus  <tobias@codesourcery.com>
+
+       PR fortran/93363
+       * gfortran.dg/associate_51.f90: Fix test case.
+       * gfortran.dg/associate_53.f90: New.
+
 2020-03-27  Jakub Jelinek  <jakub@redhat.com>
 
        PR c++/94326

diff --git a/gcc/testsuite/gfortran.dg/associate_51.f90 b/gcc/testsuite/gfortran.dg/associate_51.f90
index b6ab1414b02ed33742d896a74fbdb21f8f2ff0f4..e6f2e4fafa37c196e379bcbb7c72b32cd18ed704 100644 (file)
--- a/gcc/testsuite/gfortran.dg/associate_51.f90
+++ b/gcc/testsuite/gfortran.dg/associate_51.f90
@@ -29,7 +29,7 @@ subroutine p2
   type t
   end type
   type(t) :: z = t()
-  associate (y => t)
+  associate (y => t())
   end associate
 end
 

diff --git a/gcc/testsuite/gfortran.dg/associate_53.f90 b/gcc/testsuite/gfortran.dg/associate_53.f90
new file mode 100644 (file)
index 0000000..5b56af3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/associate_53.f90
@@ -0,0 +1,71 @@
+! { dg-do compile }
+!
+! PR fortran/93363
+!
+! Contributed by G. Steinmetz
+
+program p
+   type t
+      integer :: a
+   end type
+   type(t) :: z
+   z = t(1)
+   associate (var1 => t)  ! { dg-error "Derived type 't' cannot be used as a variable" }
+   end associate
+end
+
+subroutine sub
+   if (f() /= 1) stop
+   associate (var2 => f)  ! { dg-error "Associating entity 'f' at .1. is a procedure name" }
+   end associate
+   block
+      block
+        associate (var2a => f)  ! { dg-error "Associating entity 'f' at .1. is a procedure name" }
+        end associate
+      end block
+    end block
+contains
+   integer function f()
+      f = 1
+      associate (var3 => f)
+      end associate
+      block
+        block
+          associate (var4 => f)
+          end associate
+        end block
+      end block
+   end
+   integer recursive function f2() result(res)
+      res = 1
+      associate (var5 => f2)  ! { dg-error "Associating entity 'f2' at .1. is a procedure name" }
+      end associate
+      block
+        block
+          associate (var6 => f2)  ! { dg-error "Associating entity 'f2' at .1. is a procedure name" }
+          end associate
+        end block
+      end block
+   end
+   subroutine subsub
+      associate (var7 => f)  ! { dg-error "Associating entity 'f' at .1. is a procedure name" }
+      end associate
+      block
+        block
+          associate (var8 => f)  ! { dg-error "Associating entity 'f' at .1. is a procedure name" }
+          end associate
+        end block
+      end block
+   end
+end
+
+subroutine sub2
+   interface g
+      procedure s
+   end interface
+   associate (var9 => g)  ! { dg-error "Associating entity 'g' at .1. is a procedure name" }
+   end associate
+contains
+   subroutine s
+   end
+end