From fa7d9b00f3a9134282ee70ab34543c87fea06a82 Mon Sep 17 00:00:00 2001 From: Ilmir Usmanov Date: Wed, 26 Feb 2014 19:05:23 +0400 Subject: [PATCH 5/5] OpenACC Fortran FE: Tests --- gcc/testsuite/gfortran.dg/goacc/assumed.f95 | 66 +++ gcc/testsuite/gfortran.dg/goacc/branch.f95 | 53 ++ gcc/testsuite/gfortran.dg/goacc/coarray.f95 | 35 ++ .../gfortran.dg/goacc/continuation-free-form.f95 | 23 + gcc/testsuite/gfortran.dg/goacc/cray.f95 | 53 ++ gcc/testsuite/gfortran.dg/goacc/critical.f95 | 27 + gcc/testsuite/gfortran.dg/goacc/data-clauses.f95 | 259 ++++++++ gcc/testsuite/gfortran.dg/goacc/data-tree.f95 | 31 + gcc/testsuite/gfortran.dg/goacc/declare-1.f95 | 20 + .../gfortran.dg/goacc/enter-exit-data.f95 | 88 +++ gcc/testsuite/gfortran.dg/goacc/goacc.exp | 36 ++ gcc/testsuite/gfortran.dg/goacc/host_data-tree.f95 | 13 + gcc/testsuite/gfortran.dg/goacc/if.f95 | 52 ++ gcc/testsuite/gfortran.dg/goacc/kernels-tree.f95 | 33 ++ gcc/testsuite/gfortran.dg/goacc/list.f95 | 111 ++++ gcc/testsuite/gfortran.dg/goacc/literal.f95 | 29 + gcc/testsuite/gfortran.dg/goacc/loop-1.f95 | 170 ++++++ gcc/testsuite/gfortran.dg/goacc/loop-2.f95 | 649 +++++++++++++++++++++ gcc/testsuite/gfortran.dg/goacc/loop-3.f95 | 31 + gcc/testsuite/gfortran.dg/goacc/omp.f95 | 66 +++ .../gfortran.dg/goacc/parallel-kernels-clauses.f95 | 98 ++++ .../gfortran.dg/goacc/parallel-kernels-regions.f95 | 56 ++ gcc/testsuite/gfortran.dg/goacc/parallel-tree.f95 | 42 ++ gcc/testsuite/gfortran.dg/goacc/parameter.f95 | 30 + .../goacc/pure-elemental-procedures.f95 | 78 +++ gcc/testsuite/gfortran.dg/goacc/reduction.f95 | 138 +++++ .../gfortran.dg/goacc/sentinel-free-form.f95 | 21 + .../gfortran.dg/goacc/several-directives.f95 | 6 + gcc/testsuite/gfortran.dg/goacc/sie.f95 | 252 ++++++++ 29 files changed, 2566 insertions(+) create mode 100644 gcc/testsuite/gfortran.dg/goacc/assumed.f95 create mode 100644 gcc/testsuite/gfortran.dg/goacc/branch.f95 create mode 100644 gcc/testsuite/gfortran.dg/goacc/coarray.f95 create mode 100644 gcc/testsuite/gfortran.dg/goacc/continuation-free-form.f95 create mode 100644 gcc/testsuite/gfortran.dg/goacc/cray.f95 create mode 100644 gcc/testsuite/gfortran.dg/goacc/critical.f95 create mode 100644 gcc/testsuite/gfortran.dg/goacc/data-clauses.f95 create mode 100644 gcc/testsuite/gfortran.dg/goacc/data-tree.f95 create mode 100644 gcc/testsuite/gfortran.dg/goacc/declare-1.f95 create mode 100644 gcc/testsuite/gfortran.dg/goacc/enter-exit-data.f95 create mode 100644 gcc/testsuite/gfortran.dg/goacc/goacc.exp create mode 100644 gcc/testsuite/gfortran.dg/goacc/host_data-tree.f95 create mode 100644 gcc/testsuite/gfortran.dg/goacc/if.f95 create mode 100644 gcc/testsuite/gfortran.dg/goacc/kernels-tree.f95 create mode 100644 gcc/testsuite/gfortran.dg/goacc/list.f95 create mode 100644 gcc/testsuite/gfortran.dg/goacc/literal.f95 create mode 100644 gcc/testsuite/gfortran.dg/goacc/loop-1.f95 create mode 100644 gcc/testsuite/gfortran.dg/goacc/loop-2.f95 create mode 100644 gcc/testsuite/gfortran.dg/goacc/loop-3.f95 create mode 100644 gcc/testsuite/gfortran.dg/goacc/omp.f95 create mode 100644 gcc/testsuite/gfortran.dg/goacc/parallel-kernels-clauses.f95 create mode 100644 gcc/testsuite/gfortran.dg/goacc/parallel-kernels-regions.f95 create mode 100644 gcc/testsuite/gfortran.dg/goacc/parallel-tree.f95 create mode 100644 gcc/testsuite/gfortran.dg/goacc/parameter.f95 create mode 100644 gcc/testsuite/gfortran.dg/goacc/pure-elemental-procedures.f95 create mode 100644 gcc/testsuite/gfortran.dg/goacc/reduction.f95 create mode 100644 gcc/testsuite/gfortran.dg/goacc/sentinel-free-form.f95 create mode 100644 gcc/testsuite/gfortran.dg/goacc/several-directives.f95 create mode 100644 gcc/testsuite/gfortran.dg/goacc/sie.f95 diff --git a/gcc/testsuite/gfortran.dg/goacc/assumed.f95 b/gcc/testsuite/gfortran.dg/goacc/assumed.f95 new file mode 100644 index 0000000..4f6c23f --- /dev/null +++ b/gcc/testsuite/gfortran.dg/goacc/assumed.f95 @@ -0,0 +1,66 @@ +! { dg-do compile } +! { dg-additional-options "-fmax-errors=100" } + +module test +contains + subroutine assumed_size(a) + implicit none + integer :: a(*), i + !$acc declare device_resident (a) ! { dg-error "Assumed size" } + !$acc data copy (a) ! { dg-error "Assumed size" } + !$acc end data + !$acc data deviceptr (a) ! { dg-error "Assumed size" } + !$acc end data + !$acc parallel private (a) ! { dg-error "Assumed size" } + !$acc end parallel + !$acc host_data use_device (a) ! { dg-error "Assumed size" } + !$acc end host_data + !$acc parallel loop reduction(+:a) ! { dg-error "Assumed size" } + do i = 1,5 + enddo + !$acc end parallel loop + !$acc update host (a) ! { dg-error "Assumed size" } + !$acc update device (a) ! { dg-error "Assumed size" } + end subroutine assumed_size + + subroutine assumed_shape(a) + implicit none + integer :: a(:), i + !$acc declare device_resident (a) ! { dg-error "Assumed shape" } + !$acc data copy (a) ! { dg-error "Assumed shape" } + !$acc end data + !$acc data deviceptr (a) ! { dg-error "Assumed shape" } + !$acc end data + !$acc parallel private (a) ! { dg-error "Assumed shape" } + !$acc end parallel + !$acc host_data use_device (a) ! { dg-error "Assumed shape" } + !$acc end host_data + !$acc parallel loop reduction(+:a) ! { dg-error "Assumed shape" } + do i = 1,5 + enddo + !$acc end parallel loop + !$acc update host (a) ! { dg-error "Assumed shape" } + !$acc update device (a) ! { dg-error "Assumed shape" } + end subroutine assumed_shape + + subroutine assumed_rank(a) + implicit none + integer, intent(in) :: a(..) + integer :: i + !$acc declare device_resident (a) ! { dg-error "Assumed rank" } + !$acc data copy (a) ! { dg-error "Assumed rank" } + !$acc end data + !$acc data deviceptr (a) ! { dg-error "Assumed rank" } + !$acc end data + !$acc parallel private (a) ! { dg-error "Assumed rank" } + !$acc end parallel + !$acc host_data use_device (a) ! { dg-error "Assumed rank" } + !$acc end host_data + !$acc parallel loop reduction(+:a) ! { dg-error "Assumed rank" } + do i = 1,5 + enddo + !$acc end parallel loop + !$acc update host (a) ! { dg-error "Assumed rank" } + !$acc update device (a) ! { dg-error "Assumed rank" } + end subroutine assumed_rank +end module test \ No newline at end of file diff --git a/gcc/testsuite/gfortran.dg/goacc/branch.f95 b/gcc/testsuite/gfortran.dg/goacc/branch.f95 new file mode 100644 index 0000000..7eed3e2 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/goacc/branch.f95 @@ -0,0 +1,53 @@ +! { dg-do compile } + +program test + implicit none + + integer :: i + + if (.true.) then + !$acc parallel + end if ! { dg-error "Unexpected" } + !$acc end parallel + end if + + if (.true.) then + !$acc kernels + end if ! { dg-error "Unexpected" } + !$acc end kernels + end if + + !$acc parallel + if (.true.) then + !$acc end parallel ! { dg-error "Unexpected" } + end if + !$acc end parallel + + !$acc kernels + if (.true.) then + !$acc end kernels ! { dg-error "Unexpected" } + end if + !$acc end kernels + + !$acc parallel + if (.true.) then + end if + !$acc end parallel + + !$acc kernels + if (.true.) then + end if + !$acc end kernels + + if (.true.) then + !$acc parallel + !$acc end parallel + end if + + if (.true.) then + !$acc kernels + !$acc end kernels + end if + + +end program test \ No newline at end of file diff --git a/gcc/testsuite/gfortran.dg/goacc/coarray.f95 b/gcc/testsuite/gfortran.dg/goacc/coarray.f95 new file mode 100644 index 0000000..7afb4bc --- /dev/null +++ b/gcc/testsuite/gfortran.dg/goacc/coarray.f95 @@ -0,0 +1,35 @@ +! { dg-do compile } +! { dg-additional-options "-fcoarray=single" } + +! TODO: These cases must fail + +module test +contains + subroutine oacc1(a) + implicit none + integer :: i + integer, codimension[*] :: a + !$acc declare device_resident (a) + !$acc data copy (a) + !$acc end data + !$acc data deviceptr (a) + !$acc end data + !$acc parallel private (a) + !$acc end parallel + !$acc host_data use_device (a) + !$acc end host_data + !$acc parallel loop reduction(+:a) + do i = 1,5 + enddo + !$acc end parallel loop + !$acc parallel loop + do i = 1,5 + !$acc cache (a) + enddo + !$acc end parallel loop + !$acc update host (a) + !$acc update device (a) + end subroutine oacc1 +end module test +! { dg-excess-errors "Unimplemented" } +! { dg-excess-errors "ACC LOOP" } \ No newline at end of file diff --git a/gcc/testsuite/gfortran.dg/goacc/continuation-free-form.f95 b/gcc/testsuite/gfortran.dg/goacc/continuation-free-form.f95 new file mode 100644 index 0000000..1c9a3f3 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/goacc/continuation-free-form.f95 @@ -0,0 +1,23 @@ +! { dg-do compile } + +program test + implicit none + + integer :: i + real :: x + + !$acc parallel & + !$acc loop & ! continuation + !$acc & reduction(+:x) + + ! this line must be ignored + !$acc ! kernels + do i = 1,10 + x = x + 0.3 + enddo + ! continuation must begin with sentinel + !$acc end parallel & ! { dg-error "Unclassifiable OpenACC directive" } + ! loop + + print *, x +end \ No newline at end of file diff --git a/gcc/testsuite/gfortran.dg/goacc/cray.f95 b/gcc/testsuite/gfortran.dg/goacc/cray.f95 new file mode 100644 index 0000000..b4d6a9d --- /dev/null +++ b/gcc/testsuite/gfortran.dg/goacc/cray.f95 @@ -0,0 +1,53 @@ +! { dg-do compile } +! { dg-additional-options "-fcray-pointer" } + +module test +contains + subroutine oacc1 + implicit none + integer :: i + real :: pointee + pointer (ptr, pointee) + !$acc declare device_resident (pointee) + !$acc declare device_resident (ptr) + !$acc data copy (pointee) ! { dg-error "Cray pointee" } + !$acc end data + !$acc data deviceptr (pointee) ! { dg-error "Cray pointee" } + !$acc end data + !$acc parallel private (pointee) ! { dg-error "Cray pointee" } + !$acc end parallel + !$acc host_data use_device (pointee) ! { dg-error "Cray pointee" } + !$acc end host_data + !$acc parallel loop reduction(+:pointee) ! { dg-error "Cray pointee" } + do i = 1,5 + enddo + !$acc end parallel loop + !$acc parallel loop + do i = 1,5 + ! Subarrays are not implemented yet + !$acc cache (pointee) ! TODO: This must fail, as in openacc-1_0-branch + enddo + !$acc end parallel loop + !$acc update host (pointee) ! { dg-error "Cray pointee" } + !$acc update device (pointee) ! { dg-error "Cray pointee" } + !$acc data copy (ptr) + !$acc end data + !$acc data deviceptr (ptr) ! { dg-error "Cray pointer" } + !$acc end data + !$acc parallel private (ptr) + !$acc end parallel + !$acc host_data use_device (ptr) ! { dg-error "Cray pointer" } + !$acc end host_data + !$acc parallel loop reduction(+:ptr) ! { dg-error "Cray pointer" } + do i = 1,5 + enddo + !$acc end parallel loop + !$acc parallel loop + do i = 1,5 + !$acc cache (ptr) ! TODO: This must fail, as in openacc-1_0-branch + enddo + !$acc end parallel loop + !$acc update host (ptr) + !$acc update device (ptr) + end subroutine oacc1 +end module test \ No newline at end of file diff --git a/gcc/testsuite/gfortran.dg/goacc/critical.f95 b/gcc/testsuite/gfortran.dg/goacc/critical.f95 new file mode 100644 index 0000000..510ea18 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/goacc/critical.f95 @@ -0,0 +1,27 @@ +! { dg-do compile } +! { dg-additional-options "-fcoarray=single" } + +module test +contains + subroutine oacc1 + implicit none + integer :: i, j + j = 0 + !$acc parallel + critical ! { dg-error "CRITICAL block inside of" } + j = j + 1 + end critical + !$acc end parallel + end subroutine oacc1 + + subroutine oacc2 + implicit none + integer :: i, j + j = 0 + critical + !$acc parallel ! { dg-error "OpenACC directive inside of" } + j = j + 1 + !$acc end parallel + end critical + end subroutine oacc2 +end module test \ No newline at end of file diff --git a/gcc/testsuite/gfortran.dg/goacc/data-clauses.f95 b/gcc/testsuite/gfortran.dg/goacc/data-clauses.f95 new file mode 100644 index 0000000..b65d61d --- /dev/null +++ b/gcc/testsuite/gfortran.dg/goacc/data-clauses.f95 @@ -0,0 +1,259 @@ +! { dg-do compile } +! { dg-additional-options "-fmax-errors=100" } + +module test + implicit none +contains + + subroutine foo (vi) + integer, value :: vi + integer :: i, ia(10) + complex :: c, ca(10) + real, target:: r + real :: ra(10) + real, pointer :: rp + real, dimension(:), allocatable :: aa + type t + integer :: i + end type + type(t) :: ti + type(t), allocatable :: tia + type(t), target :: tit + type(t), pointer :: tip + rp => r + tip => tit + + !$acc parallel deviceptr (rp) ! { dg-error "POINTER" } + !$acc end parallel + !$acc parallel deviceptr (vi) ! { dg-error "VALUE" } + !$acc end parallel + !$acc parallel deviceptr (aa) ! { dg-error "ALLOCATABLE" } + !$acc end parallel + + !$acc parallel deviceptr (i, c, r, ia, ca, ra, ti) + !$acc end parallel + !$acc kernels deviceptr (i, c, r, ia, ca, ra, ti) + !$acc end kernels + !$acc data deviceptr (i, c, r, ia, ca, ra, ti) + !$acc end data + + + !$acc parallel copy (tip) ! { dg-error "POINTER" } + !$acc end parallel + !$acc parallel copy (tia) ! { dg-error "ALLOCATABLE" } + !$acc end parallel + !$acc parallel deviceptr (i) copy (i) ! { dg-error "multiple clauses" } + !$acc end parallel + + !$acc parallel copy (i, c, r, ia, ca, ra, rp, ti, vi, aa) + !$acc end parallel + !$acc kernels copy (i, c, r, ia, ca, ra, rp, ti, vi, aa) + !$acc end kernels + !$acc data copy (i, c, r, ia, ca, ra, rp, ti, vi, aa) + !$acc end data + + + !$acc parallel copyin (tip) ! { dg-error "POINTER" } + !$acc end parallel + !$acc parallel copyin (tia) ! { dg-error "ALLOCATABLE" } + !$acc end parallel + !$acc parallel deviceptr (i) copyin (i) ! { dg-error "multiple clauses" } + !$acc end parallel + !$acc parallel copy (i) copyin (i) ! { dg-error "multiple clauses" } + !$acc end parallel + + !$acc parallel copyin (i, c, r, ia, ca, ra, rp, ti, vi, aa) + !$acc end parallel + !$acc kernels copyin (i, c, r, ia, ca, ra, rp, ti, vi, aa) + !$acc end kernels + !$acc data copyin (i, c, r, ia, ca, ra, rp, ti, vi, aa) + !$acc end data + + + !$acc parallel copyout (tip) ! { dg-error "POINTER" } + !$acc end parallel + !$acc parallel copyout (tia) ! { dg-error "ALLOCATABLE" } + !$acc end parallel + !$acc parallel deviceptr (i) copyout (i) ! { dg-error "multiple clauses" } + !$acc end parallel + !$acc parallel copy (i) copyout (i) ! { dg-error "multiple clauses" } + !$acc end parallel + !$acc parallel copyin (i) copyout (i) ! { dg-error "multiple clauses" } + !$acc end parallel + + !$acc parallel copyout (i, c, r, ia, ca, ra, rp, ti, vi, aa) + !$acc end parallel + !$acc kernels copyout (i, c, r, ia, ca, ra, rp, ti, vi, aa) + !$acc end kernels + !$acc data copyout (i, c, r, ia, ca, ra, rp, ti, vi, aa) + !$acc end data + + + !$acc parallel create (tip) ! { dg-error "POINTER" } + !$acc end parallel + !$acc parallel create (tia) ! { dg-error "ALLOCATABLE" } + !$acc end parallel + !$acc parallel deviceptr (i) create (i) ! { dg-error "multiple clauses" } + !$acc end parallel + !$acc parallel copy (i) create (i) ! { dg-error "multiple clauses" } + !$acc end parallel + !$acc parallel copyin (i) create (i) ! { dg-error "multiple clauses" } + !$acc end parallel + !$acc parallel copyout (i) create (i) ! { dg-error "multiple clauses" } + !$acc end parallel + + !$acc parallel create (i, c, r, ia, ca, ra, rp, ti, vi, aa) + !$acc end parallel + !$acc kernels create (i, c, r, ia, ca, ra, rp, ti, vi, aa) + !$acc end kernels + !$acc data create (i, c, r, ia, ca, ra, rp, ti, vi, aa) + !$acc end data + + + !$acc parallel present (tip) ! { dg-error "POINTER" } + !$acc end parallel + !$acc parallel present (tia) ! { dg-error "ALLOCATABLE" } + !$acc end parallel + !$acc parallel deviceptr (i) present (i) ! { dg-error "multiple clauses" } + !$acc end parallel + !$acc parallel copy (i) present (i) ! { dg-error "multiple clauses" } + !$acc end parallel + !$acc parallel copyin (i) present (i) ! { dg-error "multiple clauses" } + !$acc end parallel + !$acc parallel copyout (i) present (i) ! { dg-error "multiple clauses" } + !$acc end parallel + !$acc parallel create (i) present (i) ! { dg-error "multiple clauses" } + !$acc end parallel + + !$acc parallel present (i, c, r, ia, ca, ra, rp, ti, vi, aa) + !$acc end parallel + !$acc kernels present (i, c, r, ia, ca, ra, rp, ti, vi, aa) + !$acc end kernels + !$acc data present (i, c, r, ia, ca, ra, rp, ti, vi, aa) + !$acc end data + + + !$acc parallel pcopy (i, c, r, ia, ca, ra, rp, ti, vi, aa) + !$acc end parallel + !$acc parallel pcopyin (i, c, r, ia, ca, ra, rp, ti, vi, aa) + !$acc end parallel + !$acc parallel pcopyout (i, c, r, ia, ca, ra, rp, ti, vi, aa) + !$acc end parallel + !$acc parallel pcreate (i, c, r, ia, ca, ra, rp, ti, vi, aa) + !$acc end parallel + + + !$acc parallel present_or_copy (tip) ! { dg-error "POINTER" } + !$acc end parallel + !$acc parallel present_or_copy (tia) ! { dg-error "ALLOCATABLE" } + !$acc end parallel + !$acc parallel deviceptr (i) present_or_copy (i) ! { dg-error "multiple clauses" } + !$acc end parallel + !$acc parallel copy (i) present_or_copy (i) ! { dg-error "multiple clauses" } + !$acc end parallel + !$acc parallel copyin (i) present_or_copy (i) ! { dg-error "multiple clauses" } + !$acc end parallel + !$acc parallel copyout (i) present_or_copy (i) ! { dg-error "multiple clauses" } + !$acc end parallel + !$acc parallel create (i) present_or_copy (i) ! { dg-error "multiple clauses" } + !$acc end parallel + !$acc parallel present (i) present_or_copy (i) ! { dg-error "multiple clauses" } + !$acc end parallel + + !$acc parallel present_or_copy (i, c, r, ia, ca, ra, rp, ti, vi, aa) + !$acc end parallel + !$acc kernels present_or_copy (i, c, r, ia, ca, ra, rp, ti, vi, aa) + !$acc end kernels + !$acc data present_or_copy (i, c, r, ia, ca, ra, rp, ti, vi, aa) + !$acc end data + + + !$acc parallel present_or_copyin (tip) ! { dg-error "POINTER" } + !$acc end parallel + !$acc parallel present_or_copyin (tia) ! { dg-error "ALLOCATABLE" } + !$acc end parallel + !$acc parallel deviceptr (i) present_or_copyin (i) ! { dg-error "multiple clauses" } + !$acc end parallel + !$acc parallel copy (i) present_or_copyin (i) ! { dg-error "multiple clauses" } + !$acc end parallel + !$acc parallel copyin (i) present_or_copyin (i) ! { dg-error "multiple clauses" } + !$acc end parallel + !$acc parallel copyout (i) present_or_copyin (i) ! { dg-error "multiple clauses" } + !$acc end parallel + !$acc parallel create (i) present_or_copyin (i) ! { dg-error "multiple clauses" } + !$acc end parallel + !$acc parallel present (i) present_or_copyin (i) ! { dg-error "multiple clauses" } + !$acc end parallel + !$acc parallel present_or_copy (i) present_or_copyin (i) ! { dg-error "multiple clauses" } + !$acc end parallel + + !$acc parallel present_or_copyin (i, c, r, ia, ca, ra, rp, ti, vi, aa) + !$acc end parallel + !$acc kernels present_or_copyin (i, c, r, ia, ca, ra, rp, ti, vi, aa) + !$acc end kernels + !$acc data present_or_copyin (i, c, r, ia, ca, ra, rp, ti, vi, aa) + !$acc end data + + + !$acc parallel present_or_copyout (tip) ! { dg-error "POINTER" } + !$acc end parallel + !$acc parallel present_or_copyout (tia) ! { dg-error "ALLOCATABLE" } + !$acc end parallel + !$acc parallel deviceptr (i) present_or_copyout (i) ! { dg-error "multiple clauses" } + !$acc end parallel + !$acc parallel copy (i) present_or_copyout (i) ! { dg-error "multiple clauses" } + !$acc end parallel + !$acc parallel copyin (i) present_or_copyout (i) ! { dg-error "multiple clauses" } + !$acc end parallel + !$acc parallel copyout (i) present_or_copyout (i) ! { dg-error "multiple clauses" } + !$acc end parallel + !$acc parallel create (i) present_or_copyout (i) ! { dg-error "multiple clauses" } + !$acc end parallel + !$acc parallel present (i) present_or_copyout (i) ! { dg-error "multiple clauses" } + !$acc end parallel + !$acc parallel present_or_copy (i) present_or_copyout (i) ! { dg-error "multiple clauses" } + !$acc end parallel + !$acc parallel present_or_copyin (i) present_or_copyout (i) ! { dg-error "multiple clauses" } + !$acc end parallel + + !$acc parallel present_or_copyout (i, c, r, ia, ca, ra, rp, ti, vi, aa) + !$acc end parallel + !$acc kernels present_or_copyout (i, c, r, ia, ca, ra, rp, ti, vi, aa) + !$acc end kernels + !$acc data present_or_copyout (i, c, r, ia, ca, ra, rp, ti, vi, aa) + !$acc end data + + + !$acc parallel present_or_create (tip) ! { dg-error "POINTER" } + !$acc end parallel + !$acc parallel present_or_create (tia) ! { dg-error "ALLOCATABLE" } + !$acc end parallel + !$acc parallel deviceptr (i) present_or_create (i) ! { dg-error "multiple clauses" } + !$acc end parallel + !$acc parallel copy (i) present_or_create (i) ! { dg-error "multiple clauses" } + !$acc end parallel + !$acc parallel copyin (i) present_or_create (i) ! { dg-error "multiple clauses" } + !$acc end parallel + !$acc parallel copyout (i) present_or_create (i) ! { dg-error "multiple clauses" } + !$acc end parallel + !$acc parallel create (i) present_or_create (i) ! { dg-error "multiple clauses" } + !$acc end parallel + !$acc parallel present (i) present_or_create (i) ! { dg-error "multiple clauses" } + !$acc end parallel + !$acc parallel present_or_copy (i) present_or_create (i) ! { dg-error "multiple clauses" } + !$acc end parallel + !$acc parallel present_or_copyin (i) present_or_create (i) ! { dg-error "multiple clauses" } + !$acc end parallel + !$acc parallel present_or_copyout (i) present_or_create (i) ! { dg-error "multiple clauses" } + !$acc end parallel + + !$acc parallel present_or_create (i, c, r, ia, ca, ra, rp, ti, vi, aa) + !$acc end parallel + !$acc kernels present_or_create (i, c, r, ia, ca, ra, rp, ti, vi, aa) + !$acc end kernels + !$acc data present_or_create (i, c, r, ia, ca, ra, rp, ti, vi, aa) + !$acc end data + + end subroutine foo + +end module test \ No newline at end of file diff --git a/gcc/testsuite/gfortran.dg/goacc/data-tree.f95 b/gcc/testsuite/gfortran.dg/goacc/data-tree.f95 new file mode 100644 index 0000000..d29c060 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/goacc/data-tree.f95 @@ -0,0 +1,31 @@ +! { dg-do compile } +! { dg-additional-options "-fdump-tree-original" } + +program test + implicit none + integer :: q, i, j, k, m, n, o, p, r, s, t, u, v, w + logical :: l + + !$acc data if(l) copy(i), copyin(j), copyout(k), create(m) & + !$acc present(o), pcopy(p), pcopyin(r), pcopyout(s), pcreate(t) & + !$acc deviceptr(u) + !$acc end data + +end program test +! { dg-excess-errors "unimplemented" } +! { dg-final { scan-tree-dump-times "pragma acc data" 1 "original" } } + +! { dg-final { scan-tree-dump-times "if" 1 "original" } } +! { dg-final { scan-tree-dump-times "map\\(force_tofrom:i\\)" 1 "original" } } +! { dg-final { scan-tree-dump-times "map\\(force_to:j\\)" 1 "original" } } +! { dg-final { scan-tree-dump-times "map\\(force_from:k\\)" 1 "original" } } +! { dg-final { scan-tree-dump-times "map\\(force_alloc:m\\)" 1 "original" } } + +! { dg-final { scan-tree-dump-times "map\\(force_present:o\\)" 1 "original" } } +! { dg-final { scan-tree-dump-times "map\\(tofrom:p\\)" 1 "original" } } +! { dg-final { scan-tree-dump-times "map\\(to:r\\)" 1 "original" } } +! { dg-final { scan-tree-dump-times "map\\(from:s\\)" 1 "original" } } +! { dg-final { scan-tree-dump-times "map\\(alloc:t\\)" 1 "original" } } + +! { dg-final { scan-tree-dump-times "map\\(force_deviceptr:u\\)" 1 "original" } } +! { dg-final { cleanup-tree-dump "original" } } \ No newline at end of file diff --git a/gcc/testsuite/gfortran.dg/goacc/declare-1.f95 b/gcc/testsuite/gfortran.dg/goacc/declare-1.f95 new file mode 100644 index 0000000..aec3ae8 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/goacc/declare-1.f95 @@ -0,0 +1,20 @@ +! { dg-do compile } +! { dg-additional-options "-fdump-tree-original" } + +program test + implicit none + integer :: i + + !$acc declare copy(i) +contains + real function foo(n) + integer, value :: n + BLOCK + integer i + !$acc declare copy(i) + END BLOCK + end function foo +end program test +! { dg-excess-errors "unimplemented" } +! { dg-final { scan-tree-dump-times "pragma acc declare map\\(force_tofrom:i\\)" 2 "original" } } +! { dg-final { cleanup-tree-dump "original" } } diff --git a/gcc/testsuite/gfortran.dg/goacc/enter-exit-data.f95 b/gcc/testsuite/gfortran.dg/goacc/enter-exit-data.f95 new file mode 100644 index 0000000..8f1715e --- /dev/null +++ b/gcc/testsuite/gfortran.dg/goacc/enter-exit-data.f95 @@ -0,0 +1,88 @@ +! { dg-do compile } +! { dg-additional-options "-fmax-errors=100" } + +module test + implicit none +contains + + subroutine foo (vi) + logical :: l + integer, value :: vi + integer :: i, ia(10), a(10), b(2:8) + complex :: c, ca(10) + real, target:: r + real :: ra(10) + real, pointer :: rp + real, dimension(:), allocatable :: aa + type t + integer :: i + end type + type(t) :: ti + type(t), allocatable :: tia + type(t), target :: tit + type(t), pointer :: tip + rp => r + tip => tit + + ! enter data + !$acc enter data + !$acc enter data if (.false.) + !$acc enter data if (l) + !$acc enter data if (.false.) if (l) ! { dg-error "Unclassifiable" } + !$acc enter data if (i) ! { dg-error "LOGICAL" } + !$acc enter data if (1) ! { dg-error "LOGICAL" } + !$acc enter data if (a) ! { dg-error "LOGICAL" } + !$acc enter data if (b(5:6)) ! { dg-error "LOGICAL" } + !$acc enter data async (l) ! { dg-error "INTEGER" } + !$acc enter data async (.true.) ! { dg-error "INTEGER" } + !$acc enter data async (1) + !$acc enter data async (i) + !$acc enter data async (a) ! { dg-error "INTEGER" } + !$acc enter data async (b(5:6)) ! { dg-error "INTEGER" } + !$acc enter data wait (l) ! { dg-error "INTEGER" } + !$acc enter data wait (.true.) ! { dg-error "INTEGER" } + !$acc enter data wait (i, 1) + !$acc enter data wait (a) ! { dg-error "INTEGER" } + !$acc enter data wait (b(5:6)) ! { dg-error "INTEGER" } + !$acc enter data copyin (tip) ! { dg-error "POINTER" } + !$acc enter data copyin (tia) ! { dg-error "ALLOCATABLE" } + !$acc enter data create (tip) ! { dg-error "POINTER" } + !$acc enter data create (tia) ! { dg-error "ALLOCATABLE" } + !$acc enter data present_or_copyin (tip) ! { dg-error "POINTER" } + !$acc enter data present_or_copyin (tia) ! { dg-error "ALLOCATABLE" } + !$acc enter data present_or_create (tip) ! { dg-error "POINTER" } + !$acc enter data present_or_create (tia) ! { dg-error "ALLOCATABLE" } + !$acc enter data copyin (i) create (i) ! { dg-error "multiple clauses" } + !$acc enter data copyin (i) present_or_copyin (i) ! { dg-error "multiple clauses" } + !$acc enter data create (i) present_or_copyin (i) ! { dg-error "multiple clauses" } + !$acc enter data copyin (i) present_or_create (i) ! { dg-error "multiple clauses" } + !$acc enter data create (i) present_or_create (i) ! { dg-error "multiple clauses" } + !$acc enter data present_or_copyin (i) present_or_create (i) ! { dg-error "multiple clauses" } + + ! exit data + !$acc exit data + !$acc exit data if (.false.) + !$acc exit data if (l) + !$acc exit data if (.false.) if (l) ! { dg-error "Unclassifiable" } + !$acc exit data if (i) ! { dg-error "LOGICAL" } + !$acc exit data if (1) ! { dg-error "LOGICAL" } + !$acc exit data if (a) ! { dg-error "LOGICAL" } + !$acc exit data if (b(5:6)) ! { dg-error "LOGICAL" } + !$acc exit data async (l) ! { dg-error "INTEGER" } + !$acc exit data async (.true.) ! { dg-error "INTEGER" } + !$acc exit data async (1) + !$acc exit data async (i) + !$acc exit data async (a) ! { dg-error "INTEGER" } + !$acc exit data async (b(5:6)) ! { dg-error "INTEGER" } + !$acc exit data wait (l) ! { dg-error "INTEGER" } + !$acc exit data wait (.true.) ! { dg-error "INTEGER" } + !$acc exit data wait (i, 1) + !$acc exit data wait (a) ! { dg-error "INTEGER" } + !$acc exit data wait (b(5:6)) ! { dg-error "INTEGER" } + !$acc exit data copyout (tip) ! { dg-error "POINTER" } + !$acc exit data copyout (tia) ! { dg-error "ALLOCATABLE" } + !$acc exit data delete (tip) ! { dg-error "POINTER" } + !$acc exit data delete (tia) ! { dg-error "ALLOCATABLE" } + !$acc exit data copyout (i) delete (i) ! { dg-error "multiple clauses" } + end subroutine foo +end module test diff --git a/gcc/testsuite/gfortran.dg/goacc/goacc.exp b/gcc/testsuite/gfortran.dg/goacc/goacc.exp new file mode 100644 index 0000000..96530d2 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/goacc/goacc.exp @@ -0,0 +1,36 @@ +# Copyright (C) 2005-2013 Free Software Foundation, Inc. +# +# This file is part of GCC. +# +# GCC is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 3, or (at your option) +# any later version. +# +# GCC is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with GCC; see the file COPYING3. If not see +# . + +# GCC testsuite that uses the `dg.exp' driver. + +# Load support procs. +load_lib gfortran-dg.exp + +if ![check_effective_target_fopenacc] { + return +} + +# Initialize `dg'. +dg-init + +# Main loop. +gfortran-dg-runtest [lsort \ + [find $srcdir/$subdir *.\[fF\]{,90,95,03,08} ] ] " -fopenacc" + +# All done. +dg-finish diff --git a/gcc/testsuite/gfortran.dg/goacc/host_data-tree.f95 b/gcc/testsuite/gfortran.dg/goacc/host_data-tree.f95 new file mode 100644 index 0000000..1c24fe7 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/goacc/host_data-tree.f95 @@ -0,0 +1,13 @@ +! { dg-do compile } +! { dg-additional-options "-fdump-tree-original" } + +program test + implicit none + integer :: i + + !$acc host_data use_device(i) + !$acc end host_data +end program test +! { dg-excess-errors "unimplemented" } +! { dg-final { scan-tree-dump-times "pragma acc host_data use_device\\(i\\)" 1 "original" } } +! { dg-final { cleanup-tree-dump "original" } } diff --git a/gcc/testsuite/gfortran.dg/goacc/if.f95 b/gcc/testsuite/gfortran.dg/goacc/if.f95 new file mode 100644 index 0000000..a45035d --- /dev/null +++ b/gcc/testsuite/gfortran.dg/goacc/if.f95 @@ -0,0 +1,52 @@ +! { dg-do compile } + +program test + implicit none + + logical :: x + integer :: i + + !$acc parallel if ! { dg-error "Unclassifiable OpenACC directive" } + !$acc parallel if () ! { dg-error "Invalid character" } + !$acc parallel if (i) ! { dg-error "scalar LOGICAL expression" } + !$acc end parallel + !$acc parallel if (1) ! { dg-error "scalar LOGICAL expression" } + !$acc end parallel + !$acc kernels if (i) ! { dg-error "scalar LOGICAL expression" } + !$acc end kernels + !$acc kernels if ! { dg-error "Unclassifiable OpenACC directive" } + !$acc kernels if () ! { dg-error "Invalid character" } + !$acc kernels if (1) ! { dg-error "scalar LOGICAL expression" } + !$acc end kernels + !$acc data if ! { dg-error "Unclassifiable OpenACC directive" } + !$acc data if () ! { dg-error "Invalid character" } + !$acc data if (i) ! { dg-error "scalar LOGICAL expression" } + !$acc end data + !$acc data if (1) ! { dg-error "scalar LOGICAL expression" } + !$acc end data + + ! at most one if clause may appear + !$acc parallel if (.false.) if (.false.) { dg-error "Unclassifiable OpenACC directive" } + !$acc kernels if (.false.) if (.false.) { dg-error "Unclassifiable OpenACC directive" } + !$acc data if (.false.) if (.false.) { dg-error "Unclassifiable OpenACC directive" } + + !$acc parallel if (x) + !$acc end parallel + !$acc parallel if (.true.) + !$acc end parallel + !$acc parallel if (i.gt.1) + !$acc end parallel + !$acc kernels if (x) + !$acc end kernels + !$acc kernels if (.true.) + !$acc end kernels + !$acc kernels if (i.gt.1) + !$acc end kernels + !$acc data if (x) + !$acc end data + !$acc data if (.true.) + !$acc end data + !$acc data if (i.gt.1) + !$acc end data + +end program test \ No newline at end of file diff --git a/gcc/testsuite/gfortran.dg/goacc/kernels-tree.f95 b/gcc/testsuite/gfortran.dg/goacc/kernels-tree.f95 new file mode 100644 index 0000000..5c65d2a --- /dev/null +++ b/gcc/testsuite/gfortran.dg/goacc/kernels-tree.f95 @@ -0,0 +1,33 @@ +! { dg-do compile } +! { dg-additional-options "-fdump-tree-original" } + +program test + implicit none + integer :: q, i, j, k, m, n, o, p, r, s, t, u, v, w + logical :: l + + !$acc kernels if(l) async copy(i), copyin(j), copyout(k), create(m) & + !$acc present(o), pcopy(p), pcopyin(r), pcopyout(s), pcreate(t) & + !$acc deviceptr(u) + !$acc end kernels + +end program test +! { dg-excess-errors "unimplemented" } +! { dg-final { scan-tree-dump-times "pragma acc kernels" 1 "original" } } + +! { dg-final { scan-tree-dump-times "if" 1 "original" } } +! { dg-final { scan-tree-dump-times "async" 1 "original" } } + +! { dg-final { scan-tree-dump-times "map\\(force_tofrom:i\\)" 1 "original" } } +! { dg-final { scan-tree-dump-times "map\\(force_to:j\\)" 1 "original" } } +! { dg-final { scan-tree-dump-times "map\\(force_from:k\\)" 1 "original" } } +! { dg-final { scan-tree-dump-times "map\\(force_alloc:m\\)" 1 "original" } } + +! { dg-final { scan-tree-dump-times "map\\(force_present:o\\)" 1 "original" } } +! { dg-final { scan-tree-dump-times "map\\(tofrom:p\\)" 1 "original" } } +! { dg-final { scan-tree-dump-times "map\\(to:r\\)" 1 "original" } } +! { dg-final { scan-tree-dump-times "map\\(from:s\\)" 1 "original" } } +! { dg-final { scan-tree-dump-times "map\\(alloc:t\\)" 1 "original" } } + +! { dg-final { scan-tree-dump-times "map\\(force_deviceptr:u\\)" 1 "original" } } +! { dg-final { cleanup-tree-dump "original" } } diff --git a/gcc/testsuite/gfortran.dg/goacc/list.f95 b/gcc/testsuite/gfortran.dg/goacc/list.f95 new file mode 100644 index 0000000..94fdadd --- /dev/null +++ b/gcc/testsuite/gfortran.dg/goacc/list.f95 @@ -0,0 +1,111 @@ +! { dg-do compile } +! { dg-additional-options "-fmax-errors=100" } + +program test + implicit none + + integer :: i, j, k, l, a(10) + common /b/ j, k + real, pointer :: p1 => NULL() + complex :: c, d(10) + + !$acc parallel private(i) + !$acc end parallel + + !$acc parallel private(a) + !$acc end parallel + + !$acc parallel private(c, d) + !$acc end parallel + + !$acc parallel private(i, j, k, l, a) + !$acc end parallel + + !$acc parallel private (i) private (j) + !$acc end parallel + + !$acc parallel private ! { dg-error "Unclassifiable OpenACC directive" } + + !$acc parallel private() ! { dg-error "Syntax error" } + + !$acc parallel private(a(1:3)) ! { dg-error "Syntax error" } + + !$acc parallel private(10) ! { dg-error "Syntax error" } + + !$acc parallel private(/b/, /b/) ! { dg-error "present on multiple clauses" } + !$acc end parallel + + !$acc parallel private(i, j, i) ! { dg-error "present on multiple clauses" } + !$acc end parallel + + !$acc parallel private(p1) + !$acc end parallel + + !$acc parallel firstprivate(i) + !$acc end parallel + + !$acc parallel firstprivate(c, d) + !$acc end parallel + + !$acc parallel firstprivate(a) + !$acc end parallel + + !$acc parallel firstprivate(i, j, k, l, a) + !$acc end parallel + + !$acc parallel firstprivate (i) firstprivate (j) + !$acc end parallel + + !$acc parallel firstprivate ! { dg-error "Unclassifiable OpenACC directive" } + + !$acc parallel firstprivate() ! { dg-error "Syntax error" } + + !$acc parallel firstprivate(a(1:3)) ! { dg-error "Syntax error" } + + !$acc parallel firstprivate(10) ! { dg-error "Syntax error" } + + !$acc parallel firstprivate (/b/, /b/) ! { dg-error "present on multiple clauses" } + !$acc end parallel + + !$acc parallel firstprivate (i, j, i) ! { dg-error "present on multiple clauses" } + !$acc end parallel + + !$acc parallel firstprivate(p1) + !$acc end parallel + + !$acc parallel private (i) firstprivate (i) ! { dg-error "present on multiple clauses" } + !$acc end parallel + + !$acc host_data use_device(i) + !$acc end host_data + + !$acc host_data use_device(c, d) + !$acc end host_data + + !$acc host_data use_device(a) + !$acc end host_data + + !$acc host_data use_device(i, j, k, l, a) + !$acc end host_data + + !$acc host_data use_device (i) use_device (j) + !$acc end host_data + + !$acc host_data use_device ! { dg-error "Unclassifiable OpenACC directive" } + + !$acc host_data use_device() ! { dg-error "Syntax error" } + + !$acc host_data use_device(a(1:3)) ! { dg-error "Syntax error" } + + !$acc host_data use_device(10) ! { dg-error "Syntax error" } + + !$acc host_data use_device(/b/, /b/) ! { dg-error "present on multiple clauses" } + !$acc end host_data + + !$acc host_data use_device(i, j, i) ! { dg-error "present on multiple clauses" } + !$acc end host_data + + !$acc host_data use_device(p1) ! { dg-error "POINTER" } + !$acc end host_data + +end program test \ No newline at end of file diff --git a/gcc/testsuite/gfortran.dg/goacc/literal.f95 b/gcc/testsuite/gfortran.dg/goacc/literal.f95 new file mode 100644 index 0000000..bdbf66d --- /dev/null +++ b/gcc/testsuite/gfortran.dg/goacc/literal.f95 @@ -0,0 +1,29 @@ +! { dg-do compile } + +module test +contains + subroutine oacc1 + implicit none + integer :: i + !$acc declare device_resident (10) ! { dg-error "Syntax error" } + !$acc data copy (10) ! { dg-error "Syntax error" } + !$acc end data ! { dg-error "Unexpected" } + !$acc data deviceptr (10) ! { dg-error "Syntax error" } + !$acc end data ! { dg-error "Unexpected" } + !$acc data private (10) ! { dg-error "Unclassifiable" } + !$acc end data ! { dg-error "Unexpected" } + !$acc host_data use_device (10) ! { dg-error "Syntax error" } + !$acc end host_data ! { dg-error "Unexpected" } + !$acc parallel loop reduction(+:10) ! { dg-error "Syntax error" } + do i = 1,5 + enddo + !$acc end parallel loop ! { dg-error "Unexpected" } + !$acc parallel loop + do i = 1,5 + !$acc cache (10) ! { dg-error "Syntax error" } + enddo + !$acc end parallel loop + !$acc update host (10) ! { dg-error "Syntax error" } + !$acc update device (10) ! { dg-error "Syntax error" } + end subroutine oacc1 +end module test \ No newline at end of file diff --git a/gcc/testsuite/gfortran.dg/goacc/loop-1.f95 b/gcc/testsuite/gfortran.dg/goacc/loop-1.f95 new file mode 100644 index 0000000..af4f537 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/goacc/loop-1.f95 @@ -0,0 +1,170 @@ +! { dg-do compile } +! { dg-additional-options "-fmax-errors=100" } +module test + implicit none +contains + +subroutine test1 + integer :: i, j, k, b(10) + integer, dimension (30) :: a + double precision :: d + real :: r + i = 0 + !$acc loop + do 100 ! { dg-error "cannot be a DO WHILE or DO without loop control" } + if (i .gt. 0) exit ! { dg-error "EXIT statement" } + 100 i = i + 1 + i = 0 + !$acc loop + do ! { dg-error "cannot be a DO WHILE or DO without loop control" } + if (i .gt. 0) exit ! { dg-error "EXIT statement" } + i = i + 1 + end do + i = 0 + !$acc loop + do 200 while (i .lt. 4) ! { dg-error "cannot be a DO WHILE or DO without loop control" } + 200 i = i + 1 + !$acc loop + do while (i .lt. 8) ! { dg-error "cannot be a DO WHILE or DO without loop control" } + i = i + 1 + end do + !$acc loop + do 300 d = 1, 30, 6 ! { dg-error "integer" } + i = d + 300 a(i) = 1 + !$acc loop + do d = 1, 30, 5 ! { dg-error "integer" } + i = d + a(i) = 2 + end do + !$acc loop + do i = 1, 30 + if (i .eq. 16) exit ! { dg-error "EXIT statement" } + end do + !$acc loop + outer: do i = 1, 30 + do j = 5, 10 + if (i .eq. 6 .and. j .eq. 7) exit outer ! { dg-error "EXIT statement" } + end do + end do outer + last: do i = 1, 30 + end do last + + ! different types of loop are allowed + !$acc loop + do i = 1,10 + end do + !$acc loop + do 400, i = 1,10 +400 a(i) = i + + ! after loop directive must be loop + !$acc loop + a(1) = 1 ! { dg-error "Expected DO loop" } + do i = 1,10 + enddo + + ! combined directives may be used with/without end + !$acc parallel loop + do i = 1,10 + enddo + !$acc parallel loop + do i = 1,10 + enddo + !$acc end parallel loop + !$acc kernels loop + do i = 1,10 + enddo + !$acc kernels loop + do i = 1,10 + enddo + !$acc end kernels loop + + !$acc kernels loop reduction(max:i) + do i = 1,10 + enddo + !$acc kernels + !$acc loop reduction(max:i) + do i = 1,10 + enddo + !$acc end kernels + + !$acc parallel loop collapse(0) ! { dg-error "constant positive integer" } + do i = 1,10 + enddo + + !$acc parallel loop collapse(-1) ! { dg-error "constant positive integer" } + do i = 1,10 + enddo + + !$acc parallel loop collapse(i) ! { dg-error "Constant expression required" } + do i = 1,10 + enddo + + !$acc parallel loop collapse(4) ! { dg-error "not enough DO loops for collapsed" } + do i = 1, 3 + do j = 4, 6 + do k = 5, 7 + a(i+j-k) = i + j + k + end do + end do + end do + !$acc parallel loop collapse(2) + do i = 1, 5, 2 + do j = i + 1, 7, i ! { dg-error "collapsed loops don.t form rectangular iteration space" } + end do + end do + !$acc parallel loop collapse(2) + do i = 1, 3 + do j = 4, 6 + end do + end do + !$acc parallel loop collapse(2) + do i = 1, 3 + do j = 4, 6 + end do + k = 4 + end do + !$acc parallel loop collapse(3-1) + do i = 1, 3 + do j = 4, 6 + end do + k = 4 + end do + !$acc parallel loop collapse(1+1) + do i = 1, 3 + do j = 4, 6 + end do + k = 4 + end do + !$acc parallel loop collapse(2) + do i = 1, 3 + do ! { dg-error "cannot be a DO WHILE or DO without loop control" } + end do + end do + !$acc parallel loop collapse(2) + do i = 1, 3 + do r = 4, 6 ! { dg-error "integer" } + end do + end do + + ! Both seq and independent are not allowed + !$acc loop independent seq ! { dg-error "SEQ conflicts with INDEPENDENT" } + do i = 1,10 + enddo + + + !$acc cache (a) ! { dg-error "inside of loop" } + + do i = 1,10 + !$acc cache(a) + enddo + + do i = 1,10 + a(i) = i + !$acc cache(a) + enddo + +end subroutine test1 +end module test +! { dg-excess-errors "Deleted" } diff --git a/gcc/testsuite/gfortran.dg/goacc/loop-2.f95 b/gcc/testsuite/gfortran.dg/goacc/loop-2.f95 new file mode 100644 index 0000000..f85691e --- /dev/null +++ b/gcc/testsuite/gfortran.dg/goacc/loop-2.f95 @@ -0,0 +1,649 @@ +! { dg-do compile } +! { dg-additional-options "-fmax-errors=100" } + +! TODO: nested kernels are allowed in 2.0 + +program test + implicit none + integer :: i, j + + !$acc kernels + !$acc loop auto + DO i = 1,10 + ENDDO + !$acc loop gang + DO i = 1,10 + ENDDO + !$acc loop gang(5) + DO i = 1,10 + ENDDO + !$acc loop gang(num:5) + DO i = 1,10 + ENDDO + !$acc loop gang(static:5) + DO i = 1,10 + ENDDO + !$acc loop gang(static:*) + DO i = 1,10 + ENDDO + !$acc loop gang + DO i = 1,10 + !$acc loop vector + DO j = 1,10 + ENDDO + !$acc loop worker + DO j = 1,10 + ENDDO + !$acc loop gang ! { dg-error "not allowed" } + DO j = 1,10 + ENDDO + ENDDO + !$acc loop seq gang ! { dg-error "conflicts with" } + DO i = 1,10 + ENDDO + + !$acc loop worker + DO i = 1,10 + ENDDO + !$acc loop worker(5) + DO i = 1,10 + ENDDO + !$acc loop worker(num:5) + DO i = 1,10 + ENDDO + !$acc loop worker + DO i = 1,10 + !$acc loop vector + DO j = 1,10 + ENDDO + !$acc loop worker ! { dg-error "not allowed" } + DO j = 1,10 + ENDDO + !$acc loop gang ! { dg-error "not allowed" } + DO j = 1,10 + ENDDO + ENDDO + !$acc loop seq worker ! { dg-error "conflicts with" } + DO i = 1,10 + ENDDO + !$acc loop gang worker ! { dg-error "conflicts with" } + DO i = 1,10 + ENDDO + + !$acc loop vector + DO i = 1,10 + ENDDO + !$acc loop vector(5) + DO i = 1,10 + ENDDO + !$acc loop vector(length:5) + DO i = 1,10 + ENDDO + !$acc loop vector + DO i = 1,10 + !$acc loop vector ! { dg-error "not allowed" } + DO j = 1,10 + ENDDO + !$acc loop worker ! { dg-error "not allowed" } + DO j = 1,10 + ENDDO + !$acc loop gang ! { dg-error "not allowed" } + DO j = 1,10 + ENDDO + ENDDO + !$acc loop seq vector ! { dg-error "conflicts with" } + DO i = 1,10 + ENDDO + !$acc loop gang vector ! { dg-error "conflicts with" } + DO i = 1,10 + ENDDO + !$acc loop worker vector ! { dg-error "conflicts with" } + DO i = 1,10 + ENDDO + + !$acc loop auto + DO i = 1,10 + ENDDO + !$acc loop seq auto ! { dg-error "conflicts with" } + DO i = 1,10 + ENDDO + !$acc loop gang auto ! { dg-error "conflicts with" } + DO i = 1,10 + ENDDO + !$acc loop worker auto ! { dg-error "conflicts with" } + DO i = 1,10 + ENDDO + !$acc loop vector auto ! { dg-error "conflicts with" } + DO i = 1,10 + ENDDO + + !$acc loop tile ! { dg-error "Unclassifiable" } + DO i = 1,10 + ENDDO + !$acc loop tile() ! { dg-error "Syntax error" } + DO i = 1,10 + ENDDO + !$acc loop tile(1) + DO i = 1,10 + ENDDO + !$acc loop tile(2) + DO i = 1,10 + ENDDO + !$acc loop tile(6-2) + DO i = 1,10 + ENDDO + !$acc loop tile(6+2) + DO i = 1,10 + ENDDO + !$acc loop tile(*) + DO i = 1,10 + ENDDO + !$acc loop tile(*, 1) + DO i = 1,10 + DO j = 1,10 + ENDDO + ENDDO + !$acc loop tile(-1) ! { dg-warning "must be positive" } + do i = 1,10 + enddo + !$acc loop tile(i) ! { dg-error "constant expression" } + do i = 1,10 + enddo + !$acc loop tile(2, 2, 1) ! { dg-error "not enough DO loops for tiled" } + do i = 1, 3 + do j = 4, 6 + end do + end do + !$acc loop tile(2, 2) + do i = 1, 5, 2 + do j = i + 1, 7, i ! { dg-error "tiled loops don.t form rectangular iteration space" } + end do + end do + !$acc loop vector tile(*) + DO i = 1,10 + ENDDO + !$acc loop worker tile(*) + DO i = 1,10 + ENDDO + !$acc loop gang tile(*) + DO i = 1,10 + ENDDO + !$acc loop vector gang tile(*) + DO i = 1,10 + ENDDO + !$acc loop vector worker tile(*) + DO i = 1,10 + ENDDO + !$acc loop gang worker tile(*) + DO i = 1,10 + ENDDO + !$acc end kernels + + + !$acc parallel + !$acc loop auto + DO i = 1,10 + ENDDO + !$acc loop gang + DO i = 1,10 + ENDDO + !$acc loop gang(5) ! { dg-error "non-static" } + DO i = 1,10 + ENDDO + !$acc loop gang(num:5) ! { dg-error "non-static" } + DO i = 1,10 + ENDDO + !$acc loop gang(static:5) + DO i = 1,10 + ENDDO + !$acc loop gang(static:*) + DO i = 1,10 + ENDDO + !$acc loop gang + DO i = 1,10 + !$acc loop vector + DO j = 1,10 + ENDDO + !$acc loop worker + DO j = 1,10 + ENDDO + !$acc loop gang ! { dg-error "not allowed" } + DO j = 1,10 + ENDDO + ENDDO + !$acc loop seq gang ! { dg-error "conflicts with" } + DO i = 1,10 + ENDDO + + !$acc loop worker + DO i = 1,10 + ENDDO + !$acc loop worker(5) ! { dg-error "non-static" } + DO i = 1,10 + ENDDO + !$acc loop worker(num:5) ! { dg-error "non-static" } + DO i = 1,10 + ENDDO + !$acc loop worker + DO i = 1,10 + !$acc loop vector + DO j = 1,10 + ENDDO + !$acc loop worker ! { dg-error "not allowed" } + DO j = 1,10 + ENDDO + !$acc loop gang ! { dg-error "not allowed" } + DO j = 1,10 + ENDDO + ENDDO + !$acc loop seq worker ! { dg-error "conflicts with" } + DO i = 1,10 + ENDDO + !$acc loop gang worker ! { dg-error "conflicts with" } + DO i = 1,10 + ENDDO + + !$acc loop vector + DO i = 1,10 + ENDDO + !$acc loop vector(5) + DO i = 1,10 + ENDDO + !$acc loop vector(length:5) + DO i = 1,10 + ENDDO + !$acc loop vector + DO i = 1,10 + !$acc loop vector ! { dg-error "not allowed" } + DO j = 1,10 + ENDDO + !$acc loop worker ! { dg-error "not allowed" } + DO j = 1,10 + ENDDO + !$acc loop gang ! { dg-error "not allowed" } + DO j = 1,10 + ENDDO + ENDDO + !$acc loop seq vector ! { dg-error "conflicts with" } + DO i = 1,10 + ENDDO + !$acc loop gang vector ! { dg-error "conflicts with" } + DO i = 1,10 + ENDDO + !$acc loop worker vector ! { dg-error "conflicts with" } + DO i = 1,10 + ENDDO + + !$acc loop auto + DO i = 1,10 + ENDDO + !$acc loop seq auto ! { dg-error "conflicts with" } + DO i = 1,10 + ENDDO + !$acc loop gang auto ! { dg-error "conflicts with" } + DO i = 1,10 + ENDDO + !$acc loop worker auto ! { dg-error "conflicts with" } + DO i = 1,10 + ENDDO + !$acc loop vector auto ! { dg-error "conflicts with" } + DO i = 1,10 + ENDDO + + !$acc loop tile ! { dg-error "Unclassifiable" } + DO i = 1,10 + ENDDO + !$acc loop tile() ! { dg-error "Syntax error" } + DO i = 1,10 + ENDDO + !$acc loop tile(1) + DO i = 1,10 + ENDDO + !$acc loop tile(*) + DO i = 1,10 + ENDDO + !$acc loop tile(2) + DO i = 1,10 + DO j = 1,10 + ENDDO + ENDDO + !$acc loop tile(-1) ! { dg-warning "must be positive" } + do i = 1,10 + enddo + !$acc loop tile(i) ! { dg-error "constant expression" } + do i = 1,10 + enddo + !$acc loop tile(2, 2, 1) ! { dg-error "not enough DO loops for tiled" } + do i = 1, 3 + do j = 4, 6 + end do + end do + !$acc loop tile(2, 2) + do i = 1, 5, 2 + do j = i + 1, 7, i ! { dg-error "tiled loops don.t form rectangular iteration space" } + end do + end do + !$acc loop vector tile(*) + DO i = 1,10 + ENDDO + !$acc loop worker tile(*) + DO i = 1,10 + ENDDO + !$acc loop gang tile(*) + DO i = 1,10 + ENDDO + !$acc loop vector gang tile(*) + DO i = 1,10 + ENDDO + !$acc loop vector worker tile(*) + DO i = 1,10 + ENDDO + !$acc loop gang worker tile(*) + DO i = 1,10 + ENDDO + !$acc end parallel + + !$acc kernels loop auto + DO i = 1,10 + ENDDO + !$acc kernels loop gang + DO i = 1,10 + ENDDO + !$acc kernels loop gang(5) + DO i = 1,10 + ENDDO + !$acc kernels loop gang(num:5) + DO i = 1,10 + ENDDO + !$acc kernels loop gang(static:5) + DO i = 1,10 + ENDDO + !$acc kernels loop gang(static:*) + DO i = 1,10 + ENDDO + !$acc kernels loop gang + DO i = 1,10 + !$acc kernels loop gang + DO j = 1,10 + ENDDO + ENDDO + !$acc kernels loop seq gang ! { dg-error "conflicts with" } + DO i = 1,10 + ENDDO + + !$acc kernels loop worker + DO i = 1,10 + ENDDO + !$acc kernels loop worker(5) + DO i = 1,10 + ENDDO + !$acc kernels loop worker(num:5) + DO i = 1,10 + ENDDO + !$acc kernels loop worker + DO i = 1,10 + !$acc kernels loop worker + DO j = 1,10 + ENDDO + !$acc kernels loop gang + DO j = 1,10 + ENDDO + ENDDO + !$acc kernels loop seq worker ! { dg-error "conflicts with" } + DO i = 1,10 + ENDDO + !$acc kernels loop gang worker ! { dg-error "conflicts with" } + DO i = 1,10 + ENDDO + + !$acc kernels loop vector + DO i = 1,10 + ENDDO + !$acc kernels loop vector(5) + DO i = 1,10 + ENDDO + !$acc kernels loop vector(length:5) + DO i = 1,10 + ENDDO + !$acc kernels loop vector + DO i = 1,10 + !$acc kernels loop vector + DO j = 1,10 + ENDDO + !$acc kernels loop worker + DO j = 1,10 + ENDDO + !$acc kernels loop gang + DO j = 1,10 + ENDDO + ENDDO + !$acc kernels loop seq vector ! { dg-error "conflicts with" } + DO i = 1,10 + ENDDO + !$acc kernels loop gang vector ! { dg-error "conflicts with" } + DO i = 1,10 + ENDDO + !$acc kernels loop worker vector ! { dg-error "conflicts with" } + DO i = 1,10 + ENDDO + + !$acc kernels loop auto + DO i = 1,10 + ENDDO + !$acc kernels loop seq auto ! { dg-error "conflicts with" } + DO i = 1,10 + ENDDO + !$acc kernels loop gang auto ! { dg-error "conflicts with" } + DO i = 1,10 + ENDDO + !$acc kernels loop worker auto ! { dg-error "conflicts with" } + DO i = 1,10 + ENDDO + !$acc kernels loop vector auto ! { dg-error "conflicts with" } + DO i = 1,10 + ENDDO + + !$acc kernels loop tile ! { dg-error "Unclassifiable" } + DO i = 1,10 + ENDDO + !$acc kernels loop tile() ! { dg-error "Syntax error" } + DO i = 1,10 + ENDDO + !$acc kernels loop tile(1) + DO i = 1,10 + ENDDO + !$acc kernels loop tile(*) + DO i = 1,10 + ENDDO + !$acc kernels loop tile(*, 1) + DO i = 1,10 + DO j = 1,10 + ENDDO + ENDDO + !$acc kernels loop tile(-1) ! { dg-warning "must be positive" } + do i = 1,10 + enddo + !$acc kernels loop tile(i) ! { dg-error "constant expression" } + do i = 1,10 + enddo + !$acc kernels loop tile(2, 2, 1) ! { dg-error "not enough DO loops for tiled" } + do i = 1, 3 + do j = 4, 6 + end do + end do + !$acc kernels loop tile(2, 2) + do i = 1, 5, 2 + do j = i + 1, 7, i ! { dg-error "tiled loops don.t form rectangular iteration space" } + end do + end do + !$acc kernels loop vector tile(*) + DO i = 1,10 + ENDDO + !$acc kernels loop worker tile(*) + DO i = 1,10 + ENDDO + !$acc kernels loop gang tile(*) + DO i = 1,10 + ENDDO + !$acc kernels loop vector gang tile(*) + DO i = 1,10 + ENDDO + !$acc kernels loop vector worker tile(*) + DO i = 1,10 + ENDDO + !$acc kernels loop gang worker tile(*) + DO i = 1,10 + ENDDO + + !$acc parallel loop auto + DO i = 1,10 + ENDDO + !$acc parallel loop gang + DO i = 1,10 + ENDDO + !$acc parallel loop gang(5) ! { dg-error "non-static" } + DO i = 1,10 + ENDDO + !$acc parallel loop gang(num:5) ! { dg-error "non-static" } + DO i = 1,10 + ENDDO + !$acc parallel loop gang(static:5) + DO i = 1,10 + ENDDO + !$acc parallel loop gang(static:*) + DO i = 1,10 + ENDDO + !$acc parallel loop gang + DO i = 1,10 + !$acc parallel loop gang + DO j = 1,10 + ENDDO + ENDDO + !$acc parallel loop seq gang ! { dg-error "conflicts with" } + DO i = 1,10 + ENDDO + + !$acc parallel loop worker + DO i = 1,10 + ENDDO + !$acc parallel loop worker(5) ! { dg-error "non-static" } + DO i = 1,10 + ENDDO + !$acc parallel loop worker(num:5) ! { dg-error "non-static" } + DO i = 1,10 + ENDDO + !$acc parallel loop worker + DO i = 1,10 + !$acc parallel loop worker + DO j = 1,10 + ENDDO + !$acc parallel loop gang + DO j = 1,10 + ENDDO + ENDDO + !$acc parallel loop seq worker ! { dg-error "conflicts with" } + DO i = 1,10 + ENDDO + !$acc parallel loop gang worker ! { dg-error "conflicts with" } + DO i = 1,10 + ENDDO + + !$acc parallel loop vector + DO i = 1,10 + ENDDO + !$acc parallel loop vector(5) + DO i = 1,10 + ENDDO + !$acc parallel loop vector(length:5) + DO i = 1,10 + ENDDO + !$acc parallel loop vector + DO i = 1,10 + !$acc parallel loop vector + DO j = 1,10 + ENDDO + !$acc parallel loop worker + DO j = 1,10 + ENDDO + !$acc parallel loop gang + DO j = 1,10 + ENDDO + ENDDO + !$acc parallel loop seq vector ! { dg-error "conflicts with" } + DO i = 1,10 + ENDDO + !$acc parallel loop gang vector ! { dg-error "conflicts with" } + DO i = 1,10 + ENDDO + !$acc parallel loop worker vector ! { dg-error "conflicts with" } + DO i = 1,10 + ENDDO + + !$acc parallel loop auto + DO i = 1,10 + ENDDO + !$acc parallel loop seq auto ! { dg-error "conflicts with" } + DO i = 1,10 + ENDDO + !$acc parallel loop gang auto ! { dg-error "conflicts with" } + DO i = 1,10 + ENDDO + !$acc parallel loop worker auto ! { dg-error "conflicts with" } + DO i = 1,10 + ENDDO + !$acc parallel loop vector auto ! { dg-error "conflicts with" } + DO i = 1,10 + ENDDO + + !$acc parallel loop tile ! { dg-error "Unclassifiable" } + DO i = 1,10 + ENDDO + !$acc parallel loop tile() ! { dg-error "Syntax error" } + DO i = 1,10 + ENDDO + !$acc parallel loop tile(1) + DO i = 1,10 + ENDDO + !$acc parallel loop tile(*) + DO i = 1,10 + ENDDO + !$acc parallel loop tile(*, 1) + DO i = 1,10 + DO j = 1,10 + ENDDO + ENDDO + !$acc parallel loop tile(-1) ! { dg-warning "must be positive" } + do i = 1,10 + enddo + !$acc parallel loop tile(i) ! { dg-error "constant expression" } + do i = 1,10 + enddo + !$acc parallel loop tile(2, 2, 1) ! { dg-error "not enough DO loops for tiled" } + do i = 1, 3 + do j = 4, 6 + end do + end do + !$acc parallel loop tile(2, 2) + do i = 1, 5, 2 + do j = i + 1, 7, i ! { dg-error "tiled loops don.t form rectangular iteration space" } + end do + end do + !$acc parallel loop vector tile(*) + DO i = 1,10 + ENDDO + !$acc parallel loop worker tile(*) + DO i = 1,10 + ENDDO + !$acc parallel loop gang tile(*) + DO i = 1,10 + ENDDO + !$acc parallel loop vector gang tile(*) + DO i = 1,10 + ENDDO + !$acc parallel loop vector worker tile(*) + DO i = 1,10 + ENDDO + !$acc parallel loop gang worker tile(*) + DO i = 1,10 + ENDDO +end \ No newline at end of file diff --git a/gcc/testsuite/gfortran.dg/goacc/loop-3.f95 b/gcc/testsuite/gfortran.dg/goacc/loop-3.f95 new file mode 100644 index 0000000..78bb72b --- /dev/null +++ b/gcc/testsuite/gfortran.dg/goacc/loop-3.f95 @@ -0,0 +1,31 @@ +! { dg-do compile } + +subroutine test1 + implicit none + integer :: i, j + + ! !$acc end loop not required by spec + !$acc loop + do i = 1,5 + enddo + !$acc end loop ! { dg-warning "Redundant" } + + !$acc loop + do i = 1,5 + enddo + j = 1 + !$acc end loop ! { dg-error "Unexpected" } + + !$acc parallel + !$acc loop + do i = 1,5 + enddo + !$acc end parallel + !$acc end loop ! { dg-error "Unexpected" } + + ! OpenACC supports Fortran 2008 do concurrent statement + !$acc loop + do concurrent (i = 1:5) + end do +end subroutine test1 + diff --git a/gcc/testsuite/gfortran.dg/goacc/omp.f95 b/gcc/testsuite/gfortran.dg/goacc/omp.f95 new file mode 100644 index 0000000..24f639f --- /dev/null +++ b/gcc/testsuite/gfortran.dg/goacc/omp.f95 @@ -0,0 +1,66 @@ +! { dg-do compile } +! { dg-additional-options "-fopenmp" } + +module test +contains + subroutine ichi + implicit none + integer :: i + !$acc parallel + !$omp do ! { dg-error "cannot be specified" } + do i = 1,5 + enddo + !$acc end parallel + end subroutine ichi + + subroutine ni + implicit none + integer :: i + !$omp parallel + !$acc loop ! { dg-error "cannot be specified" } + do i = 1,5 + enddo + !$omp end parallel + end subroutine ni + + subroutine san + implicit none + integer :: i + !$omp do + !$acc loop ! { dg-error "Unexpected" } + do i = 1,5 + enddo + end subroutine san + + subroutine yon + implicit none + integer :: i + !$acc loop + !$omp do ! { dg-error "Expected DO loop" } + do i = 1,5 + enddo + end subroutine yon + + subroutine go + implicit none + integer :: i, j + + !$omp parallel + do i = 1,5 + !$acc kernels ! { dg-error "cannot be specified" } + do j = 1,5 + enddo + !$acc end kernels + enddo + !$omp end parallel + end subroutine go + + subroutine roku + implicit none + + !$acc data + !$omp parallel ! { dg-error "cannot be specified" } + !$omp end parallel + !$acc end data + end subroutine roku +end module test \ No newline at end of file diff --git a/gcc/testsuite/gfortran.dg/goacc/parallel-kernels-clauses.f95 b/gcc/testsuite/gfortran.dg/goacc/parallel-kernels-clauses.f95 new file mode 100644 index 0000000..6084238 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/goacc/parallel-kernels-clauses.f95 @@ -0,0 +1,98 @@ +! { dg-do compile } + +! { dg-do compile } +! { dg-additional-options "-fmax-errors=100" } + +! test clauses added in OpenACC ver 2.0 + +program test + implicit none + integer :: i, a(10), b(5:7) + integer, parameter :: acc_async_noval = -1 + integer, parameter :: acc_async_sync = -2 + logical :: l + + ! async + !$acc kernels async(i) + !$acc end kernels + !$acc parallel async(i) + !$acc end parallel + + !$acc kernels async(0, 1) { dg-error "Unclassifiable" } + !$acc parallel async(0, 1) { dg-error "Unclassifiable" } + + !$acc kernels async + !$acc end kernels + !$acc parallel async + !$acc end parallel + + !$acc kernels async(acc_async_noval) + !$acc end kernels + !$acc parallel async(acc_async_noval) + !$acc end parallel + + !$acc kernels async(acc_async_sync) + !$acc end kernels + !$acc parallel async(acc_async_sync) + !$acc end parallel + + !$acc kernels async() { dg-error "Invalid character" } + !$acc parallel async() { dg-error "Invalid character" } + + !$acc kernels async("a") { dg-error "Unclassifiable" } + !$acc parallel async("a") { dg-error "Unclassifiable" } + + !$acc kernels async(.true.) { dg-error "Unclassifiable" } + !$acc parallel async(.true.) { dg-error "Unclassifiable" } + + ! default(none) + !$acc kernels default(none) + !$acc end kernels + !$acc parallel default(none) + !$acc end parallel + + !$acc kernels default (none) + !$acc end kernels + !$acc parallel default (none) + !$acc end parallel + + !$acc kernels default ( none ) + !$acc end kernels + !$acc parallel default ( none ) + !$acc end parallel + + !$acc kernels default { dg-error "Unclassifiable" } + !$acc parallel default { dg-error "Unclassifiable" } + + !$acc kernels default() { dg-error "Unclassifiable" } + !$acc parallel default() { dg-error "Unclassifiable" } + + !$acc kernels default(i) { dg-error "Unclassifiable" } + !$acc parallel default(i) { dg-error "Unclassifiable" } + + !$acc kernels default(1) { dg-error "Unclassifiable" } + !$acc parallel default(1) { dg-error "Unclassifiable" } + + ! Wait + !$acc kernels wait (l) ! { dg-error "INTEGER" } + !$acc end kernels + !$acc kernels wait (.true.) ! { dg-error "INTEGER" } + !$acc end kernels + !$acc kernels wait (i, 1) + !$acc end kernels + !$acc kernels wait (a) ! { dg-error "INTEGER" } + !$acc end kernels + !$acc kernels wait (b(5:6)) ! { dg-error "INTEGER" } + !$acc end kernels + + !$acc parallel wait (l) ! { dg-error "INTEGER" } + !$acc end parallel + !$acc parallel wait (.true.) ! { dg-error "INTEGER" } + !$acc end parallel + !$acc parallel wait (i, 1) + !$acc end parallel + !$acc parallel wait (a) ! { dg-error "INTEGER" } + !$acc end parallel + !$acc parallel wait (b(5:6)) ! { dg-error "INTEGER" } + !$acc end parallel +end diff --git a/gcc/testsuite/gfortran.dg/goacc/parallel-kernels-regions.f95 b/gcc/testsuite/gfortran.dg/goacc/parallel-kernels-regions.f95 new file mode 100644 index 0000000..5cd4d6c --- /dev/null +++ b/gcc/testsuite/gfortran.dg/goacc/parallel-kernels-regions.f95 @@ -0,0 +1,56 @@ +! { dg-do compile } + +! OpenACC 2.0 allows nested parallel/kernels regions +! However, in middle-end there is check for nested parallel + +program test + implicit none + + integer :: i + + !$acc parallel + !$acc kernels + !$acc end kernels + !$acc end parallel + + !$acc parallel + !$acc parallel ! { dg-error "may not be nested" } + !$acc end parallel + !$acc end parallel + + !$acc parallel + !$acc parallel ! { dg-error "may not be nested" } + !$acc end parallel + !$acc kernels + !$acc end kernels + !$acc end parallel + + !$acc kernels + !$acc kernels + !$acc end kernels + !$acc end kernels + + !$acc kernels + !$acc parallel + !$acc end parallel + !$acc end kernels + + !$acc kernels + !$acc parallel + !$acc end parallel + !$acc kernels + !$acc end kernels + !$acc end kernels + + !$acc parallel + !$acc data ! { dg-error "may not be nested" } + !$acc end data + !$acc end parallel + + !$acc kernels + !$acc data + !$acc end data + !$acc end kernels + +end program test +! { dg-excess-errors "unimplemented" } \ No newline at end of file diff --git a/gcc/testsuite/gfortran.dg/goacc/parallel-tree.f95 b/gcc/testsuite/gfortran.dg/goacc/parallel-tree.f95 new file mode 100644 index 0000000..a92de4e --- /dev/null +++ b/gcc/testsuite/gfortran.dg/goacc/parallel-tree.f95 @@ -0,0 +1,42 @@ +! { dg-do compile } +! { dg-additional-options "-fdump-tree-original" } + +! test for tree-dump-original and spaces-commas + +program test + implicit none + integer :: q, i, j, k, m, n, o, p, r, s, t, u, v, w + logical :: l + + !$acc parallel if(l) async num_gangs(i) num_workers(i) vector_length(i) & + !$acc reduction(max:q), copy(i), copyin(j), copyout(k), create(m) & + !$acc present(o), pcopy(p), pcopyin(r), pcopyout(s), pcreate(t) & + !$acc deviceptr(u), private(v), firstprivate(w) + !$acc end parallel + +end program test +! { dg-excess-errors "unimplemented" } +! { dg-final { scan-tree-dump-times "pragma acc parallel" 1 "original" } } + +! { dg-final { scan-tree-dump-times "if" 1 "original" } } +! { dg-final { scan-tree-dump-times "async" 1 "original" } } +! { dg-final { scan-tree-dump-times "num_gangs" 1 "original" } } +! { dg-final { scan-tree-dump-times "num_workers" 1 "original" } } +! { dg-final { scan-tree-dump-times "vector_length" 1 "original" } } + +! { dg-final { scan-tree-dump-times "reduction\\(max:q\\)" 1 "original" } } +! { dg-final { scan-tree-dump-times "map\\(force_tofrom:i\\)" 1 "original" } } +! { dg-final { scan-tree-dump-times "map\\(force_to:j\\)" 1 "original" } } +! { dg-final { scan-tree-dump-times "map\\(force_from:k\\)" 1 "original" } } +! { dg-final { scan-tree-dump-times "map\\(force_alloc:m\\)" 1 "original" } } + +! { dg-final { scan-tree-dump-times "map\\(force_present:o\\)" 1 "original" } } +! { dg-final { scan-tree-dump-times "map\\(tofrom:p\\)" 1 "original" } } +! { dg-final { scan-tree-dump-times "map\\(to:r\\)" 1 "original" } } +! { dg-final { scan-tree-dump-times "map\\(from:s\\)" 1 "original" } } +! { dg-final { scan-tree-dump-times "map\\(alloc:t\\)" 1 "original" } } + +! { dg-final { scan-tree-dump-times "map\\(force_deviceptr:u\\)" 1 "original" } } +! { dg-final { scan-tree-dump-times "private\\(v\\)" 1 "original" } } +! { dg-final { scan-tree-dump-times "firstprivate\\(w\\)" 1 "original" } } +! { dg-final { cleanup-tree-dump "original" } } diff --git a/gcc/testsuite/gfortran.dg/goacc/parameter.f95 b/gcc/testsuite/gfortran.dg/goacc/parameter.f95 new file mode 100644 index 0000000..7693254 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/goacc/parameter.f95 @@ -0,0 +1,30 @@ +! { dg-do compile } + +module test +contains + subroutine oacc1 + implicit none + integer :: i + integer, parameter :: a = 1 + !$acc declare device_resident (a) ! { dg-error "PARAMETER" } + !$acc data copy (a) ! { dg-error "not a variable" } + !$acc end data + !$acc data deviceptr (a) ! { dg-error "not a variable" } + !$acc end data + !$acc parallel private (a) ! { dg-error "not a variable" } + !$acc end parallel + !$acc host_data use_device (a) ! { dg-error "not a variable" } + !$acc end host_data + !$acc parallel loop reduction(+:a) ! { dg-error "not a variable" } + do i = 1,5 + enddo + !$acc end parallel loop + !$acc parallel loop + do i = 1,5 + !$acc cache (a) ! TODO: This must fail, as in openacc-1_0-branch + enddo + !$acc end parallel loop + !$acc update host (a) ! { dg-error "not a variable" } + !$acc update device (a) ! { dg-error "not a variable" } + end subroutine oacc1 +end module test \ No newline at end of file diff --git a/gcc/testsuite/gfortran.dg/goacc/pure-elemental-procedures.f95 b/gcc/testsuite/gfortran.dg/goacc/pure-elemental-procedures.f95 new file mode 100644 index 0000000..726e8e9 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/goacc/pure-elemental-procedures.f95 @@ -0,0 +1,78 @@ +! { dg-do compile } +! { dg-additional-options "-std=f2008 -fcoarray=single" } + +module test + implicit none +contains + elemental subroutine test1 + !$acc parallel ! { dg-error "may not appear in PURE procedures" } + end subroutine test1 + + pure subroutine test2 + !$acc parallel ! { dg-error "may not appear in PURE procedures" } + end subroutine test2 + + ! Implicit pure + elemental real function test3(x) + real, intent(in) :: x + !$acc parallel ! { dg-error "may not appear in PURE procedures" } + test3 = x*x + end function test3 + + pure real function test4(x) + real, intent(in) :: x + !$acc parallel ! { dg-error "may not appear in PURE procedures" } + test4 = x + end function test4 + + subroutine test5 + real :: x = 0.0 + integer :: i + !$acc parallel loop collapse(1) reduction(+:x) + do i = 1,10 + x = x + 0.3 + enddo + print *, x + end subroutine test5 + + real function test6(x) + real :: x + integer :: i + !$acc parallel loop collapse(1) reduction(+:x) + do i = 1,10 + x = x + 0.3 + enddo + test6 = x + end function test6 + + impure elemental real function test7(x) + real, intent(in) :: x + !$acc parallel + test7 = x + !$acc end parallel + end function test7 + + subroutine test8 + real :: x = 0.0 + integer :: i + !$acc parallel loop collapse(1) reduction(+:x) + do i = 1,10 + critical ! { dg-error "CRITICAL block inside of" } + x = x + 0.3 + end critical + enddo + print *, x + end subroutine test8 + + real function test9(n) + integer, value :: n + BLOCK + integer i + real sum + !$acc loop reduction(+:sum) + do i=1, n + sum = sum + sin(real(i)) + end do + END BLOCK + end function test9 +end module test \ No newline at end of file diff --git a/gcc/testsuite/gfortran.dg/goacc/reduction.f95 b/gcc/testsuite/gfortran.dg/goacc/reduction.f95 new file mode 100644 index 0000000..9b680e0 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/goacc/reduction.f95 @@ -0,0 +1,138 @@ +! { dg-do compile } +! { dg-additional-options "-fmax-errors=100" } + +subroutine foo (ia1) +integer :: i1, i2, i3 +integer, dimension (*) :: ia1 +integer, dimension (10) :: ia2 +real :: r1 +real, dimension (5) :: ra1 +double precision :: d1 +double precision, dimension (4) :: da1 +complex :: c1 +complex, dimension (7) :: ca1 +logical :: l1 +logical, dimension (3) :: la1 +character (5) :: a1 +type t + integer :: i +end type +type(t) :: t1 +type(t), dimension (2) :: ta1 +real, pointer :: p1 => NULL() +integer, allocatable :: aa1 (:,:) +save i2 +common /blk/ i1 + +!$acc parallel reduction (+:ia2) +!$acc end parallel +!$acc parallel reduction (+:ra1) +!$acc end parallel +!$acc parallel reduction (+:ca1) +!$acc end parallel +!$acc parallel reduction (+:da1) +!$acc end parallel +!$acc parallel reduction (.and.:la1) +!$acc end parallel +!$acc parallel reduction (+:i3, r1, d1, c1) +!$acc end parallel +!$acc parallel reduction (*:i3, r1, d1, c1) +!$acc end parallel +!$acc parallel reduction (-:i3, r1, d1, c1) +!$acc end parallel +!$acc parallel reduction (.and.:l1) +!$acc end parallel +!$acc parallel reduction (.or.:l1) +!$acc end parallel +!$acc parallel reduction (.eqv.:l1) +!$acc end parallel +!$acc parallel reduction (.neqv.:l1) +!$acc end parallel +!$acc parallel reduction (min:i3, r1, d1) +!$acc end parallel +!$acc parallel reduction (max:i3, r1, d1) +!$acc end parallel +!$acc parallel reduction (iand:i3) +!$acc end parallel +!$acc parallel reduction (ior:i3) +!$acc end parallel +!$acc parallel reduction (ieor:i3) +!$acc end parallel +!$acc parallel reduction (+:/blk/) ! { dg-error "Syntax error" } +!$acc end parallel ! { dg-error "Unexpected" } +!$acc parallel reduction (*:p1) ! { dg-error "POINTER object" } +!$acc end parallel +!$acc parallel reduction (-:aa1) +!$acc end parallel +!$acc parallel reduction (*:ia1) ! { dg-error "Assumed size" } +!$acc end parallel +!$acc parallel reduction (+:l1) ! { dg-error "must be of numeric type, got LOGICAL" } +!$acc end parallel +!$acc parallel reduction (*:la1) ! { dg-error "must be of numeric type, got LOGICAL" } +!$acc end parallel +!$acc parallel reduction (-:a1) ! { dg-error "must be of numeric type, got CHARACTER" } +!$acc end parallel +!$acc parallel reduction (+:t1) ! { dg-error "must be of numeric type, got TYPE" } +!$acc end parallel +!$acc parallel reduction (*:ta1) ! { dg-error "must be of numeric type, got TYPE" } +!$acc end parallel +!$acc parallel reduction (.and.:i3) ! { dg-error "must be LOGICAL" } +!$acc end parallel +!$acc parallel reduction (.or.:ia2) ! { dg-error "must be LOGICAL" } +!$acc end parallel +!$acc parallel reduction (.eqv.:r1) ! { dg-error "must be LOGICAL" } +!$acc end parallel +!$acc parallel reduction (.neqv.:ra1) ! { dg-error "must be LOGICAL" } +!$acc end parallel +!$acc parallel reduction (.and.:d1) ! { dg-error "must be LOGICAL" } +!$acc end parallel +!$acc parallel reduction (.or.:da1) ! { dg-error "must be LOGICAL" } +!$acc end parallel +!$acc parallel reduction (.eqv.:c1) ! { dg-error "must be LOGICAL" } +!$acc end parallel +!$acc parallel reduction (.neqv.:ca1) ! { dg-error "must be LOGICAL" } +!$acc end parallel +!$acc parallel reduction (.and.:a1) ! { dg-error "must be LOGICAL" } +!$acc end parallel +!$acc parallel reduction (.or.:t1) ! { dg-error "must be LOGICAL" } +!$acc end parallel +!$acc parallel reduction (.eqv.:ta1) ! { dg-error "must be LOGICAL" } +!$acc end parallel +!$acc parallel reduction (min:c1) ! { dg-error "must be INTEGER or REAL" } +!$acc end parallel +!$acc parallel reduction (max:ca1) ! { dg-error "must be INTEGER or REAL" } +!$acc end parallel +!$acc parallel reduction (max:l1) ! { dg-error "must be INTEGER or REAL" } +!$acc end parallel +!$acc parallel reduction (min:la1) ! { dg-error "must be INTEGER or REAL" } +!$acc end parallel +!$acc parallel reduction (max:a1) ! { dg-error "must be INTEGER or REAL" } +!$acc end parallel +!$acc parallel reduction (min:t1) ! { dg-error "must be INTEGER or REAL" } +!$acc end parallel +!$acc parallel reduction (max:ta1) ! { dg-error "must be INTEGER or REAL" } +!$acc end parallel +!$acc parallel reduction (iand:r1) ! { dg-error "must be INTEGER" } +!$acc end parallel +!$acc parallel reduction (ior:ra1) ! { dg-error "must be INTEGER" } +!$acc end parallel +!$acc parallel reduction (ieor:d1) ! { dg-error "must be INTEGER" } +!$acc end parallel +!$acc parallel reduction (ior:da1) ! { dg-error "must be INTEGER" } +!$acc end parallel +!$acc parallel reduction (iand:c1) ! { dg-error "must be INTEGER" } +!$acc end parallel +!$acc parallel reduction (ior:ca1) ! { dg-error "must be INTEGER" } +!$acc end parallel +!$acc parallel reduction (ieor:l1) ! { dg-error "must be INTEGER" } +!$acc end parallel +!$acc parallel reduction (iand:la1) ! { dg-error "must be INTEGER" } +!$acc end parallel +!$acc parallel reduction (ior:a1) ! { dg-error "must be INTEGER" } +!$acc end parallel +!$acc parallel reduction (ieor:t1) ! { dg-error "must be INTEGER" } +!$acc end parallel +!$acc parallel reduction (iand:ta1) ! { dg-error "must be INTEGER" } +!$acc end parallel + +end subroutine \ No newline at end of file diff --git a/gcc/testsuite/gfortran.dg/goacc/sentinel-free-form.f95 b/gcc/testsuite/gfortran.dg/goacc/sentinel-free-form.f95 new file mode 100644 index 0000000..1a3189c --- /dev/null +++ b/gcc/testsuite/gfortran.dg/goacc/sentinel-free-form.f95 @@ -0,0 +1,21 @@ +! { dg-do compile } + +program test + implicit none + + integer :: i + real :: x + + ! sentinel may only be preceeded by white space + x = 0.0 !$acc parallel ! comment + ! sentinel must appear as a single word + ! $acc parallel ! comment + !$ acc parallel ! { dg-error "Unclassifiable statement" } + ! directive lines must have space after sentinel + !$accparallel ! { dg-warning "followed by a space" } + do i = 1,10 + x = x + 0.3 + enddo + !$acc end parallel ! { dg-error "Unexpected" } + print *, x +end \ No newline at end of file diff --git a/gcc/testsuite/gfortran.dg/goacc/several-directives.f95 b/gcc/testsuite/gfortran.dg/goacc/several-directives.f95 new file mode 100644 index 0000000..8fb97b5 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/goacc/several-directives.f95 @@ -0,0 +1,6 @@ +! { dg-do compile } + +program test + ! only one directive-name may appear in directive + !$acc parallel kernels ! { dg-error "Unclassifiable OpenACC directive" } +end \ No newline at end of file diff --git a/gcc/testsuite/gfortran.dg/goacc/sie.f95 b/gcc/testsuite/gfortran.dg/goacc/sie.f95 new file mode 100644 index 0000000..2d66026 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/goacc/sie.f95 @@ -0,0 +1,252 @@ +! { dg-do compile } +! { dg-additional-options "-fmax-errors=100" } + +! tests async, num_gangs, num_workers, vector_length, gang, worker, vector clauses + +program test + implicit none + + integer :: i + + !$acc parallel async + !$acc end parallel + + !$acc parallel async(3) + !$acc end parallel + + !$acc parallel async(i) + !$acc end parallel + + !$acc parallel async(i+1) + !$acc end parallel + + !$acc parallel async(-1) + !$acc end parallel + + !$acc parallel async(0) + !$acc end parallel + + !$acc parallel async() ! { dg-error "Invalid character in name" } + + !$acc parallel async(1.5) ! { dg-error "scalar INTEGER expression" } + !$acc end parallel + + !$acc parallel async(.true.) ! { dg-error "scalar INTEGER expression" } + !$acc end parallel + + !$acc parallel async("1") ! { dg-error "scalar INTEGER expression" } + !$acc end parallel + + !$acc kernels async + !$acc end kernels + + !$acc kernels async(3) + !$acc end kernels + + !$acc kernels async(i) + !$acc end kernels + + !$acc kernels async(i+1) + !$acc end kernels + + !$acc kernels async(-1) + !$acc end kernels + + !$acc kernels async(0) + !$acc end kernels + + !$acc kernels async() ! { dg-error "Invalid character in name" } + + !$acc kernels async(1.5) ! { dg-error "scalar INTEGER expression" } + !$acc end kernels + + !$acc kernels async(.true.) ! { dg-error "scalar INTEGER expression" } + !$acc end kernels + + !$acc kernels async("1") ! { dg-error "scalar INTEGER expression" } + !$acc end kernels + + + !$acc parallel num_gangs ! { dg-error "Unclassifiable OpenACC directive" } + + !$acc parallel num_gangs(3) + !$acc end parallel + + !$acc parallel num_gangs(i) + !$acc end parallel + + !$acc parallel num_gangs(i+1) + !$acc end parallel + + !$acc parallel num_gangs(-1) ! { dg-warning "must be positive" } + !$acc end parallel + + !$acc parallel num_gangs(0) ! { dg-warning "must be positive" } + !$acc end parallel + + !$acc parallel num_gangs() ! { dg-error "Invalid character in name" } + + !$acc parallel num_gangs(1.5) ! { dg-error "scalar INTEGER expression" } + !$acc end parallel + + !$acc parallel num_gangs(.true.) ! { dg-error "scalar INTEGER expression" } + !$acc end parallel + + !$acc parallel num_gangs("1") ! { dg-error "scalar INTEGER expression" } + !$acc end parallel + + + !$acc parallel num_workers ! { dg-error "Unclassifiable OpenACC directive" } + + !$acc parallel num_workers(3) + !$acc end parallel + + !$acc parallel num_workers(i) + !$acc end parallel + + !$acc parallel num_workers(i+1) + !$acc end parallel + + !$acc parallel num_workers(-1) ! { dg-warning "must be positive" } + !$acc end parallel + + !$acc parallel num_workers(0) ! { dg-warning "must be positive" } + !$acc end parallel + + !$acc parallel num_workers() ! { dg-error "Invalid character in name" } + + !$acc parallel num_workers(1.5) ! { dg-error "scalar INTEGER expression" } + !$acc end parallel + + !$acc parallel num_workers(.true.) ! { dg-error "scalar INTEGER expression" } + !$acc end parallel + + !$acc parallel num_workers("1") ! { dg-error "scalar INTEGER expression" } + !$acc end parallel + + + !$acc parallel vector_length ! { dg-error "Unclassifiable OpenACC directive" } + + !$acc parallel vector_length(3) + !$acc end parallel + + !$acc parallel vector_length(i) + !$acc end parallel + + !$acc parallel vector_length(i+1) + !$acc end parallel + + !$acc parallel vector_length(-1) ! { dg-warning "must be positive" } + !$acc end parallel + + !$acc parallel vector_length(0) ! { dg-warning "must be positive" } + !$acc end parallel + + !$acc parallel vector_length() ! { dg-error "Invalid character in name" } + + !$acc parallel vector_length(1.5) ! { dg-error "scalar INTEGER expression" } + !$acc end parallel + + !$acc parallel vector_length(.true.) ! { dg-error "scalar INTEGER expression" } + !$acc end parallel + + !$acc parallel vector_length("1") ! { dg-error "scalar INTEGER expression" } + !$acc end parallel + + + !$acc loop gang + do i = 1,10 + enddo + !$acc loop gang(3) + do i = 1,10 + enddo + !$acc loop gang(i) + do i = 1,10 + enddo + !$acc loop gang(i+1) + do i = 1,10 + enddo + !$acc loop gang(-1) ! { dg-warning "must be positive" } + do i = 1,10 + enddo + !$acc loop gang(0) ! { dg-warning "must be positive" } + do i = 1,10 + enddo + !$acc loop gang() ! { dg-error "Invalid character in name" } + do i = 1,10 + enddo + !$acc loop gang(1.5) ! { dg-error "scalar INTEGER expression" } + do i = 1,10 + enddo + !$acc loop gang(.true.) ! { dg-error "scalar INTEGER expression" } + do i = 1,10 + enddo + !$acc loop gang("1") ! { dg-error "scalar INTEGER expression" } + do i = 1,10 + enddo + + + !$acc loop worker + do i = 1,10 + enddo + !$acc loop worker(3) + do i = 1,10 + enddo + !$acc loop worker(i) + do i = 1,10 + enddo + !$acc loop worker(i+1) + do i = 1,10 + enddo + !$acc loop worker(-1) ! { dg-warning "must be positive" } + do i = 1,10 + enddo + !$acc loop worker(0) ! { dg-warning "must be positive" } + do i = 1,10 + enddo + !$acc loop worker() ! { dg-error "Invalid character in name" } + do i = 1,10 + enddo + !$acc loop worker(1.5) ! { dg-error "scalar INTEGER expression" } + do i = 1,10 + enddo + !$acc loop worker(.true.) ! { dg-error "scalar INTEGER expression" } + do i = 1,10 + enddo + !$acc loop worker("1") ! { dg-error "scalar INTEGER expression" } + do i = 1,10 + enddo + + + !$acc loop vector + do i = 1,10 + enddo + !$acc loop vector(3) + do i = 1,10 + enddo + !$acc loop vector(i) + do i = 1,10 + enddo + !$acc loop vector(i+1) + do i = 1,10 + enddo + !$acc loop vector(-1) ! { dg-warning "must be positive" } + do i = 1,10 + enddo + !$acc loop vector(0) ! { dg-warning "must be positive" } + do i = 1,10 + enddo + !$acc loop vector() ! { dg-error "Invalid character in name" } + do i = 1,10 + enddo + !$acc loop vector(1.5) ! { dg-error "scalar INTEGER expression" } + do i = 1,10 + enddo + !$acc loop vector(.true.) ! { dg-error "scalar INTEGER expression" } + do i = 1,10 + enddo + !$acc loop vector("1") ! { dg-error "scalar INTEGER expression" } + do i = 1,10 + enddo + +end program test \ No newline at end of file -- 1.8.3.2