[Fortran] Reject invalid association target (PR93363)

2020-03-27  Tobias Burnus  <tobias@codesourcery.com>

	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.

 gcc/fortran/resolve.c                      | 32 +++++++++++---
 gcc/testsuite/gfortran.dg/associate_51.f90 |  2 +-
 gcc/testsuite/gfortran.dg/associate_53.f90 | 71 ++++++++++++++++++++++++++++++
 3 files changed, 97 insertions(+), 8 deletions(-)

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 2dcb261fc71..b6277d236da 100644
--- 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/gfortran.dg/associate_51.f90 b/gcc/testsuite/gfortran.dg/associate_51.f90
index b6ab1414b02..e6f2e4fafa3 100644
--- 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
index 00000000000..5b56af38e47
--- /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