From c064374dc436b7e7150be2a01c81f4b71072ef1a Mon Sep 17 00:00:00 2001 From: Paul Thomas Date: Fri, 9 Dec 2016 22:25:26 +0000 Subject: [PATCH] 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 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 PR fortran/77903 * gfortran.dg/submodule_20.f08: New test. From-SVN: r243507 --- gcc/fortran/ChangeLog | 14 ++++++++++- gcc/fortran/decl.c | 21 ++++++++--------- gcc/fortran/gfortran.h | 16 +++++++++---- gcc/fortran/parse.c | 8 +++---- gcc/fortran/resolve.c | 10 +++----- gcc/testsuite/ChangeLog | 5 ++++ gcc/testsuite/gfortran.dg/submodule_20.f08 | 27 ++++++++++++++++++++++ 7 files changed, 73 insertions(+), 28 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/submodule_20.f08 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 819f5ef9156..795f1f2f2ee 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,15 @@ +2016-12-09 Paul Thomas + + 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 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 diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index 411d496dd5b..c8adedb933e 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -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; } diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 670c13afa64..fd64af241b1 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -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; diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c index b72863a2e58..6addae3678e 100644 --- a/gcc/fortran/parse.c +++ b/gcc/fortran/parse.c @@ -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); diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 2093de91c20..d04b4318742 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -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; } diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index f5f910a5888..6c86182a8e5 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2016-12-09 Paul Thomas + + PR fortran/77903 + * gfortran.dg/submodule_20.f08: New test. + 2016-12-09 Bill Schmidt PR testsuite/78740 diff --git a/gcc/testsuite/gfortran.dg/submodule_20.f08 b/gcc/testsuite/gfortran.dg/submodule_20.f08 new file mode 100644 index 00000000000..36a95a50f13 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/submodule_20.f08 @@ -0,0 +1,27 @@ +! { dg-do compile } +! +! Test the fix for PR77903 +! +! Contributed by Damian Rouson +! +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 + -- 2.30.2