[Bug fortran/36361] attribute declaration outside of INTERFACE body

[janus at gcc dot gnu dot org]

------- Comment #4 from janus at gcc dot gnu dot org  2008-05-29 20:06 -------
Here is a first attempt to fix this. The following patch should cope with the
original test case and the one in comment #1. The fix for the POINTER issues
will go into my procedure pointer patch. Any other attributes we need to
handle?


Index: gcc/fortran/symbol.c
===================================================================
--- gcc/fortran/symbol.c        (revision 136137)
+++ 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 ("Attribute ALLOCATABLE declared 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 ("Attribute DIMENSION of %s declared outside of 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 declared outside of INTERFACE body for %s at %L",
+                sym->name, where);
+      return FAILURE;
+    }
+
   sym->formal = formal;
   sym->attr.if_source = source;

Index: gcc/fortran/parse.c
===================================================================
--- gcc/fortran/parse.c (revision 136137)
+++ gcc/fortran/parse.c (working copy)
@@ -1915,8 +1915,13 @@ loop:

     case ST_SUBROUTINE:
       new_state = COMP_SUBROUTINE;
-      gfc_add_explicit_interface (gfc_new_block, IFSRC_IFBODY,
-                                 gfc_new_block->formal, NULL);
+      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;
+       }
       if (current_interface.type != INTERFACE_ABSTRACT &&
         !gfc_new_block->attr.dummy &&
         gfc_add_external (&gfc_new_block->attr, &gfc_current_locus) ==
FAILURE)
@@ -1929,8 +1934,13 @@ loop:

     case ST_FUNCTION:
       new_state = COMP_FUNCTION;
-      gfc_add_explicit_interface (gfc_new_block, IFSRC_IFBODY,
-                                 gfc_new_block->formal, NULL);
+      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;
+       }
       if (current_interface.type != INTERFACE_ABSTRACT &&
         !gfc_new_block->attr.dummy &&
         gfc_add_external (&gfc_new_block->attr, &gfc_current_locus) ==
FAILURE)


-- 

janus at gcc dot gnu dot org changed:

           What    |Removed                     |Added
----------------------------------------------------------------------------
         AssignedTo|unassigned at gcc dot gnu   |janus at gcc dot gnu dot org
                   |dot org                     |
             Status|NEW                         |ASSIGNED
   Last reconfirmed|2008-05-28 22:23:43         |2008-05-29 20:06:26
               date|                            |


http://gcc.gnu.org/bugzilla/show_bug.cgi?id=36361