diff options
| author | Steven G. Kargl <kargl@gcc.gnu.org> | 2018-03-18 17:51:57 +0000 |
|---|---|---|
| committer | Steven G. Kargl <kargl@gcc.gnu.org> | 2018-03-18 17:51:57 +0000 |
| commit | 96c8b2534d19a0769152cd33e7fccc66a8785389 (patch) | |
| tree | ff06ab0f94a74091ec8b716ec3ed15cf47bc3d7f /gcc/fortran/decl.c | |
| parent | 81ea7c11e1995736f39b0bbd8aa14160d7f08626 (diff) | |
| download | gcc-96c8b2534d19a0769152cd33e7fccc66a8785389.zip gcc-96c8b2534d19a0769152cd33e7fccc66a8785389.tar.gz gcc-96c8b2534d19a0769152cd33e7fccc66a8785389.tar.bz2 | |
re PR fortran/77414 (ICE in create_function_arglist, at fortran/trans-decl.c:2410)
2018-03-18 Steven G. Kargl <kargl@gcc.gnu.org>
PR fortran/77414
* decl.c (get_proc_name): Check for a subroutine re-defined in
the contain portion of a subroutine. Change language of existing
error message to better describe the issue. While here fix whitespace
issues.
2018-03-18 Steven G. Kargl <kargl@gcc.gnu.org>
PR fortran/77414
* gfortran.dg/pr77414.f90: New test.
* gfortran.dg/internal_references_1.f90: Adjust error message.
From-SVN: r258633
Diffstat (limited to 'gcc/fortran/decl.c')
| -rw-r--r-- | gcc/fortran/decl.c | 25 |
1 files changed, 16 insertions, 9 deletions
diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index 9ffaa78..f6649cf 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -1172,14 +1172,12 @@ get_proc_name (const char *name, gfc_symbol **result, bool module_fcn_entry) if (sym->attr.proc == PROC_ST_FUNCTION) return rc; - if (sym->attr.module_procedure - && sym->attr.if_source == IFSRC_IFBODY) + if (sym->attr.module_procedure && sym->attr.if_source == IFSRC_IFBODY) { /* 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_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); @@ -1244,7 +1242,16 @@ get_proc_name (const char *name, gfc_symbol **result, bool module_fcn_entry) && sym->attr.access == 0 && !module_fcn_entry) gfc_error_now ("Procedure %qs at %C has an explicit interface " - "and must not have attributes declared at %L", + "from a previous declaration", name); + } + + if (sym && !sym->gfc_new + && sym->attr.flavor != FL_UNKNOWN + && sym->attr.referenced == 0 && sym->attr.subroutine == 1 + && gfc_state_stack->state == COMP_CONTAINS + && gfc_state_stack->previous->state == COMP_SUBROUTINE) + { + gfc_error_now ("Procedure %qs at %C is already defined at %L", name, &sym->declared_at); } @@ -1269,10 +1276,10 @@ get_proc_name (const char *name, gfc_symbol **result, bool module_fcn_entry) /* See if the procedure should be a module procedure. */ if (((sym->ns->proc_name != NULL - && sym->ns->proc_name->attr.flavor == FL_MODULE - && sym->attr.proc != PROC_MODULE) - || (module_fcn_entry && sym->attr.proc != PROC_MODULE)) - && !gfc_add_procedure (&sym->attr, PROC_MODULE, sym->name, NULL)) + && sym->ns->proc_name->attr.flavor == FL_MODULE + && sym->attr.proc != PROC_MODULE) + || (module_fcn_entry && sym->attr.proc != PROC_MODULE)) + && !gfc_add_procedure (&sym->attr, PROC_MODULE, sym->name, NULL)) rc = 2; return rc; |