[Patch, Fortran] Two minor tweaks for type-bound procedure parsing

[Daniel Kraft <d at domob dot eu>]

Hi,

this patch adds two additional checks to the type-bound procedure 
parsing as commented by Tobias in my other thread; it disallows CONTAINS 
inside derived-types with SEQUENCE/BIND(C) and emits an error if a 
type-bound procedure has the same name as a component of this derived type.

Reading the standard, it seems that this is all that is required for the 
latter case.  I'm wondering what should happen with this:

TYPE :: t1
CONTAINS
  PROCEDURE :: foobar
END TYPE t1

TYPE, EXTENDS(t1) :: t2
  INTEGER :: foobar(42)
END TYPE t2

...

TYPE(t2) :: dt

WRITE (*,*) dt%foobar(5)

Is this allowed?  According to my reading of the standard, it is.  And 
according to my intuition, this should output the array-element and not 
call the type-bound procedure.  What do you think?  Did I miss something 
in the standard and this is not allowed?  If so, I'll incorporate this 
in the patch.

Are there some additional checks that I could add right away to this 
patch?  I'm regression testing at the moment on GNU/Linux-x86-32, ok to 
commit if no regressions and no more comments?

Yours,
Daniel

--
Done:     Arc-Bar-Cav-Sam-Val-Wiz, Dwa-Elf-Gno-Hum-Orc, Law-Neu-Cha, Fem-Mal
To go:    Hea-Kni-Mon-Pri-Ran-Rog-Tou

2008-08-24  Daniel Kraft  <d@domob.eu>

	* decl.c (match_procedure_in_type): Emit an error if a type-bound
	procedure has the same name as a derived-type component.
	* parse.c (parse_derived_contains): Check if the derived-type containing
	the CONTAINS section is SEQUENCE/BIND(C).

2008-08-24  Daniel Kraft  <d@domob.eu>

	* gfortran.dg/typebound_proc_7.f03: New test.
	* gfortran.dg/typebound_proc_8.f03: New test.

Index: gcc/fortran/decl.c
===================================================================
--- gcc/fortran/decl.c	(revision 139534)
+++ gcc/fortran/decl.c	(working copy)
@@ -6868,6 +6868,7 @@ match_procedure_in_type (void)
   gfc_symtree* stree;
   gfc_namespace* ns;
   gfc_symbol* block;
+  gfc_component* comp;
 
   /* Check current state.  */
   gcc_assert (gfc_state_stack->state == COMP_DERIVED_CONTAINS);
@@ -6966,6 +6967,15 @@ match_procedure_in_type (void)
       return MATCH_ERROR;
     }
 
+  /* If there's a component with this name, its an error, too.  */
+  for (comp = block->components; comp; comp = comp->next)
+    if (!strcmp (name, comp->name))
+      {
+	gfc_error ("Procedure '%s' at %C has the same name as a component",
+		   name);
+	return MATCH_ERROR;
+      }
+
   /* Insert it and set attributes.  */
   if (gfc_get_sym_tree (name, ns, &stree))
     return MATCH_ERROR;
Index: gcc/fortran/parse.c
===================================================================
--- gcc/fortran/parse.c	(revision 139534)
+++ gcc/fortran/parse.c	(working copy)
@@ -1715,8 +1715,19 @@ parse_derived_contains (void)
   bool error_flag = false;
   bool to_finish;
 
-  accept_statement (ST_CONTAINS);
   gcc_assert (gfc_current_state () == COMP_DERIVED);
+  gcc_assert (gfc_current_block ());
+
+  /* Derived-types with SEQUENCE and/or BIND(C) must not have a CONTAINS
+     section.  */
+  if (gfc_current_block ()->attr.sequence)
+    gfc_error ("Derived-type '%s' with SEQUENCE must not have a CONTAINS"
+	       " section at %C", gfc_current_block ()->name);
+  if (gfc_current_block ()->attr.is_bind_c)
+    gfc_error ("Derived-type '%s' with BIND(C) must not have a CONTAINS"
+	       " section at %C", gfc_current_block ()->name);
+
+  accept_statement (ST_CONTAINS);
   push_state (&s, COMP_DERIVED_CONTAINS, NULL);
 
   to_finish = false;
Index: gcc/testsuite/gfortran.dg/typebound_proc_8.f03
===================================================================
--- gcc/testsuite/gfortran.dg/typebound_proc_8.f03	(revision 0)
+++ gcc/testsuite/gfortran.dg/typebound_proc_8.f03	(revision 0)
@@ -0,0 +1,21 @@
+! { dg-do compile }
+
+! Type-bound procedures
+! Test for name collision between type-bound procedures and components.
+! This could have gone into typebound_proc_4 but that one was already too
+! large.
+
+MODULE testmod
+  IMPLICIT NONE
+
+  TYPE t
+    REAL :: comp
+  CONTAINS
+    PROCEDURE, NOPASS :: comp ! { dg-error "same name as a component" }
+  END TYPE t
+
+CONTAINS
+
+END MODULE testmod
+
+! { dg-final { cleanup-modules "testmod" } }
Index: gcc/testsuite/gfortran.dg/typebound_proc_7.f03
===================================================================
--- gcc/testsuite/gfortran.dg/typebound_proc_7.f03	(revision 0)
+++ gcc/testsuite/gfortran.dg/typebound_proc_7.f03	(revision 0)
@@ -0,0 +1,34 @@
+! { dg-do compile }
+
+! Type-bound procedures
+! Tests that SEQUENCE and BIND(C) types do not allow a type-bound procedure
+! section.
+
+MODULE testmod
+  USE ISO_C_BINDING
+  IMPLICIT NONE
+
+  TYPE sequencet
+    SEQUENCE
+    INTEGER :: a, b
+  CONTAINS ! { dg-error "SEQUENCE" }
+    PROCEDURE, NOPASS :: proc_noarg
+  END TYPE sequencet
+
+  TYPE, BIND(C) :: bindct
+    INTEGER(c_int) :: a
+    REAL(c_float) :: b
+  CONTAINS ! { dg-error "BIND" }
+    PROCEDURE, NOPASS :: proc_noarg
+  END TYPE bindct
+
+CONTAINS
+
+  SUBROUTINE proc_noarg ()
+  END SUBROUTINE proc_noarg
+
+END MODULE testmod
+
+! { dg-final { cleanup-modules "testmod" } }
+! FIXME: Remove not-yet-implemented error when implemented.
+! { dg-excess-errors "not yet implemented" }