Fortran] PR 92994 – add more ASSOCIATE checks

        PR fortran/92994
        * primary.c (gfc_match_rvalue): Add some flavor checks
        gfc_matching_procptr_assignment.
        * resolve.c (resolve_assoc_var): Add more checks for invalid targets.

        PR fortran/92994
        * gfortran.dg/associate_50.f90: Update dg-error.
        * gfortran.dg/associate_51.f90: New.

From-SVN: r279853

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index c76ffcbb3e1a430512ccb725a066f4e7c7d8c24f..7f1bdc04be12d76613e59adc4b86d108ddad62b9 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,10 @@
+2020-01-03  Tobias Burnus  <tobias@codesourcery.com>
+
+       PR fortran/92994
+       * primary.c (gfc_match_rvalue): Add some flavor checks
+       gfc_matching_procptr_assignment.
+       * resolve.c (resolve_assoc_var): Add more checks for invalid targets.
+
 2020-01-02  Tobias Burnus  <tobias@codesourcery.com>
 
        PR fortran/68020

diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c
index 189b904527ee29e8bd0765502a95661c1e1b9864..e2b6fcb21062f259ec5775e078f62920d45006c4 100644 (file)
--- a/gcc/fortran/primary.c
+++ b/gcc/fortran/primary.c
@@ -3447,7 +3447,19 @@ gfc_match_rvalue (gfc_expr **result)
     }
 
   if (gfc_matching_procptr_assignment)
-    goto procptr0;
+    {
+      /* It can be a procedure or a derived-type procedure or a not-yet-known
+        type.  */
+      if (sym->attr.flavor != FL_UNKNOWN
+         && sym->attr.flavor != FL_PROCEDURE
+         && sym->attr.flavor != FL_PARAMETER
+         && sym->attr.flavor != FL_VARIABLE)
+       {
+         gfc_error ("Symbol at %C is not appropriate for an expression");
+         return MATCH_ERROR;
+       }
+      goto procptr0;
+    }
 
   if (sym->attr.function || sym->attr.external || sym->attr.intrinsic)
     goto function0;

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 4aa5f1b568a96f32b2681ae285a87ac87f45c3cc..6f2a4c4d65aa1384a07a7df3cfc40fc54da54e69 100644 (file)
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -8836,9 +8836,20 @@ resolve_assoc_var (gfc_symbol* sym, bool resolve_target)
 
       gcc_assert (target->symtree);
       tsym = target->symtree->n.sym;
-      if (tsym->attr.flavor == FL_PROGRAM)
+
+      if (tsym->attr.subroutine
+         || tsym->attr.external
+         || (tsym->attr.function
+             && (tsym->result != tsym || tsym->attr.recursive)))
        {
-         gfc_error ("Associating entity %qs at %L is a PROGRAM",
+         gfc_error ("Associating entity %qs at %L is a procedure name",
+                    tsym->name, &target->where);
+         return;
+       }
+
+      if (gfc_expr_attr (target).proc_pointer)
+       {
+         gfc_error ("Associating entity %qs at %L is a procedure pointer",
                     tsym->name, &target->where);
          return;
        }
@@ -8851,6 +8862,12 @@ resolve_assoc_var (gfc_symbol* sym, bool resolve_target)
       if (is_subref_array (target))
        sym->attr.subref_array_pointer = 1;
     }
+  else if (target->ts.type == BT_PROCEDURE)
+    {
+      gfc_error ("Associating selector-expression at %L yields a procedure",
+                &target->where);
+      return;
+    }
 
   if (target->expr_type == EXPR_NULL)
     {

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 07947c15d5ea6f3730a43e5b5401ad66b16b118f..2a3a45e46896b8ad99cd06c43ab09a30aa2d63d4 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+2020-01-03  Tobias Burnus  <tobias@codesourcery.com>
+
+       PR fortran/92994
+       * gfortran.dg/associate_50.f90: Update dg-error.
+       * gfortran.dg/associate_51.f90: New.
+
 2020-01-03  Jakub Jelinek  <jakub@redhat.com>
 
        PR fortran/68020

diff --git a/gcc/testsuite/gfortran.dg/associate_50.f90 b/gcc/testsuite/gfortran.dg/associate_50.f90
index d759db59b29290f6c2ecb86bd33f78f3c5f77f0a..990ec58bffe13833ae53148d74d93f4dd600151e 100644 (file)
--- a/gcc/testsuite/gfortran.dg/associate_50.f90
+++ b/gcc/testsuite/gfortran.dg/associate_50.f90
@@ -3,6 +3,6 @@
 ! Test case by Gerhard Steinmetz.
 
 program p
-  associate (y => p) ! { dg-error "is a PROGRAM" }
-  end associate
+  associate (y => p) ! { dg-error "Invalid association target" }
+  end associate  ! { dg-error "Expecting END PROGRAM statement" }
 end program p

diff --git a/gcc/testsuite/gfortran.dg/associate_51.f90 b/gcc/testsuite/gfortran.dg/associate_51.f90
new file mode 100644 (file)
index 0000000..7b3edc4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/associate_51.f90
@@ -0,0 +1,54 @@
+! { dg-do compile }
+!
+! PR fortran/92994
+!
+! Contributed by G. Steinmetz
+!
+recursive function f() result(z)
+  associate (y1 => f())
+  end associate
+  associate (y2 => f)  ! { dg-error "is a procedure name" }
+  end associate
+end
+
+recursive function f2()
+  associate (y1 => f2()) ! { dg-error "Invalid association target" }
+  end associate          ! { dg-error "Expecting END FUNCTION statement" }
+  associate (y2 => f2)   ! { dg-error "is a procedure name" }
+  end associate
+end
+
+subroutine p2
+  type t
+  end type
+  type(t) :: z = t()
+  associate (y => t)
+  end associate
+end
+
+subroutine p3
+  procedure() :: g
+  associate (y => g)  ! { dg-error "is a procedure name" }
+  end associate
+end
+
+subroutine p4
+  external :: g
+  associate (y => g)  ! { dg-error "is a procedure name" }
+  end associate
+end
+
+recursive subroutine s
+  associate (y => s)  ! { dg-error "is a procedure name" }
+  end associate
+end
+
+recursive subroutine s2
+   associate (y => (s2)) ! { dg-error "Associating selector-expression at .1. yields a procedure" }
+   end associate
+end
+
+program p
+   associate (y => (p)) ! { dg-error "Invalid association target" }
+   end associate ! { dg-error "Expecting END PROGRAM statement" }
+end