re PR fortran/37423 (Fortran 2003: DEFERRED bindings not yet implemented)

2009-03-29  Daniel Kraft  <d@domob.eu>

	PR fortran/37423
	* gfortran.h (struct gfc_typebound_proc): Added new flag `deferred' and
	added a comment explaining DEFERRED binding handling.
	* decl.c (match_binding_attributes): Really match DEFERRED attribute.
	(match_procedure_in_type): Really match PROCEDURE(interface) syntax
	and do some validity checks for DEFERRED and this construct.
	* module.c (binding_overriding): New string constant for DEFERRED.
	(mio_typebound_proc): Module-IO DEFERRED flag.
	* resolve.c (check_typebound_override): Ensure that a non-DEFERRED
	binding is not overridden by a DEFERRED one.
	(resolve_typebound_procedure): Allow abstract interfaces as targets
	for DEFERRED bindings.
	(ensure_not_abstract_walker), (ensure_not_abstract): New methods.
	(resolve_fl_derived): Use new `ensure_not_abstract' method for
	non-ABSTRACT types extending ABSTRACT ones to ensure each DEFERRED
	binding is overridden.
	(check_typebound_baseobject): New method.
	(resolve_compcall), (resolve_typebound_call): Check base-object of
	the type-bound procedure call.
	* gfc-internals.texi (Type-bound procedures): Document a little bit
	about internal handling of DEFERRED bindings.

2009-03-29  Daniel Kraft  <d@domob.eu>

	PR fortran/37423
	* gfortran.dg/typebound_proc_4.f03: Remove not-implemented check for
	DEFERRED bindings.
	* gfortran.dg/typebound_proc_9.f03: New test.
	* gfortran.dg/typebound_proc_10.f03: New test.
	* gfortran.dg/typebound_proc_11.f03: New test.
	* gfortran.dg/abstract_type_5.f03: New test.

From-SVN: r145248

12 files changed, 373 insertions, 17 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 373ffb8..3156df6 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,27 @@
+2009-03-29  Daniel Kraft  <d@domob.eu>
+
+	PR fortran/37423
+	* gfortran.h (struct gfc_typebound_proc): Added new flag `deferred' and
+	added a comment explaining DEFERRED binding handling.
+	* decl.c (match_binding_attributes): Really match DEFERRED attribute.
+	(match_procedure_in_type): Really match PROCEDURE(interface) syntax
+	and do some validity checks for DEFERRED and this construct.
+	* module.c (binding_overriding): New string constant for DEFERRED.
+	(mio_typebound_proc): Module-IO DEFERRED flag.
+	* resolve.c (check_typebound_override): Ensure that a non-DEFERRED
+	binding is not overridden by a DEFERRED one.
+	(resolve_typebound_procedure): Allow abstract interfaces as targets
+	for DEFERRED bindings.
+	(ensure_not_abstract_walker), (ensure_not_abstract): New methods.
+	(resolve_fl_derived): Use new `ensure_not_abstract' method for
+	non-ABSTRACT types extending ABSTRACT ones to ensure each DEFERRED
+	binding is overridden.
+	(check_typebound_baseobject): New method.
+	(resolve_compcall), (resolve_typebound_call): Check base-object of
+	the type-bound procedure call.
+	* gfc-internals.texi (Type-bound procedures): Document a little bit
+	about internal handling of DEFERRED bindings.
+
 2008-03-29  Tobias Schlüter  <tobi@gcc.gnu.org>
 
 	PR fortran/38507
diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index f6677fe..54a32f1 100644
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -6732,6 +6732,7 @@ match_binding_attributes (gfc_typebound_proc* ba, bool generic)
   ba->pass_arg_num = 0;
   ba->nopass = 0;
   ba->non_overridable = 0;
+  ba->deferred = 0;
 
   /* If we find a comma, we believe there are binding attributes.  */
   if (gfc_match_char (',') == MATCH_NO)
@@ -6813,14 +6814,19 @@ match_binding_attributes (gfc_typebound_proc* ba, bool generic)
 	    }
 
 	  /* DEFERRED flag.  */
-	  /* TODO: Handle really once implemented.  */
 	  m = gfc_match (" deferred");
 	  if (m == MATCH_ERROR)
 	    goto error;
 	  if (m == MATCH_YES)
 	    {
-	      gfc_error ("DEFERRED not yet implemented at %C");
-	      goto error;
+	      if (ba->deferred)
+		{
+		  gfc_error ("Duplicate DEFERRED at %C");
+		  goto error;
+		}
+
+	      ba->deferred = 1;
+	      continue;
 	    }
 
 	  /* PASS possibly including argument.  */
@@ -6861,6 +6867,13 @@ match_binding_attributes (gfc_typebound_proc* ba, bool generic)
     }
   while (gfc_match_char (',') == MATCH_YES);
 
+  /* NON_OVERRIDABLE and DEFERRED exclude themselves.  */
+  if (ba->non_overridable && ba->deferred)
+    {
+      gfc_error ("NON_OVERRIDABLE and DEFERRED can't both appear at %C");
+      goto error;
+    }
+
   if (ba->access == ACCESS_UNKNOWN)
     ba->access = gfc_typebound_default_access;
 
@@ -6879,7 +6892,7 @@ match_procedure_in_type (void)
 {
   char name[GFC_MAX_SYMBOL_LEN + 1];
   char target_buf[GFC_MAX_SYMBOL_LEN + 1];
-  char* target;
+  char* target = NULL;
   gfc_typebound_proc* tb;
   bool seen_colons;
   bool seen_attrs;
@@ -6893,11 +6906,25 @@ match_procedure_in_type (void)
   block = gfc_state_stack->previous->sym;
   gcc_assert (block);
 
-  /* TODO: Really implement PROCEDURE(interface).  */
+  /* Try to match PROCEDURE(interface).  */
   if (gfc_match (" (") == MATCH_YES)
     {
-      gfc_error ("PROCEDURE(interface) at %C is not yet implemented");
-      return MATCH_ERROR;
+      m = gfc_match_name (target_buf);
+      if (m == MATCH_ERROR)
+	return m;
+      if (m != MATCH_YES)
+	{
+	  gfc_error ("Interface-name expected after '(' at %C");
+	  return MATCH_ERROR;
+	}
+
+      if (gfc_match (" )") != MATCH_YES)
+	{
+	  gfc_error ("')' expected at %C");
+	  return MATCH_ERROR;
+	}
+
+      target = target_buf;
     }
 
   /* Construct the data structure.  */
@@ -6911,6 +6938,19 @@ match_procedure_in_type (void)
     return m;
   seen_attrs = (m == MATCH_YES);
 
+  /* Check that attribute DEFERRED is given iff an interface is specified, which
+     means target != NULL.  */
+  if (tb->deferred && !target)
+    {
+      gfc_error ("Interface must be specified for DEFERRED binding at %C");
+      return MATCH_ERROR;
+    }
+  if (target && !tb->deferred)
+    {
+      gfc_error ("PROCEDURE(interface) at %C should be declared DEFERRED");
+      return MATCH_ERROR;
+    }
+
   /* Match the colons.  */
   m = gfc_match (" ::");
   if (m == MATCH_ERROR)
@@ -6933,12 +6973,17 @@ match_procedure_in_type (void)
     }
 
   /* Try to match the '=> target', if it's there.  */
-  target = NULL;
   m = gfc_match (" =>");
   if (m == MATCH_ERROR)
     return m;
   if (m == MATCH_YES)
     {
+      if (tb->deferred)
+	{
+	  gfc_error ("'=> target' is invalid for DEFERRED binding at %C");
+	  return MATCH_ERROR;
+	}
+
       if (!seen_colons)
 	{
 	  gfc_error ("'::' needed in PROCEDURE binding with explicit target"
@@ -6975,6 +7020,14 @@ match_procedure_in_type (void)
   ns = block->f2k_derived;
   gcc_assert (ns);
 
+  /* If the binding is DEFERRED, check that the containing type is ABSTRACT.  */
+  if (tb->deferred && !block->attr.abstract)
+    {
+      gfc_error ("Type '%s' containing DEFERRED binding at %C is not ABSTRACT",
+		 block->name);
+      return MATCH_ERROR;
+    }
+
   /* See if we already have a binding with this name in the symtree which would
      be an error.  If a GENERIC already targetted this binding, it may be
      already there but then typebound is still NULL.  */
diff --git a/gcc/fortran/gfc-internals.texi b/gcc/fortran/gfc-internals.texi
index 9cb5a54..97aec7b 100644
--- a/gcc/fortran/gfc-internals.texi
+++ b/gcc/fortran/gfc-internals.texi
@@ -601,6 +601,11 @@ name, and later during resolution phase the corresponding argument is looked for
 and its position remembered as @code{pass_arg_num} in @code{gfc_typebound_proc}.
 The binding's target procedure is pointed-to by @code{u.specific}.
 
+@code{DEFERRED} bindings are just like ordinary specific bindings, except
+that their @code{deferred} flag is set of course and that @code{u.specific}
+points to their ``interface'' defining symbol (might be an abstract interface)
+instead of the target procedure.
+
 At the moment, all type-bound procedure calls are statically dispatched and
 transformed into ordinary procedure calls at resolution time; their actual
 argument list is updated to include at the right position the passed-object
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 22c5776..0bc5596 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -1019,7 +1019,7 @@ typedef struct gfc_typebound_proc
 
   union
   {
-    struct gfc_symtree* specific;
+    struct gfc_symtree* specific; /* The interface if DEFERRED.  */
     gfc_tbp_generic* generic;
   }
   u;
@@ -1038,6 +1038,7 @@ typedef struct gfc_typebound_proc
 
   unsigned nopass:1; /* Whether we have NOPASS (PASS otherwise).  */
   unsigned non_overridable:1;
+  unsigned deferred:1;
   unsigned is_generic:1;
   unsigned function:1, subroutine:1;
   unsigned error:1; /* Ignore it, when an error occurred during resolution.  */
diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c
index d5a9f54..b5b79d0 100644
--- a/gcc/fortran/module.c
+++ b/gcc/fortran/module.c
@@ -1700,6 +1700,7 @@ static const mstring binding_overriding[] =
 {
     minit ("OVERRIDABLE", 0),
     minit ("NON_OVERRIDABLE", 1),
+    minit ("DEFERRED", 2),
     minit (NULL, -1)
 };
 static const mstring binding_generic[] =
@@ -3205,6 +3206,7 @@ static void
 mio_typebound_proc (gfc_typebound_proc** proc)
 {
   int flag;
+  int overriding_flag;
 
   if (iomode == IO_INPUT)
     {
@@ -3217,9 +3219,15 @@ mio_typebound_proc (gfc_typebound_proc** proc)
 
   (*proc)->access = MIO_NAME (gfc_access) ((*proc)->access, access_types);
 
+  /* IO the NON_OVERRIDABLE/DEFERRED combination.  */
+  gcc_assert (!((*proc)->deferred && (*proc)->non_overridable));
+  overriding_flag = ((*proc)->deferred << 1) | (*proc)->non_overridable;
+  overriding_flag = mio_name (overriding_flag, binding_overriding);
+  (*proc)->deferred = ((overriding_flag & 2) != 0);
+  (*proc)->non_overridable = ((overriding_flag & 1) != 0);
+  gcc_assert (!((*proc)->deferred && (*proc)->non_overridable));
+
   (*proc)->nopass = mio_name ((*proc)->nopass, binding_passing);
-  (*proc)->non_overridable = mio_name ((*proc)->non_overridable,
-				       binding_overriding);
   (*proc)->is_generic = mio_name ((*proc)->is_generic, binding_generic);
 
   if (iomode == IO_INPUT)
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 7f7a806..b79e485 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -4551,6 +4551,30 @@ update_compcall_arglist (gfc_expr* e)
 }
 
 
+/* Check that the object a TBP is called on is valid, i.e. it must not be
+   of ABSTRACT type (as in subobject%abstract_parent%tbp()).  */
+
+static gfc_try
+check_typebound_baseobject (gfc_expr* e)
+{
+  gfc_expr* base;
+
+  base = extract_compcall_passed_object (e);
+  if (!base)
+    return FAILURE;
+
+  gcc_assert (base->ts.type == BT_DERIVED);
+  if (base->ts.derived->attr.abstract)
+    {
+      gfc_error ("Base object for type-bound procedure call at %L is of"
+		 " ABSTRACT type '%s'", &e->where, base->ts.derived->name);
+      return FAILURE;
+    }
+
+  return SUCCESS;
+}
+
+
 /* Resolve a call to a type-bound procedure, either function or subroutine,
    statically from the data in an EXPR_COMPCALL expression.  The adapted
    arglist and the target-procedure symtree are returned.  */
@@ -4668,6 +4692,9 @@ resolve_typebound_call (gfc_code* c)
       return FAILURE;
     }
 
+  if (check_typebound_baseobject (c->expr) == FAILURE)
+    return FAILURE;
+
   if (resolve_typebound_generic_call (c->expr) == FAILURE)
     return FAILURE;
 
@@ -4704,6 +4731,9 @@ resolve_compcall (gfc_expr* e)
       return FAILURE;
     }
 
+  if (check_typebound_baseobject (e) == FAILURE)
+    return FAILURE;
+
   if (resolve_typebound_generic_call (e) == FAILURE)
     return FAILURE;
   gcc_assert (!e->value.compcall.tbp->is_generic);
@@ -8163,6 +8193,14 @@ check_typebound_override (gfc_symtree* proc, gfc_symtree* old)
       return FAILURE;
     }
 
+  /* It's an error to override a non-DEFERRED procedure with a DEFERRED one.  */
+  if (!old->typebound->deferred && proc->typebound->deferred)
+    {
+      gfc_error ("'%s' at %L must not be DEFERRED as it overrides a"
+		 " non-DEFERRED binding", proc->name, &where);
+      return FAILURE;
+    }
+
   /* If the overridden binding is PURE, the overriding must be, too.  */
   if (old_target->attr.pure && !proc_target->attr.pure)
     {
@@ -8505,11 +8543,11 @@ resolve_typebound_procedure (gfc_symtree* stree)
   gcc_assert (stree->typebound->access != ACCESS_UNKNOWN);
 
   /* It should be a module procedure or an external procedure with explicit
-     interface.  */
+     interface.  For DEFERRED bindings, abstract interfaces are ok as well.  */
   if ((!proc->attr.subroutine && !proc->attr.function)
       || (proc->attr.proc != PROC_MODULE
 	  && proc->attr.if_source != IFSRC_IFBODY)
-      || proc->attr.abstract)
+      || (proc->attr.abstract && !stree->typebound->deferred))
     {
       gfc_error ("'%s' must be a module procedure or an external procedure with"
 		 " an explicit interface at %L", proc->name, &where);
@@ -8664,6 +8702,67 @@ add_dt_to_dt_list (gfc_symbol *derived)
 }
 
 
+/* Ensure that a derived-type is really not abstract, meaning that every
+   inherited DEFERRED binding is overridden by a non-DEFERRED one.  */
+
+static gfc_try
+ensure_not_abstract_walker (gfc_symbol* sub, gfc_symtree* st)
+{
+  if (!st)
+    return SUCCESS;
+
+  if (ensure_not_abstract_walker (sub, st->left) == FAILURE)
+    return FAILURE;
+  if (ensure_not_abstract_walker (sub, st->right) == FAILURE)
+    return FAILURE;
+
+  if (st->typebound && st->typebound->deferred)
+    {
+      gfc_symtree* overriding;
+      overriding = gfc_find_typebound_proc (sub, NULL, st->name, true);
+      gcc_assert (overriding && overriding->typebound);
+      if (overriding->typebound->deferred)
+	{
+	  gfc_error ("Derived-type '%s' declared at %L must be ABSTRACT because"
+		     " '%s' is DEFERRED and not overridden",
+		     sub->name, &sub->declared_at, st->name);
+	  return FAILURE;
+	}
+    }
+
+  return SUCCESS;
+}
+
+static gfc_try
+ensure_not_abstract (gfc_symbol* sub, gfc_symbol* ancestor)
+{
+  /* The algorithm used here is to recursively travel up the ancestry of sub
+     and for each ancestor-type, check all bindings.  If any of them is
+     DEFERRED, look it up starting from sub and see if the found (overriding)
+     binding is not DEFERRED.
+     This is not the most efficient way to do this, but it should be ok and is
+     clearer than something sophisticated.  */
+
+  gcc_assert (ancestor && ancestor->attr.abstract && !sub->attr.abstract);
+
+  /* Walk bindings of this ancestor.  */
+  if (ancestor->f2k_derived)
+    {
+      gfc_try t;
+      t = ensure_not_abstract_walker (sub, ancestor->f2k_derived->sym_root);
+      if (t == FAILURE)
+	return FAILURE;
+    }
+
+  /* Find next ancestor type and recurse on it.  */
+  ancestor = gfc_get_derived_super_type (ancestor);
+  if (ancestor)
+    return ensure_not_abstract (sub, ancestor);
+
+  return SUCCESS;
+}
+
+
 /* Resolve the components of a derived type.  */
 
 static gfc_try
@@ -8791,6 +8890,12 @@ resolve_fl_derived (gfc_symbol *sym)
   if (gfc_resolve_finalizers (sym) == FAILURE)
     return FAILURE;
 
+  /* If this is a non-ABSTRACT type extending an ABSTRACT one, ensure that
+     all DEFERRED bindings are overridden.  */
+  if (super_type && super_type->attr.abstract && !sym->attr.abstract
+      && ensure_not_abstract (sym, super_type) == FAILURE)
+    return FAILURE;
+
   /* Add derived type to the derived type list.  */
   add_dt_to_dt_list (sym);
 
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index d33a95e..f264b33 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,13 @@
+2009-03-29  Daniel Kraft  <d@domob.eu>
+
+	PR fortran/37423
+	* gfortran.dg/typebound_proc_4.f03: Remove not-implemented check for
+	DEFERRED bindings.
+	* gfortran.dg/typebound_proc_9.f03: New test.
+	* gfortran.dg/typebound_proc_10.f03: New test.
+	* gfortran.dg/typebound_proc_11.f03: New test.
+	* gfortran.dg/abstract_type_5.f03: New test.
+
 2008-03-29  Tobias Schlüter  <tobi@gcc.gnu.org>
 
 	PR fortran/38507
diff --git a/gcc/testsuite/gfortran.dg/abstract_type_5.f03 b/gcc/testsuite/gfortran.dg/abstract_type_5.f03
new file mode 100644
index 0000000..a0060f8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/abstract_type_5.f03
@@ -0,0 +1,45 @@
+! { dg-do "compile" }
+
+! Abstract Types.
+! Check for correct handling of abstract-typed base object references.
+
+MODULE m
+  IMPLICIT NONE
+
+  TYPE, ABSTRACT :: abstract_t
+    INTEGER :: i
+  CONTAINS
+    PROCEDURE, NOPASS :: proc
+    PROCEDURE, NOPASS :: func
+  END TYPE abstract_t
+
+  TYPE, EXTENDS(abstract_t) :: concrete_t
+  END TYPE concrete_t
+
+CONTAINS
+
+  SUBROUTINE proc ()
+    IMPLICIT NONE
+    ! Do nothing
+  END SUBROUTINE proc
+
+  INTEGER FUNCTION func ()
+    IMPLICIT NONE
+    func = 1234
+  END FUNCTION func
+
+  SUBROUTINE test ()
+    IMPLICIT NONE
+    TYPE(concrete_t) :: obj
+
+    ! These are ok.
+    obj%abstract_t%i = 42
+    CALL obj%proc ()
+    PRINT *, obj%func ()
+
+    ! These are errors (even though the procedures are not DEFERRED!).
+    CALL obj%abstract_t%proc () ! { dg-error "is of ABSTRACT type" }
+    PRINT *, obj%abstract_t%func () ! { dg-error "is of ABSTRACT type" }
+  END SUBROUTINE test
+
+END MODULE m
diff --git a/gcc/testsuite/gfortran.dg/typebound_proc_10.f03 b/gcc/testsuite/gfortran.dg/typebound_proc_10.f03
new file mode 100644
index 0000000..3f372c8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/typebound_proc_10.f03
@@ -0,0 +1,43 @@
+! { dg-do compile }
+
+! Type-bound procedures
+! Test for resolution errors with DEFERRED, namely checks about invalid
+! overriding and taking into account inherited DEFERRED bindings.
+! Also check that DEFERRED attribute is saved to module correctly.
+
+MODULE m1
+  IMPLICIT NONE
+
+  ABSTRACT INTERFACE
+    SUBROUTINE intf ()
+    END SUBROUTINE intf
+  END INTERFACE
+
+  TYPE, ABSTRACT :: abstract_type
+  CONTAINS
+    PROCEDURE(intf), DEFERRED, NOPASS :: def
+    PROCEDURE, NOPASS :: nodef => realproc
+  END TYPE abstract_type
+
+CONTAINS
+
+  SUBROUTINE realproc ()
+  END SUBROUTINE realproc
+
+END MODULE m1
+
+MODULE m2
+  USE m1
+  IMPLICIT NONE
+
+  TYPE, ABSTRACT, EXTENDS(abstract_type) :: sub_type1
+  CONTAINS
+    PROCEDURE(intf), DEFERRED, NOPASS :: nodef ! { dg-error "must not be DEFERRED" }
+  END TYPE sub_type1
+
+  TYPE, EXTENDS(abstract_type) :: sub_type2 ! { dg-error "must be ABSTRACT" }
+  END TYPE sub_type2
+
+END MODULE m2
+
+! { dg-final { cleanup-modules "m1" } }
diff --git a/gcc/testsuite/gfortran.dg/typebound_proc_11.f03 b/gcc/testsuite/gfortran.dg/typebound_proc_11.f03
new file mode 100644
index 0000000..fafc149
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/typebound_proc_11.f03
@@ -0,0 +1,33 @@
+! { dg-do compile }
+
+! Type-bound procedures
+! Test that legal usage of DEFERRED is accepted.
+
+MODULE testmod
+  IMPLICIT NONE
+
+  ABSTRACT INTERFACE
+    SUBROUTINE intf ()
+    END SUBROUTINE intf
+  END INTERFACE
+
+  TYPE, ABSTRACT :: abstract_type
+  CONTAINS
+    PROCEDURE(intf), DEFERRED, NOPASS :: p1
+    PROCEDURE(realproc), DEFERRED, NOPASS :: p2
+  END TYPE abstract_type
+
+  TYPE, EXTENDS(abstract_type) :: sub_type
+  CONTAINS
+    PROCEDURE, NOPASS :: p1 => realproc
+    PROCEDURE, NOPASS :: p2 => realproc
+  END TYPE sub_type
+
+CONTAINS
+
+  SUBROUTINE realproc ()
+  END SUBROUTINE realproc
+
+END MODULE testmod
+
+! { dg-final { cleanup-modules "testmod" } }
diff --git a/gcc/testsuite/gfortran.dg/typebound_proc_4.f03 b/gcc/testsuite/gfortran.dg/typebound_proc_4.f03
index 3eb9687..92adc1a 100644
--- a/gcc/testsuite/gfortran.dg/typebound_proc_4.f03
+++ b/gcc/testsuite/gfortran.dg/typebound_proc_4.f03
@@ -30,10 +30,6 @@ MODULE testmod
     PROCEDURE, PUBLIC, PRIVATE ! { dg-error "Duplicate" }
     PROCEDURE, NON_OVERRIDABLE, NON_OVERRIDABLE ! { dg-error "Duplicate" }
     PROCEDURE, NOPASS, NOPASS ! { dg-error "illegal NOPASS" }
-
-    ! TODO: Correct these when things get implemented.
-    PROCEDURE, DEFERRED :: x ! { dg-error "not yet implemented" }
-    PROCEDURE(abc) ! { dg-error "not yet implemented" }
   END TYPE t
 
 CONTAINS
diff --git a/gcc/testsuite/gfortran.dg/typebound_proc_9.f03 b/gcc/testsuite/gfortran.dg/typebound_proc_9.f03
new file mode 100644
index 0000000..9106de6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/typebound_proc_9.f03
@@ -0,0 +1,33 @@
+! { dg-do compile }
+
+! Type-bound procedures
+! Test for basic parsing errors for invalid DEFERRED.
+
+MODULE testmod
+  IMPLICIT NONE
+
+  ABSTRACT INTERFACE
+    SUBROUTINE intf ()
+    END SUBROUTINE intf
+  END INTERFACE
+
+  TYPE not_abstract
+  CONTAINS
+    PROCEDURE(intf), DEFERRED, NOPASS :: proc ! { dg-error "is not ABSTRACT" }
+  END TYPE not_abstract
+
+  TYPE, ABSTRACT :: abstract_type
+  CONTAINS
+    PROCEDURE, DEFERRED :: p2 ! { dg-error "Interface must be specified" }
+    PROCEDURE(intf), NOPASS :: p3 ! { dg-error "should be declared DEFERRED" }
+    PROCEDURE(intf), DEFERRED, NON_OVERRIDABLE :: p4 ! { dg-error "can't both" }
+    PROCEDURE(unknown), DEFERRED :: p5 ! { dg-error "has no IMPLICIT|module procedure" }
+    PROCEDURE(intf), DEFERRED, DEFERRED :: p6 ! { dg-error "Duplicate DEFERRED" }
+    PROCEDURE(intf), DEFERRED :: p6 => proc ! { dg-error "is invalid for DEFERRED" }
+    PROCEDURE(), DEFERRED :: p7 ! { dg-error "Interface-name expected" }
+    PROCEDURE(intf, DEFERRED) :: p8 ! { dg-error "'\\)' expected" }
+  END TYPE abstract_type
+
+END MODULE testmod
+
+! { dg-final { cleanup-modules "testmod" } }