2010-12-11  Tobias Burnus  <burnus@net-b.de>

	PR fortran/46370
	* primary.c (gfc_match_varspec): Pass information about codimension
	to gfc_match_array_ref also for BT_CLASS.
	* resolve.c (resolve_procedure): Correct check for C612.

2010-12-11  Tobias Burnus  <burnus@net-b.de>

	PR fortran/46370
	* gfortran.dg/coarray_14.f90: New.

diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c
index 9632d1c..7c20da6 100644
--- a/gcc/fortran/primary.c
+++ b/gcc/fortran/primary.c
@@ -1783,7 +1783,11 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag,
       tail->type = REF_ARRAY;
 
       m = gfc_match_array_ref (&tail->u.ar, equiv_flag ? NULL : sym->as,
-			       equiv_flag, sym->as ? sym->as->corank : 0);
+			       equiv_flag,
+			       sym->ts.type == BT_CLASS
+			       ? CLASS_DATA (sym)->as
+				 ? CLASS_DATA (sym)->as->corank : 0
+			       : sym->as ? sym->as->corank : 0);
       if (m != MATCH_YES)
 	return m;
 
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 9d8ee23..ab49e93 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -5027,13 +5027,6 @@ resolve_procedure:
     {
       gfc_ref *ref, *ref2 = NULL;
 
-      if (e->ts.type == BT_CLASS)
-	{
-	  gfc_error ("Polymorphic subobject of coindexed object at %L",
-		     &e->where);
-	  t = FAILURE;
-	}
-
       for (ref = e->ref; ref; ref = ref->next)
 	{
 	  if (ref->type == REF_COMPONENT)
@@ -5046,6 +5039,14 @@ resolve_procedure:
 	if (ref->type == REF_COMPONENT)
 	  break;
 
+      /* Expression itself is not coindexed object.  */
+      if (ref && e->ts.type == BT_CLASS)
+	{
+	  gfc_error ("Polymorphic subobject of coindexed object at %L",
+		     &e->where);
+	  t = FAILURE;
+	}
+
       /* Expression itself is coindexed object.  */
       if (ref == NULL)
 	{
diff --git a/gcc/testsuite/gfortran.dg/coarray_14.f90 b/gcc/testsuite/gfortran.dg/coarray_14.f90
new file mode 100644
index 0000000..9230ad4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray_14.f90
@@ -0,0 +1,55 @@
+! { dg-do compile }
+! { dg-options "-fcoarray=single" }
+!
+! PR fortran/46370
+!
+! Coarray checks
+!
+
+! Check for C1229: "A data-ref shall not be a polymorphic subobject of a
+! coindexed object." which applies to function and subroutine calls.
+module m
+  implicit none
+  type t
+  contains
+    procedure, nopass :: sub=>sub
+    procedure, nopass :: func=>func
+  end type t
+  type t3
+    type(t) :: nopoly
+  end type t3
+  type t2
+    class(t), allocatable :: poly
+    class(t3), allocatable :: poly2
+  end type t2
+contains
+  subroutine sub()
+  end subroutine sub
+  function func()
+    integer :: func
+  end function func
+end module m
+
+subroutine test(x)
+  use m
+  type(t2) :: x[*]
+  integer :: i
+  call x[1]%poly2%nopoly%sub() ! OK
+  i = x[1]%poly2%nopoly%func() ! OK
+  call x[1]%poly%sub() ! { dg-error "Polymorphic subobject of coindexed object" }
+  i = x[1]%poly%func() ! { dg-error "Polymorphic subobject of coindexed object" }
+end subroutine test
+
+
+! Check for C617: "... a data-ref shall not be a polymorphic subobject of a
+! coindexed object or ..." 
+! Before, the second allocate statment was failing - though it is no subobject.
+program myTest
+type t
+end type t
+class(t), allocatable :: a[:]
+ allocate (t :: a) ! { dg-error "Coarray specification required in ALLOCATE statement" }
+allocate (t :: a[*]) ! { dg-error "allocatable scalar coarrays are not yet supported" }
+end program myTest
+
+! { dg-final { cleanup-modules "m" } }