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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 0bdc3fe9928b8ee0686f37efa9860113bca2fb0d..7b550aa75db313f179d0ad091f8286ac5be6e6a3 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,11 @@
+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

diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index 9ffaa78e587134691632ffd3b72823a1e3daf578..f6649cf95000749b9b944fbf2ca52665754c6ada 100644 (file)
--- 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 71c32f232a82c24dc22bf1a76a975f343e14e117..a7b96dda9661ec326fdf4e72f154fab974dfca9b 100644 (file)
--- 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 12041df9d7049a51362f80d4c8d33b05ddf2834a..2434e28d5e30f4c1e6bd659ec07012f5d55d477e 100644 (file)
--- 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 (file)
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