Dear All,
It took me an excessively long time to realise that processing the
typespec for an explicitly typed module procedure was wiping out the
interface symbol and so preventing the comparison of characteristics
between the interface and the separate module procedure. Transferring
the module interface symbol to the tlink field, rather than the
interface, fixed the problem without doing anything else.
Note the comment in the gfortran.h about the use of the tlink field.
It has been a while since this was used for change management. If it
is preferred, I could introduce a union between tlink and some other
suitable name; eg mod_proc_interface.
Bootstraps and regtests on FC21/x86_64.
OK for trunk and, after a decent interval, 6-branch?
Paul
2016-12-06 Paul Thomas <pa...@gcc.gnu.org>
PR fortran/77903
* decl.c (get_proc_name): Use the symbol tlink field instead of
the typespec interface field.
(gfc_match_function_decl, gfc_match_submod_proc): Ditto.
* gfortran.h : Since the symbol tlink field is no longer used
by the frontend for change management, change the comment to
reflect its current uses.
* parse.c (get_modproc_result): Same as decl.c changes.
* resolve.c (resolve_fl_procedure): Ditto.
2016-12-06 Paul Thomas <pa...@gcc.gnu.org>
PR fortran/77903
* gfortran.dg/submodule_20.f08: New test.
Index: gcc/fortran/decl.c
===================================================================
*** gcc/fortran/decl.c (revision 243235)
--- gcc/fortran/decl.c (working copy)
*************** get_proc_name (const char *name, gfc_sym
*** 1119,1130 ****
{
/* Create a partially populated interface symbol to carry the
characteristics of the procedure and the result. */
! sym->ts.interface = gfc_new_symbol (name, sym->ns);
! gfc_add_type (sym->ts.interface, &(sym->ts),
&gfc_current_locus);
! gfc_copy_attr (&sym->ts.interface->attr, &sym->attr, NULL);
if (sym->attr.dimension)
! sym->ts.interface->as = gfc_copy_array_spec (sym->as);
/* Ideally, at this point, a copy would be made of the formal
arguments and their namespace. However, this does not appear
--- 1119,1130 ----
{
/* Create a partially populated interface symbol to carry the
characteristics of the procedure and the result. */
! sym->tlink = gfc_new_symbol (name, sym->ns);
! gfc_add_type (sym->tlink, &(sym->ts),
&gfc_current_locus);
! gfc_copy_attr (&sym->tlink->attr, &sym->attr, NULL);
if (sym->attr.dimension)
! sym->tlink->as = gfc_copy_array_spec (sym->as);
/* Ideally, at this point, a copy would be made of the formal
arguments and their namespace. However, this does not appear
*************** get_proc_name (const char *name, gfc_sym
*** 1133,1144 ****
if (sym->result && sym->result != sym)
{
! sym->ts.interface->result = sym->result;
sym->result = NULL;
}
else if (sym->result)
{
! sym->ts.interface->result = sym->ts.interface;
}
}
else if (sym && !sym->gfc_new
--- 1133,1144 ----
if (sym->result && sym->result != sym)
{
! sym->tlink->result = sym->result;
sym->result = NULL;
}
else if (sym->result)
{
! sym->tlink->result = sym->tlink;
}
}
else if (sym && !sym->gfc_new
*************** gfc_match_function_decl (void)
*** 6063,6069 ****
sym->result = result;
}
-
/* Warn if this procedure has the same name as an intrinsic. */
do_warn_intrinsic_shadow (sym, true);
--- 6063,6068 ----
*************** gfc_match_submod_proc (void)
*** 8254,8264 ****
/* Make sure that the result field is appropriately filled, even though
the result symbol will be replaced later on. */
! if (sym->ts.interface && sym->ts.interface->attr.function)
{
! if (sym->ts.interface->result
! && sym->ts.interface->result != sym->ts.interface)
! sym->result= sym->ts.interface->result;
else
sym->result = sym;
}
--- 8253,8263 ----
/* Make sure that the result field is appropriately filled, even though
the result symbol will be replaced later on. */
! if (sym->tlink && sym->tlink->attr.function)
{
! if (sym->tlink->result
! && sym->tlink->result != sym->tlink)
! sym->result= sym->tlink->result;
else
sym->result = sym;
}
Index: gcc/fortran/gfortran.h
===================================================================
*** gcc/fortran/gfortran.h (revision 243235)
--- gcc/fortran/gfortran.h (working copy)
*************** typedef struct gfc_symbol
*** 1532,1545 ****
gfc_namelist *namelist, *namelist_tail;
/* Change management fields. Symbols that might be modified by the
! current statement have the mark member nonzero and are kept in a
! singly linked list through the tlink field. Of these symbols,
symbols with old_symbol equal to NULL are symbols created within
the current statement. Otherwise, old_symbol points to a copy of
! the old symbol. */
!
! struct gfc_symbol *old_symbol, *tlink;
unsigned mark:1, gfc_new:1;
/* Nonzero if all equivalences associated with this symbol have been
processed. */
unsigned equiv_built:1;
--- 1532,1551 ----
gfc_namelist *namelist, *namelist_tail;
/* Change management fields. Symbols that might be modified by the
! current statement have the mark member nonzero. Of these symbols,
symbols with old_symbol equal to NULL are symbols created within
the current statement. Otherwise, old_symbol points to a copy of
! the old symbol. gfc_new is used in symbol.c to flag new symbols. */
! struct gfc_symbol *old_symbol;
unsigned mark:1, gfc_new:1;
+
+ /* The tlink field is used in the front end to carry the module
+ declaration of separate module procedures so that the characteristics
+ can be compared with the corresponding declaration in a submodule. In
+ translation this field carries a linked list of symbols that require
+ deferred initialization. */
+ struct gfc_symbol *tlink;
+
/* Nonzero if all equivalences associated with this symbol have been
processed. */
unsigned equiv_built:1;
Index: gcc/fortran/parse.c
===================================================================
*** gcc/fortran/parse.c (revision 243235)
--- gcc/fortran/parse.c (working copy)
*************** get_modproc_result (void)
*** 5586,5596 ****
proc = gfc_current_ns->proc_name ? gfc_current_ns->proc_name : NULL;
if (proc != NULL
&& proc->attr.function
! && proc->ts.interface
! && proc->ts.interface->result
! && proc->ts.interface->result != proc->ts.interface)
{
! gfc_copy_dummy_sym (&proc->result, proc->ts.interface->result, 1);
gfc_set_sym_referenced (proc->result);
proc->result->attr.if_source = IFSRC_DECL;
gfc_commit_symbol (proc->result);
--- 5586,5596 ----
proc = gfc_current_ns->proc_name ? gfc_current_ns->proc_name : NULL;
if (proc != NULL
&& proc->attr.function
! && proc->tlink
! && proc->tlink->result
! && proc->tlink->result != proc->tlink)
{
! gfc_copy_dummy_sym (&proc->result, proc->tlink->result, 1);
gfc_set_sym_referenced (proc->result);
proc->result->attr.if_source = IFSRC_DECL;
gfc_commit_symbol (proc->result);
Index: gcc/fortran/resolve.c
===================================================================
*** gcc/fortran/resolve.c (revision 243235)
--- gcc/fortran/resolve.c (working copy)
*************** resolve_fl_procedure (gfc_symbol *sym, i
*** 12274,12283 ****
module_name = strtok (name, ".");
submodule_name = strtok (NULL, ".");
! /* Stop the dummy characteristics test from using the interface
! symbol instead of 'sym'. */
! iface = sym->ts.interface;
! sym->ts.interface = NULL;
/* Make sure that the result uses the correct charlen for deferred
length results. */
--- 12274,12281 ----
module_name = strtok (name, ".");
submodule_name = strtok (NULL, ".");
! iface = sym->tlink;
! sym->tlink = NULL;
/* Make sure that the result uses the correct charlen for deferred
length results. */
*************** resolve_fl_procedure (gfc_symbol *sym, i
*** 12325,12331 ****
}
check_formal:
! /* Check the charcateristics of the formal arguments. */
if (sym->formal && sym->formal_ns)
{
for (arg = sym->formal; arg && arg->sym; arg = arg->next)
--- 12323,12329 ----
}
check_formal:
! /* Check the characteristics of the formal arguments. */
if (sym->formal && sym->formal_ns)
{
for (arg = sym->formal; arg && arg->sym; arg = arg->next)
*************** check_formal:
*** 12334,12341 ****
gfc_traverse_ns (sym->formal_ns, compare_fsyms);
}
}
-
- sym->ts.interface = iface;
}
return true;
}
--- 12332,12337 ----
Index: gcc/testsuite/gfortran.dg/submodule_20.f08
===================================================================
*** gcc/testsuite/gfortran.dg/submodule_20.f08 (revision 0)
--- gcc/testsuite/gfortran.dg/submodule_20.f08 (working copy)
***************
*** 0 ****
--- 1,52 ----
+ ! { dg-do compile }
+ !
+ ! Test the fix for PR77903
+ !
+ ! Contributed by Damian Rouson <dam...@sourceryinstitute.org>
+ !
+ module one_module
+ implicit none
+ interface
+ module function one()
+ end function
+ integer module function two()
+ end function
+ end interface
+ end module
+
+ submodule(one_module) one_submodule
+ implicit none
+ contains
+ integer module function one() ! { dg-error "Type mismatch" }
+ one = 1
+ end function
+ integer(8) module function two() ! { dg-error "Type mismatch" }
+ two = 2
+ end function
+ end submodule
+ ! { dg-do compile }
+ !
+ ! Test the fix for PR77903
+ !
+ ! Contributed by Damian Rouson <dam...@sourceryinstitute.org>
+ !
+ module one_module
+ implicit none
+ interface
+ module function one()
+ end function
+ integer module function two()
+ end function
+ end interface
+ end module
+
+ submodule(one_module) one_submodule
+ implicit none
+ contains
+ integer module function one() ! { dg-error "Type mismatch" }
+ one = 1
+ end function
+ integer(8) module function two() ! { dg-error "Type mismatch" }
+ two = 2
+ end function
+ end submodule
