diff mbox

[Fortran] Reject unsupported coarray communication

Message ID 55110F40.8070702@net-b.de
State New
Headers show

Commit Message

Tobias Burnus March 24, 2015, 7:16 a.m. UTC 
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
diff mbox

Patch

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