diff mbox

[Fortran] PR 46370: Error allocating CLASS coarrays

Message ID 4D03DEDD.8080906@net-b.de
State New
Headers show

Commit Message

Tobias Burnus Dec. 11, 2010, 8:28 p.m. UTC 
The check for C617 was too strict as the following was rejected,
    ALLOCATE(polym_type[*]),
but there is no subobject of the coindexed object. Additionally, the 
array ref matcher did not know that there is a coarray as the CLASS 
contained hid  the issue.

The test case for C1229 is superfluous but I wanted to make sure that 
part is correctly handled (it is).

R611 data-ref is part-ref [ % part-ref ] ...
C617 (R611) Except as an actual argument to an intrinsic inquiry 
function or as the designator in a type parameter inquiry, a data-ref 
shall not be a polymorphic subobject of a coindexed object and shall not 
be a coindexed object that has a polymorphic allocatable subcomponent.

R1221 procedure-designator is ...or data-ref % binding-name
C1229 (R1221) A data-ref shall not be a polymorphic subobject of a 
coindexed object.

Build and currently regtesting on x86-64-linux. (The coarray* tests pass 
thus I do not expect surprises.)
OK for the trunk?

Tobias

Comments

Steve Kargl Dec. 11, 2010, 9:01 p.m. UTC | #1 
On Sat, Dec 11, 2010 at 09:28:13PM +0100, Tobias Burnus wrote:
> The check for C617 was too strict as the following was rejected,
>    ALLOCATE(polym_type[*]),
> but there is no subobject of the coindexed object. Additionally, the 
> array ref matcher did not know that there is a coarray as the CLASS 
> contained hid  the issue.
> 
> The test case for C1229 is superfluous but I wanted to make sure that 
> part is correctly handled (it is).
> 
> R611 data-ref is part-ref [ % part-ref ] ...
> C617 (R611) Except as an actual argument to an intrinsic inquiry 
> function or as the designator in a type parameter inquiry, a data-ref 
> shall not be a polymorphic subobject of a coindexed object and shall not 
> be a coindexed object that has a polymorphic allocatable subcomponent.
> 
> R1221 procedure-designator is ...or data-ref % binding-name
> C1229 (R1221) A data-ref shall not be a polymorphic subobject of a 
> coindexed object.
> 
> Build and currently regtesting on x86-64-linux. (The coarray* tests pass 
> thus I do not expect surprises.)
> OK for the trunk?
> 

OK.

Although I might suggest sprinkling a few () into three ternary 
conditional to help the read.  The following is one ugly bit of
code :-)

+                              sym->ts.type == BT_CLASS
+                              ? CLASS_DATA (sym)->as
+                                ? CLASS_DATA (sym)->as->corank : 0
+                              : sym->as ? sym->as->corank : 0);
diff mbox

Patch

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" } }