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

5 files changed, 43 insertions, 12 deletions

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  <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/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  <kargl@gcc.gnu.org>
+
+	PR fortran/77414
+	* gfortran.dg/pr77414.f90: New test.
+	* gfortran.dg/internal_references_1.f90: Adjust error message.
+
 2018-03-18  Steven G. Kargl  <kargl@gcc.gnu.org>
 
 	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