Re: [Patch, Fortran] Reject unsupported coarray communication

Re: [Patch, Fortran] Reject unsupported coarray communication

[Dominique Dhumieres]

Dear Tobias,

The test gfortran.dg/coarray/coindexed_3.f90 compiles without error,
see https://gcc.gnu.org/ml/gcc-testresults/2015-03/msg02446.html.

TIA

Dominique

Re: [Patch, Fortran] Reject unsupported coarray communication

[Tobias Burnus]

[-- Attachment #1: Type: text/plain, Size: 452 bytes --]

Dear Dominique,

Dominique Dhumieres wrote:
> The test gfortran.dg/coarray/coindexed_3.f90 compiles without error,
> see https://gcc.gnu.org/ml/gcc-testresults/2015-03/msg02446.html.

Ups, I somehow missed that files under coarray/ are run with both 
-fcoarray=single and =lib; the error (rightly!) only is shown with =lib.
I have now moved the test case and added an explicit -fcoarray=lib.

Thanks for the report! (Committed as Rev. 221618.)

Tobias

[-- Attachment #2: committed.diff --]
[-- Type: text/x-patch, Size: 4404 bytes --]

Index: gcc/testsuite/ChangeLog
===================================================================
--- gcc/testsuite/ChangeLog	(Revision 221614)
+++ gcc/testsuite/ChangeLog	(Arbeitskopie)
@@ -1,3 +1,8 @@
+2015-03-24  Tobias Burnus  <burnus@net-b.de>
+
+	* gfortran.dg/coindexed_1.f90: Moved from
+	gfortran.dg/coarray/coindexed_3.f90; added dg-options.
+
 2015-03-23  Jakub Jelinek  <jakub@redhat.com>
 
 	PR testsuite/65506
Index: gcc/testsuite/gfortran.dg/coarray/coindexed_3.f90
===================================================================
--- gcc/testsuite/gfortran.dg/coarray/coindexed_3.f90	(Revision 221614)
+++ gcc/testsuite/gfortran.dg/coarray/coindexed_3.f90	(Arbeitskopie)
@@ -1,71 +0,0 @@
-! { dg-do compile }
-!
-! Contributed by Reinhold Bader
-!
-
-program pmup
-  implicit none
-  type t
-    integer :: b, a
-  end type t
-
-  CLASS(*), allocatable :: a(:)[:]
-  integer :: ii
-
-  !! --- ONE --- 
-  allocate(real :: a(3)[*])
-  IF (this_image() == num_images()) THEN
-    SELECT TYPE (a)
-      TYPE IS (real)
-      a(:)[1] = 2.0
-    END SELECT
-  END IF
-  SYNC ALL
-
-  IF (this_image() == 1) THEN
-    SELECT TYPE (a)
-      TYPE IS (real)
-        IF (ALL(A(:)[1] == 2.0)) THEN
-          !WRITE(*,*) 'OK'
-        ELSE
-          WRITE(*,*) 'FAIL'
-          call abort()
-        END IF
-      TYPE IS (t)
-        ii = a(1)[1]%a
-        call abort()
-      CLASS IS (t)
-        ii = a(1)[1]%a
-        call abort()
-    END SELECT
-  END IF
-
-  !! --- TWO --- 
-  deallocate(a)
-  allocate(t :: a(3)[*])
-  IF (this_image() == num_images()) THEN
-    SELECT TYPE (a)
-      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
-
-  IF (this_image() == 1) THEN
-    SELECT TYPE (a)
-   TYPE IS (real)
-      ii = a(1)[1]
-      call abort()
-    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'
-        call abort()
-      END IF
-    CLASS IS (t)
-      ii = a(1)[1]%a
-      call abort()
-    END SELECT
-  END IF
-end program
Index: gcc/testsuite/gfortran.dg/coindexed_1.f90
===================================================================
--- gcc/testsuite/gfortran.dg/coindexed_1.f90	(Revision 0)
+++ gcc/testsuite/gfortran.dg/coindexed_1.f90	(Arbeitskopie)
@@ -0,0 +1,72 @@
+! { dg-do compile }
+! { dg-options "-fcoarray=lib" }
+!
+! Contributed by Reinhold Bader
+!
+
+program pmup
+  implicit none
+  type t
+    integer :: b, a
+  end type t
+
+  CLASS(*), allocatable :: a(:)[:]
+  integer :: ii
+
+  !! --- ONE --- 
+  allocate(real :: a(3)[*])
+  IF (this_image() == num_images()) THEN
+    SELECT TYPE (a)
+      TYPE IS (real)
+      a(:)[1] = 2.0
+    END SELECT
+  END IF
+  SYNC ALL
+
+  IF (this_image() == 1) THEN
+    SELECT TYPE (a)
+      TYPE IS (real)
+        IF (ALL(A(:)[1] == 2.0)) THEN
+          !WRITE(*,*) 'OK'
+        ELSE
+          WRITE(*,*) 'FAIL'
+          call abort()
+        END IF
+      TYPE IS (t)
+        ii = a(1)[1]%a
+        call abort()
+      CLASS IS (t)
+        ii = a(1)[1]%a
+        call abort()
+    END SELECT
+  END IF
+
+  !! --- TWO --- 
+  deallocate(a)
+  allocate(t :: a(3)[*])
+  IF (this_image() == num_images()) THEN
+    SELECT TYPE (a)
+      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
+
+  IF (this_image() == 1) THEN
+    SELECT TYPE (a)
+   TYPE IS (real)
+      ii = a(1)[1]
+      call abort()
+    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'
+        call abort()
+      END IF
+    CLASS IS (t)
+      ii = a(1)[1]%a
+      call abort()
+    END SELECT
+  END IF
+end program

Re: [Patch, Fortran] Reject unsupported coarray communication

[Jerry DeLisle]

On 03/12/2015 12:18 AM, Tobias Burnus wrote:
> There are two groups of features which are not properly implemented with remote
> access:
>
> * "caf(:)[i]%a" might have a byte stride which is not compatible with the size
> of "a". (Fix: new array descriptor.)
> * All access which involves dereferencing pointers in a remote coarray (e.g.
> "caf[i]%ptr_comp = 5") are not supported.
>
> This patch now rejects them - instead of accepting them silently and doing the
> wrong things at runtime.
>
> Build and regtested on x86-64-gnu-linux
> OK for the trunk?
>
> Tobias

OK for trunk.

Jerry

[Patch, Fortran] Reject unsupported coarray communication

[Tobias Burnus]

[-- Attachment #1: Type: text/plain, Size: 500 bytes --]

There are two groups of features which are not properly implemented with 
remote access:

* "caf(:)[i]%a" might have a byte stride which is not compatible with 
the size of "a". (Fix: new array descriptor.)
* All access which involves dereferencing pointers in a remote coarray 
(e.g. "caf[i]%ptr_comp = 5") are not supported.

This patch now rejects them - instead of accepting them silently and 
doing the wrong things at runtime.

Build and regtested on x86-64-gnu-linux
OK for the trunk?

Tobias

[-- Attachment #2: caf-reject.diff --]
[-- Type: text/x-patch, Size: 11448 bytes --]

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

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

	* 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.

 gcc/fortran/trans-expr.c                          |  57 +++++++++-
 gcc/testsuite/gfortran.dg/coarray/coindexed_3.f90 |  10 +-
 gcc/testsuite/gfortran.dg/coarray_38.f90          | 124 ++++++++++++++++++++++
 gcc/testsuite/gfortran.dg/coarray_39.f90          | 124 ++++++++++++++++++++++
 4 files changed, 309 insertions(+), 6 deletions(-)

diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 353d012..87d3a2d 100644
--- a/gcc/fortran/trans-expr.c
+++ b/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)
diff --git a/gcc/testsuite/gfortran.dg/coarray/coindexed_3.f90 b/gcc/testsuite/gfortran.dg/coarray/coindexed_3.f90
index 46488f3..4642f2c 100644
--- a/gcc/testsuite/gfortran.dg/coarray/coindexed_3.f90
+++ b/gcc/testsuite/gfortran.dg/coarray/coindexed_3.f90
@@ -1,4 +1,4 @@
-! { 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'
diff --git a/gcc/testsuite/gfortran.dg/coarray_38.f90 b/gcc/testsuite/gfortran.dg/coarray_38.f90
new file mode 100644
index 0000000..ea62878
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray_38.f90
@@ -0,0 +1,124 @@
+! { 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
diff --git a/gcc/testsuite/gfortran.dg/coarray_39.f90 b/gcc/testsuite/gfortran.dg/coarray_39.f90
new file mode 100644
index 0000000..17eacb0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray_39.f90
@@ -0,0 +1,124 @@
+! { 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