mirror of
git://gcc.gnu.org/git/gcc.git
synced 2025-03-26 21:51:12 +08:00
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:
parent
36823125e4
commit
c064374dc4
@ -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
|
||||
|
@ -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;
|
||||
}
|
||||
|
@ -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;
|
||||
|
@ -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);
|
||||
|
@ -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;
|
||||
}
|
||||
|
@ -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
|
||||
|
27
gcc/testsuite/gfortran.dg/submodule_20.f08
Normal file
27
gcc/testsuite/gfortran.dg/submodule_20.f08
Normal 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
|
||||
|
Loading…
x
Reference in New Issue
Block a user