From: Steven G. Kargl Date: Sun, 18 Mar 2018 17:51:57 +0000 (+0000) Subject: re PR fortran/77414 (ICE in create_function_arglist, at fortran/trans-decl.c:2410) X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=96c8b2534d19a0769152cd33e7fccc66a8785389;p=gcc.git 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 --- diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 0bdc3fe9928..7b550aa75db 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,11 @@ +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 diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index 9ffaa78e587..f6649cf9500 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 71c32f232a8..a7b96dda966 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 12041df9d70..2434e28d5e3 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 00000000000..222c1a31542 --- /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