re PR fortran/77903 ([F08] gfortran 6.1.0/7.0.0 accept invalid code with conflicting module/submodule interfaces)

2016-12-09  Paul Thomas  <pault@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-09  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/77903
	* gfortran.dg/submodule_20.f08: New test.

From-SVN: r243507
This commit is contained in:
Paul Thomas 2016-12-09 22:25:26 +00:00
parent 36823125e4
commit c064374dc4
7 changed files with 73 additions and 28 deletions

View File

@ -1,3 +1,15 @@
2016-12-09 Paul Thomas <pault@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-09 Janus Weil <janus@gcc.gnu.org>
PR fortran/61767
@ -22,7 +34,7 @@
* trans-expr.c (gfc_conv_procedure_call): Use the almighty deallocate_
with_status.
* trans-openmp.c (gfc_walk_alloc_comps): Likewise.
(gfc_omp_clause_assign_op): Likewise.
(gfc_omp_clause_assign_op): Likewise.
(gfc_omp_clause_dtor): Likewise.
* trans-stmt.c (gfc_trans_deallocate): Likewise.
* trans.c (gfc_deallocate_with_status): Allow deallocation of scalar

View File

@ -1119,12 +1119,12 @@ get_proc_name (const char *name, gfc_symbol **result, bool module_fcn_entry)
{
/* 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),
sym->tlink = gfc_new_symbol (name, sym->ns);
gfc_add_type (sym->tlink, &(sym->ts),
&gfc_current_locus);
gfc_copy_attr (&sym->ts.interface->attr, &sym->attr, NULL);
gfc_copy_attr (&sym->tlink->attr, &sym->attr, NULL);
if (sym->attr.dimension)
sym->ts.interface->as = gfc_copy_array_spec (sym->as);
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
@ -1133,12 +1133,12 @@ get_proc_name (const char *name, gfc_symbol **result, bool module_fcn_entry)
if (sym->result && sym->result != sym)
{
sym->ts.interface->result = sym->result;
sym->tlink->result = sym->result;
sym->result = NULL;
}
else if (sym->result)
{
sym->ts.interface->result = sym->ts.interface;
sym->tlink->result = sym->tlink;
}
}
else if (sym && !sym->gfc_new
@ -6063,7 +6063,6 @@ gfc_match_function_decl (void)
sym->result = result;
}
/* Warn if this procedure has the same name as an intrinsic. */
do_warn_intrinsic_shadow (sym, true);
@ -8254,11 +8253,11 @@ gfc_match_submod_proc (void)
/* 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->tlink && sym->tlink->attr.function)
{
if (sym->ts.interface->result
&& sym->ts.interface->result != sym->ts.interface)
sym->result= sym->ts.interface->result;
if (sym->tlink->result
&& sym->tlink->result != sym->tlink)
sym->result= sym->tlink->result;
else
sym->result = sym;
}

View File

@ -1532,14 +1532,20 @@ typedef struct gfc_symbol
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,
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. */
struct gfc_symbol *old_symbol, *tlink;
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;

View File

@ -5556,11 +5556,11 @@ get_modproc_result (void)
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)
&& proc->tlink
&& proc->tlink->result
&& proc->tlink->result != proc->tlink)
{
gfc_copy_dummy_sym (&proc->result, proc->ts.interface->result, 1);
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);

View File

@ -12282,10 +12282,8 @@ resolve_fl_procedure (gfc_symbol *sym, int mp_flag)
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;
iface = sym->tlink;
sym->tlink = NULL;
/* Make sure that the result uses the correct charlen for deferred
length results. */
@ -12333,7 +12331,7 @@ resolve_fl_procedure (gfc_symbol *sym, int mp_flag)
}
check_formal:
/* Check the charcateristics of the formal arguments. */
/* Check the characteristics of the formal arguments. */
if (sym->formal && sym->formal_ns)
{
for (arg = sym->formal; arg && arg->sym; arg = arg->next)
@ -12342,8 +12340,6 @@ check_formal:
gfc_traverse_ns (sym->formal_ns, compare_fsyms);
}
}
sym->ts.interface = iface;
}
return true;
}

View File

@ -1,3 +1,8 @@
2016-12-09 Paul Thomas <pault@gcc.gnu.org>
PR fortran/77903
* gfortran.dg/submodule_20.f08: New test.
2016-12-09 Bill Schmidt <wschmidt@linux.vnet.ibm.com>
PR testsuite/78740

View File

@ -0,0 +1,27 @@
! { dg-do compile }
!
! Test the fix for PR77903
!
! Contributed by Damian Rouson <damian@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