Commit 7848054c by Andrew Benson

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.
parent 0cc575e4
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> 2020-02-03 Julian Brown <julian@codesourcery.com>
Tobias Burnus <tobias@codesourcery.com> Tobias Burnus <tobias@codesourcery.com>
......
...@@ -23,6 +23,7 @@ along with GCC; see the file COPYING3. If not see ...@@ -23,6 +23,7 @@ along with GCC; see the file COPYING3. If not see
#include "coretypes.h" #include "coretypes.h"
#include "options.h" #include "options.h"
#include "gfortran.h" #include "gfortran.h"
#include "parse.h"
#include "match.h" #include "match.h"
#include "constructor.h" #include "constructor.h"
...@@ -822,7 +823,6 @@ cleanup: ...@@ -822,7 +823,6 @@ cleanup:
return MATCH_ERROR; return MATCH_ERROR;
} }
/* Given a symbol and an array specification, modify the symbol to /* Given a symbol and an array specification, modify the symbol to
have that array specification. The error locus is needed in case have that array specification. The error locus is needed in case
something goes wrong. On failure, the caller must free the spec. */ something goes wrong. On failure, the caller must free the spec. */
...@@ -831,10 +831,17 @@ bool ...@@ -831,10 +831,17 @@ bool
gfc_set_array_spec (gfc_symbol *sym, gfc_array_spec *as, locus *error_loc) gfc_set_array_spec (gfc_symbol *sym, gfc_array_spec *as, locus *error_loc)
{ {
int i; int i;
symbol_attribute *attr;
if (as == NULL) if (as == NULL)
return true; 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 if (as->rank
&& !gfc_add_dimension (&sym->attr, sym->name, error_loc)) && !gfc_add_dimension (&sym->attr, sym->name, error_loc))
return false; return false;
......
...@@ -2845,6 +2845,13 @@ bool gfc_insert_parameter_exprs (gfc_expr *, gfc_actual_arglist *); ...@@ -2845,6 +2845,13 @@ bool gfc_insert_parameter_exprs (gfc_expr *, gfc_actual_arglist *);
match gfc_get_pdt_instance (gfc_actual_arglist *, gfc_symbol **, match gfc_get_pdt_instance (gfc_actual_arglist *, gfc_symbol **,
gfc_actual_arglist **); 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 */ /* scanner.c */
void gfc_scanner_done_1 (void); void gfc_scanner_done_1 (void);
void gfc_scanner_init_1 (void); void gfc_scanner_init_1 (void);
......
...@@ -1014,7 +1014,7 @@ gfc_add_allocatable (symbol_attribute *attr, locus *where) ...@@ -1014,7 +1014,7 @@ gfc_add_allocatable (symbol_attribute *attr, locus *where)
if (check_used (attr, NULL, where)) if (check_used (attr, NULL, where))
return false; return false;
if (attr->allocatable) if (attr->allocatable && ! gfc_submodule_procedure(attr))
{ {
duplicate_attr ("ALLOCATABLE", where); duplicate_attr ("ALLOCATABLE", where);
return false; return false;
...@@ -1081,7 +1081,7 @@ gfc_add_dimension (symbol_attribute *attr, const char *name, locus *where) ...@@ -1081,7 +1081,7 @@ gfc_add_dimension (symbol_attribute *attr, const char *name, locus *where)
if (check_used (attr, name, where)) if (check_used (attr, name, where))
return false; return false;
if (attr->dimension) if (attr->dimension && ! gfc_submodule_procedure(attr))
{ {
duplicate_attr ("DIMENSION", where); duplicate_attr ("DIMENSION", where);
return false; return false;
...@@ -1208,7 +1208,8 @@ gfc_add_pointer (symbol_attribute *attr, locus *where) ...@@ -1208,7 +1208,8 @@ gfc_add_pointer (symbol_attribute *attr, locus *where)
return false; return false;
if (attr->pointer && !(attr->if_source == IFSRC_IFBODY 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); duplicate_attr ("POINTER", where);
return false; return false;
......
! { 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
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment