[Patch, Fortran] attribute declaration outside of INTERFACE body (PR36361)

["Janus Weil" <jaydub66 at googlemail dot com>]

Hi all,
here is my patch for PR36361, including test cases, regtested on
i686-pc-linux-gnu with no
failures. It also includes the one-line fix from PR36275 comment #3.

There is just one thing I need someone's opinion on: The new test case
interface_24.f90 has some slight issues regarding error recovery. For
"f2" and "f5" I commented out some lines of (normally valid) code, to
get rid of excess errors:


  dimension :: f2(4)
  interface
    real function f2()  ! { dg-error "outside its INTERFACE body" }
    !end function
  end interface

Otherwise I get an additional error like:

    end function
      1
Error: Expecting END INTERFACE statement at (1)

Is this acceptable for a test case? Or should I rather use additional
dg-errors to catch all of the excess errors? Right now I see no easy
way to completely get rid of these recovery issues.

Otherwise ok?
Janus


2008-05-31  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/36361
	PR fortran/36275
	* symbol.c (gfc_add_allocatable,gfc_add_dimension,
	gfc_add_explicit_interface): Added checks.
	* decl.c (attr_decl1): Added missing "var_locus".
	* resolve.c (resolve_symbol): Fix handling of bind(c) interfaces.
	* parse.c (parse_interface): Checking for errors.


2008-05-31  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/36361
	PR fortran/36275
	* gfortran.dg/interface_24.f90: New.
	* gfortran.dg/proc_decl_2.f90: Extended.

Index: gcc/testsuite/gfortran.dg/interface_24.f90
===================================================================
--- gcc/testsuite/gfortran.dg/interface_24.f90	(revision 0)
+++ gcc/testsuite/gfortran.dg/interface_24.f90	(revision 0)
@@ -0,0 +1,66 @@
+! { dg-do compile }
+!
+! This tests the fix for PR36361: If a function was declared in an INTERFACE
+! statement, no attributes may be declared outside of the INTERFACE body.
+!
+! Contributed by Janus Weil <janus@gcc.gnu.org>
+
+module m1
+  interface
+    real function f1()
+    end function
+  end interface
+  dimension :: f1(4)  ! { dg-error "outside its INTERFACE body" }
+end module
+
+
+module m2
+  dimension :: f2(4)
+  interface
+    real function f2()  ! { dg-error "outside its INTERFACE body" }
+    !end function
+  end interface
+end module
+
+
+! valid
+module m3
+  interface
+    real function f3()
+      dimension :: f3(4)
+    end function
+  end interface
+end module
+
+
+module m4
+  interface
+    function f4()  ! { dg-error "cannot have a deferred shape" }
+      real :: f4(:)
+    end function
+  end interface
+  allocatable :: f4  ! { dg-error "outside of INTERFACE body" }
+end module
+
+
+module m5
+  allocatable :: f5(:)
+  interface
+    function f5()  ! { dg-error "outside its INTERFACE body" }
+      !real f5(:)
+    !end function
+  end interface
+end module
+
+
+!valid
+module m6
+  interface
+    function f6()
+      real f6(:)
+      allocatable :: f6
+    end function
+  end interface
+end module
+
+! { dg-final { cleanup-modules "m1 m2 m3 m4 m5 m6" } }
Index: gcc/testsuite/gfortran.dg/proc_decl_2.f90
===================================================================
--- gcc/testsuite/gfortran.dg/proc_decl_2.f90	(revision 136199)
+++ gcc/testsuite/gfortran.dg/proc_decl_2.f90	(working copy)
@@ -4,16 +4,27 @@
 
 module m
 
+  use ISO_C_BINDING
+
   abstract interface
     subroutine csub() bind(c)
     end subroutine csub
   end interface
 
+  integer, parameter :: ckind = C_FLOAT_COMPLEX
+  abstract interface
+    function stub() bind(C)
+      import ckind
+      complex(ckind) stub
+    end function
+  end interface
+
   procedure():: mp1
   procedure(real), private:: mp2
   procedure(mfun), public:: mp3
   procedure(csub), public, bind(c) :: c, d
   procedure(csub), public, bind(c, name="myB") :: b
+  procedure(stub), bind(C) :: e
 
 contains
 
Index: gcc/fortran/symbol.c
===================================================================
--- gcc/fortran/symbol.c	(revision 136199)
+++ gcc/fortran/symbol.c	(working copy)
@@ -814,6 +814,14 @@ gfc_add_allocatable (symbol_attribute *a
       return FAILURE;
     }
 
+  if (attr->flavor == FL_PROCEDURE && attr->if_source == IFSRC_IFBODY
+      && gfc_find_state (COMP_INTERFACE) == FAILURE)
+    {
+      gfc_error ("ALLOCATABLE delaration outside of INTERFACE body at %L",
+		 where);
+      return FAILURE;
+    }
+
   attr->allocatable = 1;
   return check_conflict (attr, NULL, where);
 }
@@ -832,6 +840,14 @@ gfc_add_dimension (symbol_attribute *att
       return FAILURE;
     }
 
+  if (attr->flavor == FL_PROCEDURE && attr->if_source == IFSRC_IFBODY
+      && gfc_find_state (COMP_INTERFACE) == FAILURE)
+    {
+      gfc_error ("DIMENSION declaration for %s outside its INTERFACE body "
+		 "at %L", name, where);
+      return FAILURE;
+    }
+
   attr->dimension = 1;
   return check_conflict (attr, name, where);
 }
@@ -1453,6 +1469,13 @@ gfc_add_explicit_interface (gfc_symbol *
       return FAILURE;
     }
 
+  if (source == IFSRC_IFBODY && (sym->attr.dimension || sym->attr.allocatable))
+    {
+      gfc_error ("Attribute declaration for %s outside its INTERFACE body "
+		 "at %L", sym->name, where);
+      return FAILURE;
+    }
+
   sym->formal = formal;
   sym->attr.if_source = source;
 
Index: gcc/fortran/decl.c
===================================================================
--- gcc/fortran/decl.c	(revision 136199)
+++ gcc/fortran/decl.c	(working copy)
@@ -5216,7 +5216,7 @@ attr_decl1 (void)
   /* Update symbol table.  DIMENSION attribute is set
      in gfc_set_array_spec().  */
   if (current_attr.dimension == 0
-      && gfc_copy_attr (&sym->attr, &current_attr, NULL) == FAILURE)
+      && gfc_copy_attr (&sym->attr, &current_attr, &var_locus) == FAILURE)
     {
       m = MATCH_ERROR;
       goto cleanup;
Index: gcc/fortran/resolve.c
===================================================================
--- gcc/fortran/resolve.c	(revision 136199)
+++ gcc/fortran/resolve.c	(working copy)
@@ -7751,6 +7751,7 @@ resolve_symbol (gfc_symbol *sym)
 	{
 	  sym->ts.type = sym->ts.interface->ts.type;
 	  sym->ts.kind = sym->ts.interface->ts.kind;
+	  sym->ts.is_c_interop = sym->ts.interface->ts.is_c_interop;
 	  sym->attr.function = sym->ts.interface->attr.function;
 	  sym->attr.subroutine = sym->ts.interface->attr.subroutine;
 	  copy_formal_args (sym, sym->ts.interface);
Index: gcc/fortran/parse.c
===================================================================
--- gcc/fortran/parse.c	(revision 136199)
+++ gcc/fortran/parse.c	(working copy)
@@ -1914,23 +1914,18 @@ loop:
       unexpected_eof ();
 
     case ST_SUBROUTINE:
-      new_state = COMP_SUBROUTINE;
-      gfc_add_explicit_interface (gfc_new_block, IFSRC_IFBODY,
-				  gfc_new_block->formal, NULL);
-      if (current_interface.type != INTERFACE_ABSTRACT &&
-	 !gfc_new_block->attr.dummy &&
-	 gfc_add_external (&gfc_new_block->attr, &gfc_current_locus) == FAILURE)
+    case ST_FUNCTION:
+      if (st == ST_SUBROUTINE)
+	new_state = COMP_SUBROUTINE;
+      else if (st == ST_FUNCTION)
+	new_state = COMP_FUNCTION;
+      if (gfc_add_explicit_interface (gfc_new_block, IFSRC_IFBODY,
+				  gfc_new_block->formal, NULL) == FAILURE)
 	{
 	  reject_statement ();
 	  gfc_free_namespace (gfc_current_ns);
 	  goto loop;
 	}
-      break;
-
-    case ST_FUNCTION:
-      new_state = COMP_FUNCTION;
-      gfc_add_explicit_interface (gfc_new_block, IFSRC_IFBODY,
-				  gfc_new_block->formal, NULL);
       if (current_interface.type != INTERFACE_ABSTRACT &&
 	 !gfc_new_block->attr.dummy &&
 	 gfc_add_external (&gfc_new_block->attr, &gfc_current_locus) == FAILURE)