diff mbox series

PR fortran/77414 -- catch re-declaration of subroutines

Message ID 20180318145653.GA85774@troutmask.apl.washington.edu
State New
Headers show
Series PR fortran/77414 -- catch re-declaration of subroutines | expand

Commit Message

Steve Kargl March 18, 2018, 2:56 p.m. UTC 
The attached patch fixes an ICE by reporting an error
for the re-declaration of a subroutine by trying to 
include itself as an internal subprogram.

Regression tested on x86_64-*-freebsd and i568-*-freebsd.
OK to commit?

2018-03-17  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-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.

Comments

Thomas Koenig March 18, 2018, 4:22 p.m. UTC | #1 
Hi Steve,

> The attached patch fixes an ICE by reporting an error
> for the re-declaration of a subroutine by trying to
> include itself as an internal subprogram.
> 
> Regression tested on x86_64-*-freebsd and i568-*-freebsd.
> OK to commit?

Also ok.

Thanks for the patch!

Regards

	Thomas
diff mbox series

Patch

Index: gcc/fortran/decl.c
===================================================================
--- gcc/fortran/decl.c	(revision 258617)
+++ gcc/fortran/decl.c	(working copy)
@@ -1172,14 +1172,12 @@  get_proc_name (const char *name, gfc_symbol **result, 
   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);
@@ -1238,7 +1236,16 @@  get_proc_name (const char *name, gfc_symbol **result, 
 	  && 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);
     }
 
@@ -1263,10 +1270,10 @@  get_proc_name (const char *name, gfc_symbol **result, 
   /* 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;
Index: gcc/testsuite/gfortran.dg/pr77414.f90
===================================================================
--- gcc/testsuite/gfortran.dg/pr77414.f90	(nonexistent)
+++ gcc/testsuite/gfortran.dg/pr77414.f90	(working copy)
@@ -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
Index: gcc/testsuite/gfortran.dg/internal_references_1.f90
===================================================================
--- gcc/testsuite/gfortran.dg/internal_references_1.f90	(revision 258617)
+++ gcc/testsuite/gfortran.dg/internal_references_1.f90	(working copy)
@@ -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
+