trans-expr.c (gfc_get_tree_for_caf_expr): Reject unimplemented coindexed coarray accesses.

2015-03-21  Tobias Burnus  <burnus@net-b.de>

        * trans-expr.c (gfc_get_tree_for_caf_expr): Reject unimplemented
        coindexed coarray accesses.

2015-03-21  Tobias Burnus  <burnus@net-b.de>

        * gfortran.dg/coarray_38.f90: New.
        * gfortran.dg/coarray_39.f90: New.
        * gfortran.dg/coarray/coindexed_3.f90: Add dg-error, turn into
        compile test.

From-SVN: r221549

gcc/fortran/ChangeLog

+2015-03-21  Tobias Burnus  <burnus@net-b.de>
+
+	* trans-expr.c (gfc_get_tree_for_caf_expr): Reject unimplemented
+	coindexed coarray accesses.
+
 2014-03-17  Paul Thomas  <pault@gcc.gnu.org>
 
 	PR fortran/59198

gcc/fortran/trans-expr.c

@@ -1498,10 +1498,65 @@ gfc_get_tree_for_caf_expr (gfc_expr *expr)
 {
   tree caf_decl;
   bool found = false;
-  gfc_ref *ref;
+  gfc_ref *ref, *comp_ref = NULL;
 
   gcc_assert (expr && expr->expr_type == EXPR_VARIABLE);
 
+  /* Not-implemented diagnostic.  */
+  for (ref = expr->ref; ref; ref = ref->next)
+    if (ref->type == REF_COMPONENT)
+      {
+        comp_ref = ref;
+	if ((ref->u.c.component->ts.type == BT_CLASS
+	     && !CLASS_DATA (ref->u.c.component)->attr.codimension
+	     && (CLASS_DATA (ref->u.c.component)->attr.pointer
+		 || CLASS_DATA (ref->u.c.component)->attr.allocatable))
+	    || (ref->u.c.component->ts.type != BT_CLASS
+		&& !ref->u.c.component->attr.codimension
+		&& (ref->u.c.component->attr.pointer
+		    || ref->u.c.component->attr.allocatable)))
+	  gfc_error ("Sorry, coindexed access to a pointer or allocatable "
+		     "component of the coindexed coarray at %L is not yet "
+		     "supported", &expr->where);
+      }
+  if ((!comp_ref
+       && ((expr->symtree->n.sym->ts.type == BT_CLASS
+	    && CLASS_DATA (expr->symtree->n.sym)->attr.alloc_comp)
+	   || (expr->symtree->n.sym->ts.type == BT_DERIVED
+	       && expr->symtree->n.sym->ts.u.derived->attr.alloc_comp)))
+      || (comp_ref
+	  && ((comp_ref->u.c.component->ts.type == BT_CLASS
+	       && CLASS_DATA (comp_ref->u.c.component)->attr.alloc_comp)
+	      || (comp_ref->u.c.component->ts.type == BT_DERIVED
+		  && comp_ref->u.c.component->ts.u.derived->attr.alloc_comp))))
+    gfc_error ("Sorry, coindexed coarray at %L with allocatable component is "
+	       "not yet supported", &expr->where);
+
+  if (expr->rank)
+    {
+      /* Without the new array descriptor, access like "caf[i]%a(:)%b" is in
+	 general not possible as the required stride multiplier might be not
+	 a multiple of c_sizeof(b). In case of noncoindexed access, the
+	 scalarizer often takes care of it - for coarrays, it always fails.  */
+      for (ref = expr->ref; ref; ref = ref->next)
+        if (ref->type == REF_COMPONENT
+	    && ((ref->u.c.component->ts.type == BT_CLASS
+		 && CLASS_DATA (ref->u.c.component)->attr.codimension)
+	        || (ref->u.c.component->ts.type != BT_CLASS
+		    && ref->u.c.component->attr.codimension)))
+	  break;
+      if (ref == NULL)
+	ref = expr->ref;
+      for ( ; ref; ref = ref->next)
+	if (ref->type == REF_ARRAY && ref->u.ar.dimen)
+	  break;
+      for ( ; ref; ref = ref->next)
+	if (ref->type == REF_COMPONENT)
+	  gfc_error ("Sorry, coindexed access at %L to a scalar component "
+		     "with an array partref is not yet supported",
+		     &expr->where);
+    }
+
   caf_decl = expr->symtree->n.sym->backend_decl;
   gcc_assert (caf_decl);
   if (expr->symtree->n.sym->ts.type == BT_CLASS)

gcc/testsuite/ChangeLog

+2015-03-21  Tobias Burnus  <burnus@net-b.de>
+
+	* gfortran.dg/coarray_38.f90: New.
+	* gfortran.dg/coarray_39.f90: New.
+	* gfortran.dg/coarray/coindexed_3.f90: Add dg-error, turn into
+	compile test.
+
 2015-03-20  Marek Polacek  <polacek@redhat.com>
 
 	PR c++/65398

gcc/testsuite/gfortran.dg/coarray/coindexed_3.f90

-! { dg-do run }
+! { dg-do compile }
 !
 ! Contributed by Reinhold Bader
 !
@@ -45,8 +45,8 @@ program pmup
   allocate(t :: a(3)[*])
   IF (this_image() == num_images()) THEN
     SELECT TYPE (a)
-      TYPE IS (t)
-      a(:)[1]%a = 4.0
+      TYPE IS (t)     ! FIXME: When implemented, turn into "do-do run"
+      a(:)[1]%a = 4.0 ! { dg-error "Sorry, coindexed access at \\(1\\) to a scalar component with an array partref is not yet supported" }
     END SELECT
   END IF
   SYNC ALL
@@ -56,8 +56,8 @@ program pmup
    TYPE IS (real)
       ii = a(1)[1]
       call abort()
-    TYPE IS (t)
-      IF (ALL(A(:)[1]%a == 4.0)) THEN
+    TYPE IS (t)                       ! FIXME: When implemented, turn into "do-do run"
+      IF (ALL(A(:)[1]%a == 4.0)) THEN ! { dg-error "Sorry, coindexed access at \\(1\\) to a scalar component with an array partref is not yet supported" }
         !WRITE(*,*) 'OK'
       ELSE
         WRITE(*,*) 'FAIL'

gcc/testsuite/gfortran.dg/coarray_38.f90

+! { dg-do compile }
+! { dg-options "-fcoarray=lib" }
+!
+! Valid code - but currently not implemented for -fcoarray=lib; single okay 
+!
+subroutine one
+implicit none
+type t
+  integer, allocatable :: a
+  integer :: b
+end type t
+type t2
+  type(t), allocatable :: caf2[:]
+end type t2
+type(t), save :: caf[*],x
+type(t2) :: y
+
+x = caf[4]     ! { dg-error "Sorry, coindexed coarray at \\(1\\) with allocatable component is not yet supported" }
+x%a = caf[4]%a ! { dg-error "Sorry, coindexed access to a pointer or allocatable component of the coindexed coarray at \\(1\\) is not yet supported" }
+x%b = caf[4]%b ! OK
+x = y%caf2[5]  ! { dg-error "Sorry, coindexed coarray at \\(1\\) with allocatable component is not yet supported" }
+x%a = y%caf2[4]%a ! { dg-error "Sorry, coindexed access to a pointer or allocatable component of the coindexed coarray at \\(1\\) is not yet supported" }
+x%b = y%caf2[4]%b ! OK
+end subroutine one
+
+subroutine two
+implicit none
+type t
+  integer, pointer :: a
+  integer :: b
+end type t
+type t2
+  type(t), allocatable :: caf2[:]
+end type t2
+type(t), save :: caf[*],x
+type(t2) :: y
+
+x = caf[4]     ! OK
+x%a = caf[4]%a ! { dg-error "Sorry, coindexed access to a pointer or allocatable component of the coindexed coarray at \\(1\\) is not yet supported" }
+x%b = caf[4]%b ! OK
+x = y%caf2[5]  ! OK
+x%a = y%caf2[4]%a ! { dg-error "Sorry, coindexed access to a pointer or allocatable component of the coindexed coarray at \\(1\\) is not yet supported" }
+x%b = y%caf2[4]%b ! OK
+end subroutine two
+
+subroutine three
+implicit none
+type t
+  integer :: b
+end type t
+type t2
+  type(t), allocatable :: caf2(:)[:]
+end type t2
+type(t), save :: caf(10)[*]
+integer :: x(10)
+type(t2) :: y
+
+x(1) = caf(2)[4]%b ! OK
+x(:) = caf(:)[4]%b ! { dg-error "Sorry, coindexed access at \\(1\\) to a scalar component with an array partref is not yet supported" }
+
+x(1) = y%caf2(2)[4]%b ! OK
+x(:) = y%caf2(:)[4]%b ! { dg-error "Sorry, coindexed access at \\(1\\) to a scalar component with an array partref is not yet supported" }
+end subroutine three
+
+subroutine four
+implicit none
+type t
+  integer, allocatable :: a
+  integer :: b
+end type t
+type t2
+  class(t), allocatable :: caf2[:]
+end type t2
+class(t), allocatable :: caf[:]
+type(t) :: x
+type(t2) :: y
+
+!x = caf[4]    ! Unsupported - and ICEs in resolve_ordinary_assign, cf. PR fortran/65397
+x%a = caf[4]%a ! { dg-error "Sorry, coindexed access to a pointer or allocatable component of the coindexed coarray at \\(1\\) is not yet supported" }
+x%b = caf[4]%b ! OK
+!x = y%caf2[5] ! Unsupported - and ICEs in resolve_ordinary_assign, cf. PR fortran/65397
+x%a = y%caf2[4]%a ! { dg-error "Sorry, coindexed access to a pointer or allocatable component of the coindexed coarray at \\(1\\) is not yet supported" }
+x%b = y%caf2[4]%b ! OK
+end subroutine four
+
+subroutine five
+implicit none
+type t
+  integer, pointer :: a
+  integer :: b
+end type t
+type t2
+  class(t), allocatable :: caf2[:]
+end type t2
+class(t), save, allocatable :: caf[:]
+type(t) :: x
+type(t2) :: y
+
+!x = caf[4]     ! OK - but ICEs in resolve_ordinary_assign, cf. PR fortran/65397
+x%a = caf[4]%a ! { dg-error "Sorry, coindexed access to a pointer or allocatable component of the coindexed coarray at \\(1\\) is not yet supported" }
+x%b = caf[4]%b ! OK
+!x = y%caf2[5]  ! OK - but ICEs in resolve_ordinary_assign, cf. PR fortran/65397
+x%a = y%caf2[4]%a ! { dg-error "Sorry, coindexed access to a pointer or allocatable component of the coindexed coarray at \\(1\\) is not yet supported" }
+x%b = y%caf2[4]%b ! OK
+end subroutine five
+
+subroutine six
+implicit none
+type t
+  integer :: b
+end type t
+type t2
+  class(t), allocatable :: caf2(:)[:]
+end type t2
+class(t), save, allocatable :: caf(:)[:]
+integer :: x(10)
+type(t2) :: y
+
+x(1) = caf(2)[4]%b ! OK
+x(:) = caf(:)[4]%b ! { dg-error "Sorry, coindexed access at \\(1\\) to a scalar component with an array partref is not yet supported" }
+
+x(1) = y%caf2(2)[4]%b ! OK
+x(:) = y%caf2(:)[4]%b ! { dg-error "Sorry, coindexed access at \\(1\\) to a scalar component with an array partref is not yet supported" }
+end subroutine six

gcc/testsuite/gfortran.dg/coarray_39.f90

+! { dg-do compile }
+! { dg-options "-fcoarray=single" }
+!
+! Valid code - but currently not implemented for -fcoarray=lib; single okay 
+!
+subroutine one
+implicit none
+type t
+  integer, allocatable :: a
+  integer :: b
+end type t
+type t2
+  type(t), allocatable :: caf2[:]
+end type t2
+type(t), save :: caf[*],x
+type(t2) :: y
+
+x = caf[4]
+x%a = caf[4]%a
+x%b = caf[4]%a
+x = y%caf2[5]
+x%a = y%caf2[4]%a
+x%b = y%caf2[4]%b
+end subroutine one
+
+subroutine two
+implicit none
+type t
+  integer, pointer :: a
+  integer :: b
+end type t
+type t2
+  type(t), allocatable :: caf2[:]
+end type t2
+type(t), save :: caf[*],x
+type(t2) :: y
+
+x = caf[4]
+x%a = caf[4]%a
+x%b = caf[4]%b
+x = y%caf2[5]
+x%a = y%caf2[4]%a
+x%b = y%caf2[4]%b
+end subroutine two
+
+subroutine three
+implicit none
+type t
+  integer :: b
+end type t
+type t2
+  type(t), allocatable :: caf2(:)[:]
+end type t2
+type(t), save :: caf(10)[*]
+integer :: x(10)
+type(t2) :: y
+
+x(1) = caf(2)[4]%b
+x(:) = caf(:)[4]%b
+
+x(1) = y%caf2(2)[4]%b
+x(:) = y%caf2(:)[4]%b
+end subroutine three
+
+subroutine four
+implicit none
+type t
+  integer, allocatable :: a
+  integer :: b
+end type t
+type t2
+  class(t), allocatable :: caf2[:]
+end type t2
+class(t), allocatable :: caf[:]
+type(t) :: x
+type(t2) :: y
+
+x = caf[4]
+x%a = caf[4]%a
+x%b = caf[4]%b
+x = y%caf2[5]
+x%a = y%caf2[4]%a
+x%b = y%caf2[4]%b
+end subroutine four
+
+subroutine five
+implicit none
+type t
+  integer, pointer :: a
+  integer :: b
+end type t
+type t2
+  class(t), allocatable :: caf2[:]
+end type t2
+class(t), save, allocatable :: caf[:]
+type(t) :: x
+type(t2) :: y
+
+x = caf[4]
+x%a = caf[4]%a
+x%b = caf[4]%b
+x = y%caf2[5]
+x%a = y%caf2[4]%a
+x%b = y%caf2[4]%b
+end subroutine five
+
+subroutine six
+implicit none
+type t
+  integer :: b
+end type t
+type t2
+  class(t), allocatable :: caf2(:)[:]
+end type t2
+class(t), save, allocatable :: caf(:)[:]
+integer :: x(10)
+type(t2) :: y
+
+x(1) = caf(2)[4]%b
+x(:) = caf(:)[4]%b
+
+x(1) = y%caf2(2)[4]%b
+x(:) = y%caf2(:)[4]%b
+end subroutine six