[Patch, Fortran, 4.5] PR 39414 - PROCEDURE statement double declaration bug

[Janus Weil <janus at gcc dot gnu dot org>]

Hi all,

here is my fix for PR39414. It's regression-tested on
x86_64-unknown-linux-gnu. Ok for 4.5?

Cheers,
Janus


2009-03-10  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/39414
	* decl.c (match_procedure_decl): Fix double declaration problems with
	PROCEDURE statements.
	* symbol.c (gfc_add_type): Ditto.


2009-03-10  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/39414
	* proc_decl_21.f90: New.

Index: gcc/fortran/symbol.c
===================================================================
--- gcc/fortran/symbol.c	(Revision 144728)
+++ gcc/fortran/symbol.c	(Arbeitskopie)
@@ -1554,8 +1554,7 @@ gfc_add_type (gfc_symbol *sym, gfc_types
   if (sym->ts.type != BT_UNKNOWN)
     {
       const char *msg = "Symbol '%s' at %L already has basic type of %s";
-      if (!(sym->ts.type == ts->type
-	    && (sym->attr.flavor == FL_PROCEDURE || sym->attr.result))
+      if (!(sym->ts.type == ts->type && sym->attr.result)
 	  || gfc_notification_std (GFC_STD_GNU) == ERROR
 	  || pedantic)
 	{
@@ -1569,6 +1568,13 @@ gfc_add_type (gfc_symbol *sym, gfc_types
 	gfc_warning (msg, sym->name, where, gfc_basic_typename (sym->ts.type));
     }
 
+  if (sym->attr.procedure && sym->ts.interface)
+    {
+      gfc_error ("Procedure '%s' at %L may not have basic type of %s", sym->name, where,
+		 gfc_basic_typename (ts->type));
+      return FAILURE;
+    }
+
   flavor = sym->attr.flavor;
 
   if (flavor == FL_PROGRAM || flavor == FL_BLOCK_DATA || flavor == FL_MODULE
Index: gcc/fortran/decl.c
===================================================================
--- gcc/fortran/decl.c	(Revision 144728)
+++ gcc/fortran/decl.c	(Arbeitskopie)
@@ -4207,12 +4207,20 @@ got_ts:
       /* Set interface.  */
       if (proc_if != NULL)
 	{
+          if (sym->ts.type != BT_UNKNOWN)
+	    {
+	      gfc_error ("Procedure '%s' at %L already has basic type of %s",
+			 sym->name, &gfc_current_locus,
+			 gfc_basic_typename (sym->ts.type));
+	      return MATCH_ERROR;
+	    }
 	  sym->ts.interface = proc_if;
 	  sym->attr.untyped = 1;
 	}
       else if (current_ts.type != BT_UNKNOWN)
 	{
-	  sym->ts = current_ts;
+	  if (gfc_add_type (sym, &current_ts, &gfc_current_locus) == FAILURE)
+	    return MATCH_ERROR;
 	  sym->ts.interface = gfc_new_symbol ("", gfc_current_ns);
 	  sym->ts.interface->ts = current_ts;
 	  sym->ts.interface->attr.function = 1;

! { dg-do compile }
!
! PR fortran/39414: PROCEDURE statement double declaration bug
!
! Discovered by Paul Thomas <pault@gcc.gnu.org>
! Modified by Janus Weil <janus@gcc.gnu.org>


! forbidden

procedure(integer) :: a
integer :: a	! { dg-error "already has basic type of" }

integer :: b
procedure(integer) :: b	! { dg-error "already has basic type of" }

procedure(iabs) :: c
integer :: c	! { dg-error "may not have basic type of" }

integer :: d
procedure(iabs) :: d	! { dg-error "already has basic type of" }

! allowed

integer :: e
procedure() :: e

procedure() :: f
integer :: f

end