From: Tobias Burnus Date: Tue, 24 Mar 2015 07:14:22 +0000 (+0100) Subject: coindexed_1.f90: Moved from gfortran.dg/coarray/coindexed_3.f90; added dg-options. X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=f9addac7825df87c80c95db7070f1ce60b6700a9;p=gcc.git coindexed_1.f90: Moved from gfortran.dg/coarray/coindexed_3.f90; added dg-options. 2015-03-24 Tobias Burnus * gfortran.dg/coindexed_1.f90: Moved from gfortran.dg/coarray/coindexed_3.f90; added dg-options. From-SVN: r221618 --- diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 1d94255b54f..2deffd0c029 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2015-03-24 Tobias Burnus + + * gfortran.dg/coindexed_1.f90: Moved from + gfortran.dg/coarray/coindexed_3.f90; added dg-options. + 2015-03-23 Jakub Jelinek PR testsuite/65506 diff --git a/gcc/testsuite/gfortran.dg/coarray/coindexed_3.f90 b/gcc/testsuite/gfortran.dg/coarray/coindexed_3.f90 deleted file mode 100644 index 4642f2cfcf9..00000000000 --- a/gcc/testsuite/gfortran.dg/coarray/coindexed_3.f90 +++ /dev/null @@ -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 diff --git a/gcc/testsuite/gfortran.dg/coindexed_1.f90 b/gcc/testsuite/gfortran.dg/coindexed_1.f90 new file mode 100644 index 00000000000..878c46f7618 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/coindexed_1.f90 @@ -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