Re: ABSTRACT interfaces + PROCEDURE declarations

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

Hi,
here comes a new version of my abstract interface patch. I changed one
of the error messages (no more "garbage" ;), made dump-parse-tree.c
(gfc_show_attr) handle abstract interfaces, and implemented the checks
for C1203 and C1236 (I hope my checking is not too naive or
simple-minded). I'll do the check for C1204 in the procedure
declaration patch.
Thanks everyone for your helpful hints. I'm still open for further comments.
Cheers,
Janus

Index: gcc/fortran/interface.c
===================================================================
--- gcc/fortran/interface.c	(revision 127553)
+++ gcc/fortran/interface.c	(working copy)
@@ -175,7 +175,8 @@ syntax:
 }
 
 
-/* Match one of the five forms of an interface statement.  */
+/* Match one of the five F95 forms of an interface statement.  The
+   matcher for the abstract interface follows.  */
 
 match
 gfc_match_interface (void)
@@ -232,6 +233,7 @@ gfc_match_interface (void)
       break;
 
     case INTERFACE_NAMELESS:
+    case INTERFACE_ABSTRACT:
       break;
     }
 
@@ -239,6 +241,32 @@ gfc_match_interface (void)
 }
 
 
+
+/* Match a F2003 abstract interface.  */
+
+match
+gfc_match_abstract_interface (void)
+{
+  match m;
+
+  if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: ABSTRACT INTERFACE at %C")
+		      == FAILURE)
+    return MATCH_ERROR;
+
+  m = gfc_match_eos ();
+
+  if (m != MATCH_YES)
+    {
+      gfc_error ("Syntax error in ABSTRACT INTERFACE statement at %C");
+      return MATCH_ERROR;
+    }
+
+  current_interface.type = INTERFACE_ABSTRACT;
+
+  return m;
+}
+
+
 /* Match the different sort of generic-specs that can be present after
    the END INTERFACE itself.  */
 
@@ -270,7 +298,8 @@ gfc_match_end_interface (void)
   switch (current_interface.type)
     {
     case INTERFACE_NAMELESS:
-      if (type != current_interface.type)
+    case INTERFACE_ABSTRACT:
+      if (type != INTERFACE_NAMELESS)
 	{
 	  gfc_error ("Expected a nameless interface at %C");
 	  m = MATCH_ERROR;
@@ -2449,6 +2478,7 @@ gfc_add_interface (gfc_symbol *new)
   switch (current_interface.type)
     {
     case INTERFACE_NAMELESS:
+    case INTERFACE_ABSTRACT:
       return SUCCESS;
 
     case INTERFACE_INTRINSIC_OP:
Index: gcc/fortran/decl.c
===================================================================
--- gcc/fortran/decl.c	(revision 127553)
+++ gcc/fortran/decl.c	(working copy)
@@ -4842,6 +4842,7 @@ access_attr_decl (gfc_statement st)
       switch (type)
 	{
 	case INTERFACE_NAMELESS:
+	case INTERFACE_ABSTRACT:
 	  goto syntax;
 
 	case INTERFACE_GENERIC:
Index: gcc/fortran/dump-parse-tree.c
===================================================================
--- gcc/fortran/dump-parse-tree.c	(revision 127553)
+++ gcc/fortran/dump-parse-tree.c	(working copy)
@@ -591,6 +591,8 @@ gfc_show_attr (symbol_attribute *attr)
   if (attr->in_common)
     gfc_status (" IN-COMMON");
 
+  if (attr->abstract)
+    gfc_status (" ABSTRACT INTERFACE");
   if (attr->function)
     gfc_status (" FUNCTION");
   if (attr->subroutine)
Index: gcc/fortran/gfortran.h
===================================================================
--- gcc/fortran/gfortran.h	(revision 127553)
+++ gcc/fortran/gfortran.h	(working copy)
@@ -260,7 +260,7 @@ gfc_statement;
 typedef enum
 {
   INTERFACE_NAMELESS = 1, INTERFACE_GENERIC,
-  INTERFACE_INTRINSIC_OP, INTERFACE_USER_OP
+  INTERFACE_INTRINSIC_OP, INTERFACE_USER_OP, INTERFACE_ABSTRACT
 }
 interface_type;
 
@@ -658,7 +658,7 @@ typedef struct
 
   /* Function/subroutine attributes */
   unsigned sequence:1, elemental:1, pure:1, recursive:1;
-  unsigned unmaskable:1, masked:1, contained:1, mod_proc:1;
+  unsigned unmaskable:1, masked:1, contained:1, mod_proc:1, abstract:1;
 
   /* This is set if the subroutine doesn't return.  Currently, this
      is only possible for intrinsic subroutines.  */
Index: gcc/fortran/module.c
===================================================================
--- gcc/fortran/module.c	(revision 127553)
+++ gcc/fortran/module.c	(working copy)
@@ -599,6 +599,7 @@ gfc_match_use (void)
       switch (type)
 	{
 	case INTERFACE_NAMELESS:
+	case INTERFACE_ABSTRACT:
 	  gfc_error ("Missing generic specification in USE statement at %C");
 	  goto cleanup;
 
@@ -1512,7 +1513,7 @@ typedef enum
   AB_ELEMENTAL, AB_PURE, AB_RECURSIVE, AB_GENERIC, AB_ALWAYS_EXPLICIT,
   AB_CRAY_POINTER, AB_CRAY_POINTEE, AB_THREADPRIVATE, AB_ALLOC_COMP,
   AB_POINTER_COMP, AB_PRIVATE_COMP, AB_VALUE, AB_VOLATILE, AB_PROTECTED,
-  AB_IS_BIND_C, AB_IS_C_INTEROP, AB_IS_ISO_C
+  AB_IS_BIND_C, AB_IS_C_INTEROP, AB_IS_ISO_C, AB_ABSTRACT
 }
 ab_attribute;
 
@@ -1550,6 +1551,7 @@ static const mstring attr_bits[] =
     minit ("POINTER_COMP", AB_POINTER_COMP),
     minit ("PRIVATE_COMP", AB_PRIVATE_COMP),
     minit ("PROTECTED", AB_PROTECTED),
+    minit ("ABSTRACT", AB_ABSTRACT),
     minit (NULL, -1)
 };
 
@@ -1632,6 +1634,8 @@ mio_symbol_attribute (symbol_attribute *
 	MIO_NAME (ab_attribute) (AB_SUBROUTINE, attr_bits);
       if (attr->generic)
 	MIO_NAME (ab_attribute) (AB_GENERIC, attr_bits);
+      if (attr->abstract)
+	MIO_NAME (ab_attribute) (AB_ABSTRACT, attr_bits);
 
       if (attr->sequence)
 	MIO_NAME (ab_attribute) (AB_SEQUENCE, attr_bits);
@@ -1732,6 +1736,9 @@ mio_symbol_attribute (symbol_attribute *
 	    case AB_GENERIC:
 	      attr->generic = 1;
 	      break;
+	    case AB_ABSTRACT:
+	      attr->abstract = 1;
+	      break;
 	    case AB_SEQUENCE:
 	      attr->sequence = 1;
 	      break;
Index: gcc/fortran/resolve.c
===================================================================
--- gcc/fortran/resolve.c	(revision 127553)
+++ gcc/fortran/resolve.c	(working copy)
@@ -1968,6 +1968,13 @@ resolve_function (gfc_expr *expr)
       return FAILURE;
     }
 
+  if (sym && sym->attr.abstract)
+    {
+      gfc_error ("ABSTRACT INTERFACE '%s' must not be referenced at %L",
+		 sym->name, &expr->where);
+      return FAILURE;
+    }
+
   /* If the procedure is external, check for usage.  */
   if (sym && is_external_proc (sym))
     resolve_global_procedure (sym, &expr->where, 0);
Index: gcc/fortran/match.h
===================================================================
--- gcc/fortran/match.h	(revision 127553)
+++ gcc/fortran/match.h	(working copy)
@@ -195,6 +195,7 @@ match gfc_match_array_ref (gfc_array_ref
 match gfc_match_array_constructor (gfc_expr **);
 
 /* interface.c.  */
+match gfc_match_abstract_interface (void);
 match gfc_match_generic_spec (interface_type *, char *, gfc_intrinsic_op *);
 match gfc_match_interface (void);
 match gfc_match_end_interface (void);
Index: gcc/fortran/parse.c
===================================================================
--- gcc/fortran/parse.c	(revision 127553)
+++ gcc/fortran/parse.c	(working copy)
@@ -172,6 +172,7 @@ decode_statement (void)
   switch (c)
     {
     case 'a':
+      match ("abstract interface", gfc_match_abstract_interface, ST_INTERFACE);
       match ("allocate", gfc_match_allocate, ST_ALLOCATE);
       match ("allocatable", gfc_match_allocatable, ST_ATTR_DECL);
       match ("assign", gfc_match_assign, ST_LABEL_ASSIGNMENT);
@@ -1795,6 +1796,22 @@ loop:
 	}
     }
 
+  if (current_interface.type == INTERFACE_ABSTRACT)
+    {
+      gfc_new_block->attr.abstract = 1;
+      if (!strcmp(gfc_new_block->name,"integer")
+	  || !strcmp(gfc_new_block->name,"real")
+	  || !strcmp(gfc_new_block->name,"complex")
+	  || !strcmp(gfc_new_block->name,"character")
+	  || !strcmp(gfc_new_block->name,"logical"))
+	gfc_error ("Name of ABSTRACT INTERFACE at %C cannot be be the same as "
+		   "an intrinsic type: %s",gfc_new_block->name);
+      if (gfc_new_block->attr.is_bind_c
+	  && strcmp(gfc_new_block->binding_label,gfc_new_block->name))
+	gfc_error ("ABSTRACT INTERFACE at %C may not be BIND(C) with name '%s'",
+		   gfc_new_block->binding_label);
+    }
+
   push_state (&s2, new_state, gfc_new_block);
   accept_statement (st);
   prog_unit = gfc_new_block;