re PR fortran/46370 ([Coarray] [OOP] ALLOCATE: Error allocating CLASS coarrays)

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.

From-SVN: r167715

5 files changed, 80 insertions, 8 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 03068e0..7c3fca8 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,10 @@
+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  Mikael Morin   <mikael@gcc.gnu.org>
 	    Jerry DeLisle  <jvdelisle@gcc.gnu.org>
 
diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c
index 9632d1c..1ec677b 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/ChangeLog b/gcc/testsuite/ChangeLog
index ed15e16..934212f 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2010-12-11  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/46370
+	* gfortran.dg/coarray_14.f90: New.
+
 2010-12-11  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
 
 	PR fortran/46842
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" } }