This is the mail archive of the fortran@gcc.gnu.org mailing list for the GNU Fortran project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

[PATCH, Fortran] ABSTRACT INTERFACE


:ADDPATCH fortran:

Hi all,
this patch implements ABSTRACT interfaces, as defined in section
12.3.2 of the F2003 standard. It is based on the work of Paul Thomas,
which was taken over and extended by me, with some help from Tobias
Schlüter and Tobias Burnus.
Abstract interfaces are not very useful on their own, but prepare for
the implementation of PROCEDURE declarations (and pointers) which I'm
working on right now and which hopefully will be finished soon.
Regression tested on i686-pc-linux-gnu and x86_64-unknown-linux-gnu.
OK for trunk?
Janus



2007-08-18  Paul Thomas  <pault@gcc.gnu.org>
	    Janus Weil  <jaydub66@gmail.com>

	* interface.c (gfc_match_interface,gfc_match_abstract_interface,
	gfc_match_end_interface,gfc_add_interface): Add abstract interface.
	* dump-parse-tree.c (gfc_show_attr): Ditto.
	* gfortran.h (interface_type,symbol_attribute): Ditto.
	* module.c (gfc_match_use,ab_attribute,attr_bits,
	mio_symbol_attribute): Ditto.
	* resolve.c (resolve_function): Ditto.
	* match.h: Ditto.
	* parse.c (decode_statement): Ditto.
	(parse_interface): Ditto, check for C1203 (name of abstract interface
	cannot be the same as an intrinsic type).
	* decl.c (gfc_match_bind_c): Check for NAME= with abstract interfaces.
	(access_attr_decl): Handle Abstract interfaces.


2007-08-17  Tobias Burnus  <burnus@net-b.de>

	* gfortran.dg/interface_abstract_1.f90: New.
Index: gcc/testsuite/gfortran.dg/interface_abstract_1.f90
===================================================================
--- gcc/testsuite/gfortran.dg/interface_abstract_1.f90	(revision 0)
+++ gcc/testsuite/gfortran.dg/interface_abstract_1.f90	(revision 0)
@@ -0,0 +1,15 @@
+! { dg-do compile }
+!
+implicit none
+abstract interface :: one ! { dg-error "Syntax error in ABSTRACT INTERFACE statement" }
+end interface ! { dg-error "Expecting END PROGRAM statement" }
+
+abstract interface
+  subroutine two() bind(C)
+  end subroutine two
+  subroutine three() bind(C,name="three") ! { dg-error "NAME not allowed on BIND.C. for ABSTRACT INTERFACE" }
+  end subroutine three ! { dg-error "Expecting END INTERFACE statement" }
+  subroutine real() ! { dg-error "cannot be be the same as an intrinsic type" }
+  end subroutine real
+end interface
+end
Index: gcc/fortran/interface.c
===================================================================
--- gcc/fortran/interface.c	(revision 127586)
+++ 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 127586)
+++ gcc/fortran/decl.c	(working copy)
@@ -4182,7 +4182,13 @@ gfc_match_bind_c (gfc_symbol *sym)
       if (sym != NULL && sym->name != NULL && has_name_equals == 0)
 	strncpy (sym->binding_label, sym->name, strlen (sym->name) + 1);
     }
-	      
+
+  if (has_name_equals && current_interface.type == INTERFACE_ABSTRACT)
+    {
+      gfc_error ("NAME not allowed on BIND(C) for ABSTRACT INTERFACE at %C");
+      return MATCH_ERROR;
+    }
+
   return MATCH_YES;
 }
 
@@ -4842,6 +4848,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 127586)
+++ 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 127586)
+++ 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 127586)
+++ 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;
 
@@ -1519,7 +1520,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;
 
@@ -1557,6 +1558,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)
 };
 
@@ -1639,6 +1641,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);
@@ -1739,6 +1743,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 127586)
+++ 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 127586)
+++ 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 127586)
+++ 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,18 @@ 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 the same as "
+		   "an intrinsic type: %s",gfc_new_block->name);
+    }
+
   push_state (&s2, new_state, gfc_new_block);
   accept_statement (st);
   prog_unit = gfc_new_block;

Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]