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.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@127612 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index f0fa1f4..f7baaa8 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,4 +1,21 @@
 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-18  Paul Thomas  <pault@gcc.gnu.org>
 
        PR fortran/32881
        * expr.c (gfc_check_pointer_assign): If the rhs is the

diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index 8162300..ed0defd 100644 (file)
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -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:

diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c
index ac6a6f5..d9fbbfa 100644 (file)
--- a/gcc/fortran/dump-parse-tree.c
+++ b/gcc/fortran/dump-parse-tree.c
@@ -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)

diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 0854594..ef7811d 100644 (file)
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -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.  */

diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c
index dbd7538..55cc641 100644 (file)
--- a/gcc/fortran/interface.c
+++ b/gcc/fortran/interface.c
@@ -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:

diff --git a/gcc/fortran/match.h b/gcc/fortran/match.h
index 062fe53..abd6ab1 100644 (file)
--- a/gcc/fortran/match.h
+++ b/gcc/fortran/match.h
@@ -195,6 +195,7 @@ match gfc_match_array_ref (gfc_array_ref *, gfc_array_spec *, int);
 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);

diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c
index c5a5184..2839386 100644 (file)
--- a/gcc/fortran/module.c
+++ b/gcc/fortran/module.c
@@ -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 *attr)
        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 *attr)
            case AB_GENERIC:
              attr->generic = 1;
              break;
+           case AB_ABSTRACT:
+             attr->abstract = 1;
+             break;
            case AB_SEQUENCE:
              attr->sequence = 1;
              break;

diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
index 4e7e8e1..40b2816 100644 (file)
--- a/gcc/fortran/parse.c
+++ b/gcc/fortran/parse.c
@@ -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;

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 4cfff79..ae15d16 100644 (file)
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -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);

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 992a1a0..4f1b733 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,7 @@
+2007-08-17  Tobias Burnus  <burnus@net-b.de>
+
+       * gfortran.dg/interface_abstract_1.f90: New.
+
 2007-08-18  Paul Thomas  <pault@gcc.gnu.org>
 
        PR fortran/32881

diff --git a/gcc/testsuite/gfortran.dg/interface_abstract_1.f90 b/gcc/testsuite/gfortran.dg/interface_abstract_1.f90
new file mode 100644 (file)
index 0000000..7bb583a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/interface_abstract_1.f90
@@ -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