Fix bogus duplicate attribute errors for submodule functions.

        PR fortran/83113
        * array.c: Do not attempt to set the array spec for a submodule
        function symbol (as it has already been set in the corresponding
        module procedure interface).
        * symbol.c: Do not reject duplicate POINTER, ALLOCATABLE, or
        DIMENSION attributes in declarations of a submodule function.
        * gfortran.h: Add a macro that tests for a module procedure in a
        submodule.
        * gfortran.dg/pr83113.f90: New test.

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 568bb78a183f204689194fe2763862400b335612..a2f45d216c28afbb3c6439c1d73d834b5ce9d279 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,15 @@
+2020-02-10  Andrew Benson  <abensonca@gmail.com>
+
+        PR fortran/83113
+        * array.c: Do not attempt to set the array spec for a submodule
+        function symbol (as it has already been set in the corresponding
+        module procedure interface).
+        * symbol.c: Do not reject duplicate POINTER, ALLOCATABLE, or
+        DIMENSION attributes in declarations of a submodule function.
+        * gfortran.h: Add a macro that tests for a module procedure in a
+        submodule.
+        * gfortran.dg/pr83113.f90: New test.
+
 2020-02-03  Julian Brown  <julian@codesourcery.com>
            Tobias Burnus  <tobias@codesourcery.com>
 

diff --git a/gcc/fortran/array.c b/gcc/fortran/array.c
index c873cf2e09b15f6472e5889b29e07f5855715678..82b0eb39ca9a55569683b5ac42926859e99f039e 100644 (file)
--- a/gcc/fortran/array.c
+++ b/gcc/fortran/array.c
@@ -23,6 +23,7 @@ along with GCC; see the file COPYING3.  If not see
 #include "coretypes.h"
 #include "options.h"
 #include "gfortran.h"
+#include "parse.h"
 #include "match.h"
 #include "constructor.h"
 
@@ -822,7 +823,6 @@ cleanup:
   return MATCH_ERROR;
 }
 
-
 /* Given a symbol and an array specification, modify the symbol to
    have that array specification.  The error locus is needed in case
    something goes wrong.  On failure, the caller must free the spec.  */
@@ -831,10 +831,17 @@ bool
 gfc_set_array_spec (gfc_symbol *sym, gfc_array_spec *as, locus *error_loc)
 {
   int i;
-
+  symbol_attribute *attr;
+  
   if (as == NULL)
     return true;
 
+  /* If the symbol corresponds to a submodule module procedure the array spec is
+     already set, so do not attempt to set it again here. */
+  attr = &sym->attr;
+  if (gfc_submodule_procedure(attr))
+    return true;
+  
   if (as->rank
       && !gfc_add_dimension (&sym->attr, sym->name, error_loc))
     return false;

diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index dbf03fbfd4551c86782a7b12ef2079d368013bd7..96037629f5f07ecc6334304c2981e71c188cfebb 100644 (file)
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -2845,6 +2845,13 @@ bool gfc_insert_parameter_exprs (gfc_expr *, gfc_actual_arglist *);
 match gfc_get_pdt_instance (gfc_actual_arglist *, gfc_symbol **,
                            gfc_actual_arglist **);
 
+
+/* Given a symbol, test whether it is a module procedure in a submodule */
+#define gfc_submodule_procedure(attr)                               \
+  (gfc_state_stack->previous && gfc_state_stack->previous->previous  \
+   && gfc_state_stack->previous->previous->state == COMP_SUBMODULE   \
+   && attr->module_procedure)
+
 /* scanner.c */
 void gfc_scanner_done_1 (void);
 void gfc_scanner_init_1 (void);

diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c
index 96c0fc1ef30efd428163c270d78d128452b72482..59f602d80d521263ec2e23102b3a450cf3b8e766 100644 (file)
--- a/gcc/fortran/symbol.c
+++ b/gcc/fortran/symbol.c
@@ -1014,7 +1014,7 @@ gfc_add_allocatable (symbol_attribute *attr, locus *where)
   if (check_used (attr, NULL, where))
     return false;
 
-  if (attr->allocatable)
+  if (attr->allocatable && ! gfc_submodule_procedure(attr))
     {
       duplicate_attr ("ALLOCATABLE", where);
       return false;
@@ -1081,7 +1081,7 @@ gfc_add_dimension (symbol_attribute *attr, const char *name, locus *where)
   if (check_used (attr, name, where))
     return false;
 
-  if (attr->dimension)
+  if (attr->dimension && ! gfc_submodule_procedure(attr))
     {
       duplicate_attr ("DIMENSION", where);
       return false;
@@ -1208,7 +1208,8 @@ gfc_add_pointer (symbol_attribute *attr, locus *where)
     return false;
 
   if (attr->pointer && !(attr->if_source == IFSRC_IFBODY
-      && !gfc_find_state (COMP_INTERFACE)))
+      && !gfc_find_state (COMP_INTERFACE))
+      && ! gfc_submodule_procedure(attr))
     {
       duplicate_attr ("POINTER", where);
       return false;

diff --git a/gcc/testsuite/gfortran.dg/pr83113.f90 b/gcc/testsuite/gfortran.dg/pr83113.f90
new file mode 100644 (file)
index 0000000..7dbe802
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr83113.f90
@@ -0,0 +1,18 @@
+! { dg-do compile }
+! PR fortran/83113
+module mm
+  implicit none
+  interface
+     module function c()
+       integer, dimension(2)  :: c
+     end function c
+  end interface
+end module mm
+
+submodule (mm) oo
+  implicit none
+contains
+  module function c()
+    integer, dimension(3)  :: c
+  end function c
+end submodule oo