From 96c8b2534d19a0769152cd33e7fccc66a8785389 Mon Sep 17 00:00:00 2001 From: "Steven G. Kargl" Date: Sun, 18 Mar 2018 17:51:57 +0000 Subject: [PATCH] re PR fortran/77414 (ICE in create_function_arglist, at fortran/trans-decl.c:2410) 2018-03-18 Steven G. Kargl 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 PR fortran/77414 * gfortran.dg/pr77414.f90: New test. * gfortran.dg/internal_references_1.f90: Adjust error message. From-SVN: r258633 --- gcc/fortran/ChangeLog | 8 +++++++ gcc/fortran/decl.c | 25 ++++++++++++++-------- gcc/testsuite/ChangeLog | 6 ++++++ .../gfortran.dg/internal_references_1.f90 | 7 +++--- gcc/testsuite/gfortran.dg/pr77414.f90 | 9 ++++++++ 5 files changed, 43 insertions(+), 12 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/pr77414.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 0bdc3fe..7b550aa 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,5 +1,13 @@ 2018-03-18 Steven G. Kargl + 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 + PR fortran/65453 * decl.c (get_proc_name): Catch clash between a procedure statement and a contained subprogram 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; diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 71c32f2..a7b96dd 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2018-03-17 Steven G. Kargl + + PR fortran/77414 + * gfortran.dg/pr77414.f90: New test. + * gfortran.dg/internal_references_1.f90: Adjust error message. + 2018-03-18 Steven G. Kargl PR fortran/65453 diff --git a/gcc/testsuite/gfortran.dg/internal_references_1.f90 b/gcc/testsuite/gfortran.dg/internal_references_1.f90 index 12041df..2434e28 100644 --- a/gcc/testsuite/gfortran.dg/internal_references_1.f90 +++ b/gcc/testsuite/gfortran.dg/internal_references_1.f90 @@ -11,7 +11,7 @@ module m implicit none contains - subroutine p (i) ! { dg-error "is already defined" } + subroutine p (i) ! { dg-error "(1)" } integer :: i end subroutine @@ -22,14 +22,15 @@ end module ! ! PR25124 - would happily ignore the declaration of foo in the main program. program test -real :: foo, x ! { dg-error "explicit interface and must not have attributes declared" } +real :: foo, x x = bar () ! This is OK because it is a regular reference. x = foo () contains - function foo () ! { dg-error "explicit interface and must not have attributes declared" } + function foo () ! { dg-error "explicit interface from a previous" } foo = 1.0 end function foo function bar () bar = 1.0 end function bar end program test + diff --git a/gcc/testsuite/gfortran.dg/pr77414.f90 b/gcc/testsuite/gfortran.dg/pr77414.f90 new file mode 100644 index 0000000..222c1a3 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pr77414.f90 @@ -0,0 +1,9 @@ +! { dg-do compile } +! PR fortran/77414 +subroutine a(x) ! { dg-error "(1)" } + character(*) :: x + contains + subroutine a(x) ! { dg-error " is already defined at" } + character(*) :: x + end subroutine a +end subroutine a -- 2.7.4