From patchwork Thu Nov 6 22:36:38 2014 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Cesar Philippidis X-Patchwork-Id: 407739 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id 578D91400B7 for ; Fri, 7 Nov 2014 09:37:13 +1100 (AEDT) DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender :message-id:date:from:mime-version:to:subject:content-type; q= dns; s=default; b=XhvJcLkCYrqdJ/1eCDyQ068BIs9AuNp+lJ/bLRwfPl9r76 HAT8xa+4QIshP+GQJwCbduT2APeX9RfKbS6F4DOrkr+fXZBrupuvoeF9yqw7kDQK YM6rv8/iitvb+ej/TE9P8QgM7vxR0DC1Kg4Lj3D0hVdj2rLTOaUi1CrWlCm1A= DKIM-Signature: v=1; a=rsa-sha1; c=relaxed; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender :message-id:date:from:mime-version:to:subject:content-type; s= default; bh=43TdqjL57v305T8LxXMmpYh6RE4=; b=gfDFgZ7mOUbel87Z7TJ2 wC6EZjQU39D5O+utN+0ck6CeCJw1HWs5y0rH9knDz/Nuc9VHINXs5oaJOobG4JOl 9mKv8RJOuHj8U5IVeK+WCDvCGrK3bO0D4gBdOVWM5jLIxUme2bhwIt4RwXx0ebDh CNYQGBolvzKJiXgcIcUliaI= Received: (qmail 16268 invoked by alias); 6 Nov 2014 22:36:53 -0000 Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org Received: (qmail 16243 invoked by uid 89); 6 Nov 2014 22:36:52 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-1.6 required=5.0 tests=AWL, BAYES_00, RCVD_IN_DNSWL_NONE autolearn=ham version=3.3.2 X-Spam-User: qpsmtpd, 2 recipients X-HELO: relay1.mentorg.com Received: from relay1.mentorg.com (HELO relay1.mentorg.com) (192.94.38.131) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Thu, 06 Nov 2014 22:36:43 +0000 Received: from svr-orw-fem-02x.mgc.mentorg.com ([147.34.96.206] helo=SVR-ORW-FEM-02.mgc.mentorg.com) by relay1.mentorg.com with esmtp id 1XmVfT-0001TK-Kg from Cesar_Philippidis@mentor.com ; Thu, 06 Nov 2014 14:36:39 -0800 Received: from [127.0.0.1] (147.34.91.1) by svr-orw-fem-02.mgc.mentorg.com (147.34.96.168) with Microsoft SMTP Server id 14.3.181.6; Thu, 6 Nov 2014 14:36:38 -0800 Message-ID: <545BF7F6.9080807@codesourcery.com> Date: Thu, 6 Nov 2014 14:36:38 -0800 From: Cesar Philippidis User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:31.0) Gecko/20100101 Thunderbird/31.2.0 MIME-Version: 1.0 To: "gcc-patches@gcc.gnu.org" , Subject: [patch] OpenACC fortran tests This patch contains compile-time tests for OpenACC in gfortran. Is this patch OK for mainline trunk after the OpenACC fortran front end changes make their way in? The fortran front end changes can be found here: https://gcc.gnu.org/ml/gcc-patches/2014-11/msg00553.html Thanks, Cesar 2014-11-06 Cesar Philippidis Thomas Schwinge Ilmir Usmanov gcc/testsuite/ * gfortran.dg/goacc/acc_on_device-1.f95: New test. * gfortran.dg/goacc/acc_on_device-2-off.f95: New test. * gfortran.dg/goacc/acc_on_device-2.f95: New test. * gfortran.dg/goacc/assumed.f95: New test. * gfortran.dg/goacc/asyncwait-1.f95: New test. * gfortran.dg/goacc/asyncwait-2.f95: New test. * gfortran.dg/goacc/asyncwait-3.f95: New test. * gfortran.dg/goacc/asyncwait-4.f95: New test. * gfortran.dg/goacc/branch.f95: New test. * gfortran.dg/goacc/cache-1.f95: New test. * gfortran.dg/goacc/coarray.f95: New test. * gfortran.dg/goacc/continuation-free-form.f95: New test. * gfortran.dg/goacc/cray.f95: New test. * gfortran.dg/goacc/critical.f95: New test. * gfortran.dg/goacc/data-clauses.f95: New test. * gfortran.dg/goacc/data-tree.f95: New test. * gfortran.dg/goacc/declare-1.f95: New test. * gfortran.dg/goacc/enter-exit-data.f95: New test. * gfortran.dg/goacc/fixed-1.f: New test. * gfortran.dg/goacc/fixed-2.f: New test. * gfortran.dg/goacc/fixed-3.f: New test. * gfortran.dg/goacc/fixed-4.f: New test. * gfortran.dg/goacc/goacc.exp: New test. * gfortran.dg/goacc/host_data-tree.f95: New test. * gfortran.dg/goacc/if.f95: New test. * gfortran.dg/goacc/kernels-tree.f95: New test. * gfortran.dg/goacc/list.f95: New test. * gfortran.dg/goacc/literal.f95: New test. * gfortran.dg/goacc/loop-1.f95: New test. * gfortran.dg/goacc/loop-2.f95: New test. * gfortran.dg/goacc/loop-3.f95: New test. * gfortran.dg/goacc/loop-tree-1.f90: New test. * gfortran.dg/goacc/omp.f95: New test. * gfortran.dg/goacc/parallel-kernels-clauses.f95: New test. * gfortran.dg/goacc/parallel-kernels-regions.f95: New test. * gfortran.dg/goacc/parallel-tree.f95: New test. * gfortran.dg/goacc/parameter.f95: New test. * gfortran.dg/goacc/private-1.f95: New test. * gfortran.dg/goacc/private-2.f95: New test. * gfortran.dg/goacc/private-3.f95: New test. * gfortran.dg/goacc/pure-elemental-procedures.f95: New test. * gfortran.dg/goacc/reduction-2.f95: New test. * gfortran.dg/goacc/reduction.f95: New test. * gfortran.dg/goacc/routine-1.f90: New test. * gfortran.dg/goacc/routine-2.f90: New test. * gfortran.dg/goacc/sentinel-free-form.f95: New test. * gfortran.dg/goacc/several-directives.f95: New test. * gfortran.dg/goacc/sie.f95: New test. * gfortran.dg/goacc/subarrays.f95: New test. diff --git a/gcc/testsuite/gfortran.dg/goacc/acc_on_device-1.f95 b/gcc/testsuite/gfortran.dg/goacc/acc_on_device-1.f95 new file mode 100644 index 0000000..9dfde26 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/goacc/acc_on_device-1.f95 @@ -0,0 +1,22 @@ +! Have to enable optimizations, as otherwise builtins won't be expanded. +! { dg-additional-options "-O -fdump-rtl-expand" } + +logical function f () + implicit none + + external acc_on_device + logical (4) acc_on_device + + f = .false. + f = f .or. acc_on_device () + f = f .or. acc_on_device (1, 2) + f = f .or. acc_on_device (3.14) + f = f .or. acc_on_device ("hello") + + return +end function f + +! Unsuitable to be handled as a builtin, so we're expecting four calls. +! { dg-final { scan-rtl-dump-times "\\\(call \[^\\n\]*\\\"acc_on_device" 4 "expand" } } + +! { dg-final { cleanup-rtl-dump "expand" } } diff --git a/gcc/testsuite/gfortran.dg/goacc/acc_on_device-2-off.f95 b/gcc/testsuite/gfortran.dg/goacc/acc_on_device-2-off.f95 new file mode 100644 index 0000000..cf28264 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/goacc/acc_on_device-2-off.f95 @@ -0,0 +1,39 @@ +! Have to enable optimizations, as otherwise builtins won't be expanded. +! { dg-additional-options "-O -fdump-rtl-expand -fno-openacc" } + +module openacc_kinds + implicit none + + integer, parameter :: acc_device_kind = 4 + +end module openacc_kinds + +module openacc + use openacc_kinds + implicit none + + integer (acc_device_kind), parameter :: acc_device_host = 2 + + interface + function acc_on_device (dev) + use openacc_kinds + logical (4) :: acc_on_device + integer (acc_device_kind), intent (in) :: dev + end function acc_on_device + end interface +end module openacc + +logical (4) function f () + use openacc + implicit none + + integer (4), parameter :: dev = 2 + + f = acc_on_device (dev) + return +end function f + +! Without -fopenacc, we're expecting one call. +! { dg-final { scan-rtl-dump-times "\\\(call \[^\\n\]*\\\"acc_on_device" 1 "expand" } } + +! { dg-final { cleanup-rtl-dump "expand" } } diff --git a/gcc/testsuite/gfortran.dg/goacc/acc_on_device-2.f95 b/gcc/testsuite/gfortran.dg/goacc/acc_on_device-2.f95 new file mode 100644 index 0000000..7730a60 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/goacc/acc_on_device-2.f95 @@ -0,0 +1,40 @@ +! Have to enable optimizations, as otherwise builtins won't be expanded. +! { dg-additional-options "-O -fdump-rtl-expand" } + +module openacc_kinds + implicit none + + integer, parameter :: acc_device_kind = 4 + +end module openacc_kinds + +module openacc + use openacc_kinds + implicit none + + integer (acc_device_kind), parameter :: acc_device_host = 2 + + interface + function acc_on_device (dev) + use openacc_kinds + logical (4) :: acc_on_device + integer (acc_device_kind), intent (in) :: dev + end function acc_on_device + end interface +end module openacc + +logical (4) function f () + use openacc + implicit none + + integer (4), parameter :: dev = 2 + + f = acc_on_device (dev) + return +end function f + +! With -fopenacc, we're expecting the builtin to be expanded, so no calls. +! TODO: not working. +! { dg-final { scan-rtl-dump-times "\\\(call \[^\\n\]*\\\"acc_on_device" 0 "expand" { xfail *-*-* } } } + +! { dg-final { cleanup-rtl-dump "expand" } } diff --git a/gcc/testsuite/gfortran.dg/goacc/assumed.f95 b/gcc/testsuite/gfortran.dg/goacc/assumed.f95 new file mode 100644 index 0000000..3287241 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/goacc/assumed.f95 @@ -0,0 +1,47 @@ +! { 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 device (a) ! { dg-error "Assumed size" } + !$acc update host (a) ! { dg-error "Assumed size" } + !$acc update self (a) ! { dg-error "Assumed size" } + end subroutine assumed_size + 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 device (a) ! { dg-error "Assumed rank" } + !$acc update host (a) ! { dg-error "Assumed rank" } + !$acc update self (a) ! { dg-error "Assumed rank" } + end subroutine assumed_rank +end module test diff --git a/gcc/testsuite/gfortran.dg/goacc/asyncwait-1.f95 b/gcc/testsuite/gfortran.dg/goacc/asyncwait-1.f95 new file mode 100644 index 0000000..d630d38 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/goacc/asyncwait-1.f95 @@ -0,0 +1,91 @@ +! { dg-do compile } + +program asyncwait + integer, parameter :: N = 64 + real, allocatable :: a(:), b(:) + integer i + + allocate (a(N)) + allocate (b(N)) + + a(:) = 3.0 + b(:) = 0.0 + + !$acc parallel copyin (a(1:N)) copy (b(1:N)) async (1 2) ! { dg-error "Unclassifiable OpenACC directive" } + do i = 1, N + b(i) = a(i) + end do + !$acc end parallel ! { dg-error "Unexpected \\\!\\\$ACC END PARALLEL" } + + !$acc parallel copyin (a(1:N)) copy (b(1:N)) async (1,) ! { dg-error "Unclassifiable OpenACC directive" } + do i = 1, N + b(i) = a(i) + end do + !$acc end parallel ! { dg-error "Unexpected \\\!\\\$ACC END PARALLEL" } + + !$acc parallel copyin (a(1:N)) copy (b(1:N)) async (,1) ! { dg-error "Invalid character in name" } + do i = 1, N + b(i) = a(i) + end do + !$acc end parallel ! { dg-error "Unexpected \\\!\\\$ACC END PARALLEL" } + + !$acc parallel copyin (a(1:N)) copy (b(1:N)) async (1,2,) ! { dg-error "Unclassifiable OpenACC directive" } + do i = 1, N + b(i) = a(i) + end do + !$acc end parallel ! { dg-error "Unexpected \\\!\\\$ACC END PARALLEL" } + + !$acc parallel copyin (a(1:N)) copy (b(1:N)) async (1,2 3) ! { dg-error "Unclassifiable OpenACC directive" } + do i = 1, N + b(i) = a(i) + end do + !$acc end parallel ! { dg-error "Unexpected \\\!\\\$ACC END PARALLEL" } + + !$acc parallel copyin (a(1:N)) copy (b(1:N)) async (1,2,,) ! { dg-error "Unclassifiable OpenACC directive" } + do i = 1, N + b(i) = a(i) + end do + !$acc end parallel ! { dg-error "Unexpected \\\!\\\$ACC END PARALLEL" } + + !$acc parallel copyin (a(1:N)) copy (b(1:N)) async (1 ! { dg-error "Unclassifiable OpenACC directive" } + do i = 1, N + b(i) = a(i) + end do + !$acc end parallel ! { dg-error "Unexpected \\\!\\\$ACC END PARALLEL" } + + !$acc parallel copyin (a(1:N)) copy (b(1:N)) async (*) ! { dg-error "Invalid character in name at" } + do i = 1, N + b(i) = a(i) + end do + !$acc end parallel ! { dg-error "Unexpected \\\!\\\$ACC END PARALLEL" } + + !$acc parallel copyin (a(1:N)) copy (b(1:N)) async (a) ! { dg-error "ASYNC clause at \\\(1\\\) requires a scalar INTEGER expression" } + do i = 1, N + b(i) = a(i) + end do + !$acc end parallel + + !$acc parallel copyin (a(1:N)) copy (b(1:N)) async (N) + do i = 1, N + b(i) = a(i) + end do + !$acc end parallel + + !$acc parallel copyin (a(1:N)) copy (b(1:N)) async (1.0) ! { dg-error "ASYNC clause at \\\(1\\\) requires a scalar INTEGER expression" } + do i = 1, N + b(i) = a(i) + end do + !$acc end parallel + + !$acc parallel copyin (a(1:N)) copy (b(1:N)) async () ! { dg-error "Invalid character in name at " } + do i = 1, N + b(i) = a(i) + end do + !$acc end parallel ! { dg-error "Unexpected \\\!\\\$ACC END PARALLEL" } + + !$acc parallel copyin (a(1:N)) copy (b(1:N)) async + do i = 1, N + b(i) = a(i) + end do + !$acc end parallel +end program asyncwait diff --git a/gcc/testsuite/gfortran.dg/goacc/asyncwait-2.f95 b/gcc/testsuite/gfortran.dg/goacc/asyncwait-2.f95 new file mode 100644 index 0000000..db0ce1f --- /dev/null +++ b/gcc/testsuite/gfortran.dg/goacc/asyncwait-2.f95 @@ -0,0 +1,91 @@ +! { dg-do compile } + +program asyncwait + integer, parameter :: N = 64 + real, allocatable :: a(:), b(:) + integer i + + allocate (a(N)) + allocate (b(N)) + + a(:) = 3.0 + b(:) = 0.0 + + !$acc parallel copyin (a(1:N)) copy (b(1:N)) wait (1 2) ! { dg-error "Syntax error in OpenACC expression list" } + do i = 1, N + b(i) = a(i) + end do + !$acc end parallel ! { dg-error "Unexpected \\\!\\\$ACC END PARALLEL" } + + !$acc parallel copyin (a(1:N)) copy (b(1:N)) wait (1,) ! { dg-error "Syntax error in OpenACC expression list" } + do i = 1, N + b(i) = a(i) + end do + !$acc end parallel ! { dg-error "Unexpected \\\!\\\$ACC END PARALLEL" } + + !$acc parallel copyin (a(1:N)) copy (b(1:N)) wait (,1) ! { dg-error "Syntax error in OpenACC expression list" } + do i = 1, N + b(i) = a(i) + end do + !$acc end parallel ! { dg-error "Unexpected \\\!\\\$ACC END PARALLEL" } + + !$acc parallel copyin (a(1:N)) copy (b(1:N)) wait (1,2,) ! { dg-error "Syntax error in OpenACC expression list" } + do i = 1, N + b(i) = a(i) + end do + !$acc end parallel ! { dg-error "Unexpected \\\!\\\$ACC END PARALLEL" } + + !$acc parallel copyin (a(1:N)) copy (b(1:N)) wait (1,2 3) ! { dg-error "Syntax error in OpenACC expression list" } + do i = 1, N + b(i) = a(i) + end do + !$acc end parallel ! { dg-error "Unexpected \\\!\\\$ACC END PARALLEL" } + + !$acc parallel copyin (a(1:N)) copy (b(1:N)) wait (1,2,,) ! { dg-error "Syntax error in OpenACC expression list" } + do i = 1, N + b(i) = a(i) + end do + !$acc end parallel ! { dg-error "Unexpected \\\!\\\$ACC END PARALLEL" } + + !$acc parallel copyin (a(1:N)) copy (b(1:N)) wait (1 ! { dg-error "Syntax error in OpenACC expression list" } + do i = 1, N + b(i) = a(i) + end do + !$acc end parallel ! { dg-error "Unexpected \\\!\\\$ACC END PARALLEL" } + + !$acc parallel copyin (a(1:N)) copy (b(1:N)) wait (*) ! { dg-error "Syntax error in OpenACC expression list" } + do i = 1, N + b(i) = a(i) + end do + !$acc end parallel ! { dg-error "Unexpected \\\!\\\$ACC END PARALLEL" } + + !$acc parallel copyin (a(1:N)) copy (b(1:N)) wait (a) ! { dg-error "WAIT clause at \\\(1\\\) requires a scalar INTEGER expression" } + do i = 1, N + b(i) = a(i) + end do + !$acc end parallel + + !$acc parallel copyin (a(1:N)) copy (b(1:N)) wait (N) + do i = 1, N + b(i) = a(i) + end do + !$acc end parallel + + !$acc parallel copyin (a(1:N)) copy (b(1:N)) wait (1.0) ! { dg-error "WAIT clause at \\\(1\\\) requires a scalar INTEGER expression" } + do i = 1, N + b(i) = a(i) + end do + !$acc end parallel + + !$acc parallel copyin (a(1:N)) copy (b(1:N)) wait () ! { dg-error "Syntax error in OpenACC expression list" } + do i = 1, N + b(i) = a(i) + end do + !$acc end parallel ! { dg-error "Unexpected \\\!\\\$ACC END PARALLEL" } + + !$acc parallel copyin (a(1:N)) copy (b(1:N)) wait + do i = 1, N + b(i) = a(i) + end do + !$acc end parallel +end program asyncwait diff --git a/gcc/testsuite/gfortran.dg/goacc/asyncwait-3.f95 b/gcc/testsuite/gfortran.dg/goacc/asyncwait-3.f95 new file mode 100644 index 0000000..32c11de --- /dev/null +++ b/gcc/testsuite/gfortran.dg/goacc/asyncwait-3.f95 @@ -0,0 +1,41 @@ +! { dg-do compile } + +program asyncwait + integer, parameter :: N = 64 + real, allocatable :: a(:), b(:) + integer i + + allocate (a(N)) + allocate (b(N)) + + a(:) = 3.0 + b(:) = 0.0 + + !$acc wait (1 2) ! { dg-error "Unexpected junk in \\\!\\\$ACC WAIT at" } + + !$acc wait (1,) ! { dg-error "Unexpected junk in \\\!\\\$ACC WAIT at" } + + !$acc wait (,1) ! { dg-error "Unexpected junk in \\\!\\\$ACC WAIT at" } + + !$acc wait (1, 2, ) ! { dg-error "Unexpected junk in \\\!\\\$ACC WAIT at" } + + !$acc wait (1, 2, ,) ! { dg-error "Unexpected junk in \\\!\\\$ACC WAIT at" } + + !$acc wait (1 ! { dg-error "Unexpected junk in \\\!\\\$ACC WAIT at" } + + !$acc wait (1, *) ! { dg-error "Invalid argument to \\\$\\\!ACC WAIT" } + + !$acc wait (1, a) ! { dg-error "WAIT clause at \\\(1\\\) requires a scalar INTEGER expression" } + + !$acc wait (a) ! { dg-error "WAIT clause at \\\(1\\\) requires a scalar INTEGER expression" } + + !$acc wait (N) + + !$acc wait (1.0) ! { dg-error "WAIT clause at \\\(1\\\) requires a scalar INTEGER expression" } + + !$acc wait 1 ! { dg-error "Unexpected junk in \\\!\\\$ACC WAIT at" } + + !$acc wait N ! { dg-error "Unexpected junk in \\\!\\\$ACC WAIT at" } + + !$acc wait (1) +end program asyncwait diff --git a/gcc/testsuite/gfortran.dg/goacc/asyncwait-4.f95 b/gcc/testsuite/gfortran.dg/goacc/asyncwait-4.f95 new file mode 100644 index 0000000..cd64ef3 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/goacc/asyncwait-4.f95 @@ -0,0 +1,37 @@ +! { dg-do compile } + +program asyncwait + integer, parameter :: N = 64 + real, allocatable :: a(:), b(:) + integer i + + allocate (a(N)) + allocate (b(N)) + + a(:) = 3.0 + b(:) = 0.0 + + !$acc wait async (1 2) ! { dg-error "Unexpected junk in \\\!\\\$ACC WAIT at" } + + !$acc wait async (1,) ! { dg-error "Unexpected junk in \\\!\\\$ACC WAIT at" } + + !$acc wait async (,1) ! { dg-error "Unexpected junk in \\\!\\\$ACC WAIT at" } + + !$acc wait async (1, 2, ) ! { dg-error "Unexpected junk in \\\!\\\$ACC WAIT at" } + + !$acc wait async (1, 2, ,) ! { dg-error "Unexpected junk in \\\!\\\$ACC WAIT at" } + + !$acc wait async (1 ! { dg-error "Unexpected junk in \\\!\\\$ACC WAIT at" } + + !$acc wait async (1, *) ! { dg-error "Unexpected junk in \\\!\\\$ACC WAIT at" } + + !$acc wait async (1, a) ! { dg-error "Unexpected junk in \\\!\\\$ACC WAIT at" } + + !$acc wait async (a) ! { dg-error "ASYNC clause at \\\(1\\\) requires a scalar INTEGER expression" } + + !$acc wait async (N) + + !$acc wait async (1.0) ! { dg-error "ASYNC clause at \\\(1\\\) requires a scalar INTEGER expression" } + + !$acc wait async 1 ! { dg-error "Unexpected junk in \\\!\\\$ACC WAIT at" } +end program asyncwait 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/cache-1.f95 b/gcc/testsuite/gfortran.dg/goacc/cache-1.f95 new file mode 100644 index 0000000..746cf02 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/goacc/cache-1.f95 @@ -0,0 +1,12 @@ +! { dg-do compile } +! { dg-additional-options "-std=f2008" } + +program test + implicit none + integer :: i, d(10) + + do concurrent (i=1:5) + !$acc cache (d) + enddo +end +! { dg-prune-output "unimplemented" } diff --git a/gcc/testsuite/gfortran.dg/goacc/coarray.f95 b/gcc/testsuite/gfortran.dg/goacc/coarray.f95 new file mode 100644 index 0000000..4f1224e --- /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 device (a) + !$acc update host (a) + !$acc update self (a) + end subroutine oacc1 +end module test +! { dg-prune-output "ACC cache unimplemented" } 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..8f2c077 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/goacc/cray.f95 @@ -0,0 +1,56 @@ +! { 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 device (pointee) ! { dg-error "Cray pointee" } + !$acc update host (pointee) ! { dg-error "Cray pointee" } + !$acc update self (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 device (ptr) + !$acc update host (ptr) + !$acc update self (ptr) + end subroutine oacc1 +end module test +! { dg-prune-output "unimplemented" } 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..b94214e --- /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, asa) + integer, value :: vi + integer :: i, ia(10) + complex :: c, ca(10) + real, target:: r + real :: ra(10) + real, pointer :: rp + real, dimension(:), allocatable :: aa + real, dimension(:) :: asa + 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, asa, ti) + !$acc end parallel + !$acc kernels deviceptr (i, c, r, ia, ca, ra, asa, ti) + !$acc end kernels + !$acc data deviceptr (i, c, r, ia, ca, ra, asa, 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, asa, rp, ti, vi, aa) + !$acc end parallel + !$acc kernels copy (i, c, r, ia, ca, ra, asa, rp, ti, vi, aa) + !$acc end kernels + !$acc data copy (i, c, r, ia, ca, ra, asa, 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, asa, rp, ti, vi, aa) + !$acc end parallel + !$acc kernels copyin (i, c, r, ia, ca, ra, asa, rp, ti, vi, aa) + !$acc end kernels + !$acc data copyin (i, c, r, ia, ca, ra, asa, 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, asa, rp, ti, vi, aa) + !$acc end parallel + !$acc kernels copyout (i, c, r, ia, ca, ra, asa, rp, ti, vi, aa) + !$acc end kernels + !$acc data copyout (i, c, r, ia, ca, ra, asa, 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, asa, rp, ti, vi, aa) + !$acc end parallel + !$acc kernels create (i, c, r, ia, ca, ra, asa, rp, ti, vi, aa) + !$acc end kernels + !$acc data create (i, c, r, ia, ca, ra, asa, 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, asa, rp, ti, vi, aa) + !$acc end parallel + !$acc kernels present (i, c, r, ia, ca, ra, asa, rp, ti, vi, aa) + !$acc end kernels + !$acc data present (i, c, r, ia, ca, ra, asa, rp, ti, vi, aa) + !$acc end data + + + !$acc parallel pcopy (i, c, r, ia, ca, ra, asa, rp, ti, vi, aa) + !$acc end parallel + !$acc parallel pcopyin (i, c, r, ia, ca, ra, asa, rp, ti, vi, aa) + !$acc end parallel + !$acc parallel pcopyout (i, c, r, ia, ca, ra, asa, rp, ti, vi, aa) + !$acc end parallel + !$acc parallel pcreate (i, c, r, ia, ca, ra, asa, 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, asa, rp, ti, vi, aa) + !$acc end parallel + !$acc kernels present_or_copy (i, c, r, ia, ca, ra, asa, rp, ti, vi, aa) + !$acc end kernels + !$acc data present_or_copy (i, c, r, ia, ca, ra, asa, 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, asa, rp, ti, vi, aa) + !$acc end parallel + !$acc kernels present_or_copyin (i, c, r, ia, ca, ra, asa, rp, ti, vi, aa) + !$acc end kernels + !$acc data present_or_copyin (i, c, r, ia, ca, ra, asa, 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, asa, rp, ti, vi, aa) + !$acc end parallel + !$acc kernels present_or_copyout (i, c, r, ia, ca, ra, asa, rp, ti, vi, aa) + !$acc end kernels + !$acc data present_or_copyout (i, c, r, ia, ca, ra, asa, 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, asa, rp, ti, vi, aa) + !$acc end parallel + !$acc kernels present_or_create (i, c, r, ia, ca, ra, asa, rp, ti, vi, aa) + !$acc end kernels + !$acc data present_or_create (i, c, r, ia, ca, ra, asa, 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..32c50fd --- /dev/null +++ b/gcc/testsuite/gfortran.dg/goacc/data-tree.f95 @@ -0,0 +1,30 @@ +! { 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-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" } } 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..03540f1 --- /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-prune-output "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/fixed-1.f b/gcc/testsuite/gfortran.dg/goacc/fixed-1.f new file mode 100644 index 0000000..6a454190 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/goacc/fixed-1.f @@ -0,0 +1,12 @@ + INTEGER :: ARGC + ARGC = COMMAND_ARGUMENT_COUNT () + +!$OMP PARALLEL +!$ACC PARALLEL COPYIN(ARGC) + IF (ARGC .NE. 0) THEN + CALL ABORT + END IF +!$ACC END PARALLEL +!$OMP END PARALLEL + + END diff --git a/gcc/testsuite/gfortran.dg/goacc/fixed-2.f b/gcc/testsuite/gfortran.dg/goacc/fixed-2.f new file mode 100644 index 0000000..2c2b0a3 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/goacc/fixed-2.f @@ -0,0 +1,15 @@ +! { dg-do compile } +! { dg-additional-options "-fmax-errors=100" } + + INTEGER :: ARGC + ARGC = COMMAND_ARGUMENT_COUNT () + +!$OMP xPARALLEL +!$ACC xPARALLEL COPYIN(ARGC) ! { dg-error "Unclassifiable OpenACC directive" } + IF (ARGC .NE. 0) THEN + CALL ABORT + END IF +!$ACC END PARALLEL ! { dg-error "Unexpected" } +!$OMP END PARALLEL + + END diff --git a/gcc/testsuite/gfortran.dg/goacc/fixed-3.f b/gcc/testsuite/gfortran.dg/goacc/fixed-3.f new file mode 100644 index 0000000..ede361e --- /dev/null +++ b/gcc/testsuite/gfortran.dg/goacc/fixed-3.f @@ -0,0 +1,13 @@ + IMPLICIT NONE + + INTEGER DEV + +!$ACC PARALLEL + DEV = 0 +!$ACC END PARALLEL + +!$ACC PARALLEL + DEV = 0 +!$ACC END PARALLEL + + END diff --git a/gcc/testsuite/gfortran.dg/goacc/fixed-4.f b/gcc/testsuite/gfortran.dg/goacc/fixed-4.f new file mode 100644 index 0000000..120d5a9 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/goacc/fixed-4.f @@ -0,0 +1,6 @@ + IMPLICIT NONE + +!$ACC PARALLEL +!$ACC END PARALLEL + + END diff --git a/gcc/testsuite/gfortran.dg/goacc/goacc.exp b/gcc/testsuite/gfortran.dg/goacc/goacc.exp new file mode 100644 index 0000000..07a554f --- /dev/null +++ b/gcc/testsuite/gfortran.dg/goacc/goacc.exp @@ -0,0 +1,36 @@ +# Copyright (C) 2005-2014 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..19e7411 --- /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-prune-output "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..7585a16 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/goacc/kernels-tree.f95 @@ -0,0 +1,32 @@ +! { 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-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..e6760d0 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/goacc/literal.f95 @@ -0,0 +1,30 @@ +! { 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 device (10) ! { dg-error "Syntax error" } + !$acc update host (10) ! { dg-error "Syntax error" } + !$acc update self (10) ! { dg-error "Syntax error" } + end subroutine oacc1 +end module test 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..e1b2dfd --- /dev/null +++ b/gcc/testsuite/gfortran.dg/goacc/loop-1.f95 @@ -0,0 +1,171 @@ +! { 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-prune-output "Deleted" } +! { dg-prune-output "ACC cache unimplemented" } 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..2a866c7 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/goacc/loop-3.f95 @@ -0,0 +1,55 @@ +! { dg-do compile } +! { dg-additional-options "-std=f2008" } + +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 + + !$acc loop + outer_loop: do i = 1, 5 + inner_loop: do j = 1,5 + if (i .eq. j) cycle outer_loop + if (i .ne. j) exit outer_loop ! { dg-error "EXIT statement" } + end do inner_loop + end do outer_loop + + outer_loop1: do i = 1, 5 + !$acc loop + inner_loop1: do j = 1,5 + if (i .eq. j) cycle outer_loop1 ! { dg-error "CYCLE statement" } + end do inner_loop1 + end do outer_loop1 + + !$acc loop collapse(2) + outer_loop2: do i = 1, 5 + inner_loop2: do j = 1,5 + if (i .eq. j) cycle outer_loop2 ! { dg-error "CYCLE statement" } + if (i .ne. j) exit outer_loop2 ! { dg-error "EXIT statement" } + end do inner_loop2 + end do outer_loop2 +end subroutine test1 + diff --git a/gcc/testsuite/gfortran.dg/goacc/loop-tree-1.f90 b/gcc/testsuite/gfortran.dg/goacc/loop-tree-1.f90 new file mode 100644 index 0000000..47ff77e --- /dev/null +++ b/gcc/testsuite/gfortran.dg/goacc/loop-tree-1.f90 @@ -0,0 +1,48 @@ +! { dg-do compile } +! { dg-additional-options "-fdump-tree-original -std=f2008" } + +! test for tree-dump-original and spaces-commas + +program test + implicit none + integer :: i, j, k, m, sum + REAL :: a(64), b(64), c(64) + + !$acc kernels + !$acc loop collapse(2) + DO i = 1,10 + DO j = 1,10 + ENDDO + ENDDO + + !$acc loop independent gang (3) + DO i = 1,10 + !$acc loop worker(3) ! { dg-error "work-sharing region may not be closely nested inside of work-sharing, critical, ordered, master or explicit task region" } + DO j = 1,10 + !$acc loop vector(5) + DO k = 1,10 + ENDDO + ENDDO + ENDDO + !$acc end kernels + + sum = 0 + !$acc parallel + !$acc loop private(m) reduction(+:sum) + DO i = 1,10 + sum = sum + 1 + ENDDO + !$acc end parallel + +end program test +! { dg-final { scan-tree-dump-times "pragma acc loop" 5 "original" } } + +! { dg-final { scan-tree-dump-times "collapse\\(2\\)" 1 "original" } } +! { dg-final { scan-tree-dump-times "independent" 1 "original" } } +! { dg-final { scan-tree-dump-times "gang\\(3\\)" 1 "original" } } +! { dg-final { scan-tree-dump-times "worker\\(3\\)" 1 "original" } } +! { dg-final { scan-tree-dump-times "vector\\(5\\)" 1 "original" } } + +! { dg-final { scan-tree-dump-times "private\\(m\\)" 1 "original" } } +! { dg-final { scan-tree-dump-times "reduction\\(\\+:sum\\)" 1 "original" } } +! { dg-final { cleanup-tree-dump "original" } } 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..c37208c --- /dev/null +++ b/gcc/testsuite/gfortran.dg/goacc/parallel-kernels-clauses.f95 @@ -0,0 +1,96 @@ +! { 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..33cb9cb --- /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-prune-output "Error: may not be nested" } 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..48061b1 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/goacc/parallel-tree.f95 @@ -0,0 +1,41 @@ +! { 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-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..1364181 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/goacc/parameter.f95 @@ -0,0 +1,32 @@ +! { 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 device (a) ! { dg-error "not a variable" } + !$acc update host (a) ! { dg-error "not a variable" } + !$acc update self (a) ! { dg-error "not a variable" } + end subroutine oacc1 +end module test +! { dg-prune-output "unimplemented" } diff --git a/gcc/testsuite/gfortran.dg/goacc/private-1.f95 b/gcc/testsuite/gfortran.dg/goacc/private-1.f95 new file mode 100644 index 0000000..54c027d --- /dev/null +++ b/gcc/testsuite/gfortran.dg/goacc/private-1.f95 @@ -0,0 +1,37 @@ +! { dg-do compile } +! { dg-additional-options "-fdump-tree-omplower" } + +! test for implicit private clauses in do loops + +program test + implicit none + integer :: i, j, k + + !$acc parallel + !$acc loop + do i = 1, 100 + end do + !$acc end parallel + + !$acc parallel + !$acc loop + do i = 1, 100 + do j = 1, 100 + end do + end do + !$acc end parallel + + !$acc parallel + !$acc loop + do i = 1, 100 + do j = 1, 100 + do k = 1, 100 + end do + end do + end do + !$acc end parallel +end program test +! { dg-final { scan-tree-dump-times "pragma acc parallel" 3 "omplower" } } +! { dg-final { scan-tree-dump-times "private\\(i\\)" 3 "omplower" } } +! { dg-final { scan-tree-dump-times "private\\(j\\)" 2 "omplower" } } +! { dg-final { scan-tree-dump-times "private\\(k\\)" 1 "omplower" } } diff --git a/gcc/testsuite/gfortran.dg/goacc/private-2.f95 b/gcc/testsuite/gfortran.dg/goacc/private-2.f95 new file mode 100644 index 0000000..4b038f2 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/goacc/private-2.f95 @@ -0,0 +1,39 @@ +! { dg-do compile } + +! test for implicit private clauses in do loops + +program test + implicit none + integer :: i, j, k, a(10) + + !$acc parallel + !$acc loop + do i = 1, 100 + end do + !$acc end parallel + + !$acc parallel + !$acc loop + do i = 1, 100 + do j = 1, 100 + end do + end do + !$acc end parallel + + !$acc data copy(a) + + if(mod(1,10) .eq. 0) write(*,'(i5)') i + + do i = 1, 100 + !$acc parallel + !$acc loop + do j = 1, 100 + do k = 1, 100 + end do + end do + !$acc end parallel + end do + + !$acc end data + +end program test diff --git a/gcc/testsuite/gfortran.dg/goacc/private-3.f95 b/gcc/testsuite/gfortran.dg/goacc/private-3.f95 new file mode 100644 index 0000000..aa12a56 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/goacc/private-3.f95 @@ -0,0 +1,23 @@ +! { dg-do compile } + +! test for private variables in a reduction clause + +program test + implicit none + integer, parameter :: n = 100 + integer :: i, k + +! FIXME: This causes an ICE in the gimplifier. +! !$acc parallel private (k) reduction (+:k) +! do i = 1, n +! k = k + 1 +! end do +! !$acc end parallel + + !$acc parallel private (k) + !$acc loop reduction (+:k) + do i = 1, n + k = k + 1 + end do + !$acc end parallel +end program test 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-2.f95 b/gcc/testsuite/gfortran.dg/goacc/reduction-2.f95 new file mode 100644 index 0000000..ffcec70 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/goacc/reduction-2.f95 @@ -0,0 +1,21 @@ +! { dg-do compile } + +program reduction + integer, parameter :: n = 40, c = 10 + integer :: i, sum + + call redsub (sum, n, c) +end program reduction + +subroutine redsub(sum, n, c) + integer :: sum, n, c + + sum = 0 + + !$acc parallel vector_length(n) copyin (n, c) + !$acc loop reduction(+:sum) + do i = 1, n + sum = sum + c + end do + !$acc end parallel +end subroutine redsub diff --git a/gcc/testsuite/gfortran.dg/goacc/reduction.f95 b/gcc/testsuite/gfortran.dg/goacc/reduction.f95 new file mode 100644 index 0000000..833230a --- /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 "OMP DECLARE REDUCTION \\+ not found for type LOGICAL" } +!$acc end parallel +!$acc parallel reduction (*:la1) ! { dg-error "OMP DECLARE REDUCTION \\* not found for type LOGICAL" } +!$acc end parallel +!$acc parallel reduction (-:a1) ! { dg-error "OMP DECLARE REDUCTION - not found for type CHARACTER" } +!$acc end parallel +!$acc parallel reduction (+:t1) ! { dg-error "OMP DECLARE REDUCTION \\+ not found for type TYPE" } +!$acc end parallel +!$acc parallel reduction (*:ta1) ! { dg-error "OMP DECLARE REDUCTION \\* not found for type TYPE" } +!$acc end parallel +!$acc parallel reduction (.and.:i3) ! { dg-error "OMP DECLARE REDUCTION \\.and\\. not found for type INTEGER" } +!$acc end parallel +!$acc parallel reduction (.or.:ia2) ! { dg-error "OMP DECLARE REDUCTION \\.or\\. not found for type INTEGER" } +!$acc end parallel +!$acc parallel reduction (.eqv.:r1) ! { dg-error "OMP DECLARE REDUCTION \\.eqv\\. not found for type REAL" } +!$acc end parallel +!$acc parallel reduction (.neqv.:ra1) ! { dg-error "OMP DECLARE REDUCTION \\.neqv\\. not found for type REAL" } +!$acc end parallel +!$acc parallel reduction (.and.:d1) ! { dg-error "OMP DECLARE REDUCTION \\.and\\. not found for type REAL" } +!$acc end parallel +!$acc parallel reduction (.or.:da1) ! { dg-error "OMP DECLARE REDUCTION \\.or\\. not found for type REAL" } +!$acc end parallel +!$acc parallel reduction (.eqv.:c1) ! { dg-error "OMP DECLARE REDUCTION \\.eqv\\. not found for type COMPLEX" } +!$acc end parallel +!$acc parallel reduction (.neqv.:ca1) ! { dg-error "OMP DECLARE REDUCTION \\.neqv\\. not found for type COMPLEX" } +!$acc end parallel +!$acc parallel reduction (.and.:a1) ! { dg-error "OMP DECLARE REDUCTION \\.and\\. not found for type CHARACTER" } +!$acc end parallel +!$acc parallel reduction (.or.:t1) ! { dg-error "OMP DECLARE REDUCTION \\.or\\. not found for type TYPE" } +!$acc end parallel +!$acc parallel reduction (.eqv.:ta1) ! { dg-error "OMP DECLARE REDUCTION \\.eqv\\. not found for type TYPE" } +!$acc end parallel +!$acc parallel reduction (min:c1) ! { dg-error "OMP DECLARE REDUCTION min not found for type COMPLEX" } +!$acc end parallel +!$acc parallel reduction (max:ca1) ! { dg-error "OMP DECLARE REDUCTION max not found for type COMPLEX" } +!$acc end parallel +!$acc parallel reduction (max:l1) ! { dg-error "OMP DECLARE REDUCTION max not found for type LOGICAL" } +!$acc end parallel +!$acc parallel reduction (min:la1) ! { dg-error "OMP DECLARE REDUCTION min not found for type LOGICAL" } +!$acc end parallel +!$acc parallel reduction (max:a1) ! { dg-error "OMP DECLARE REDUCTION max not found for type CHARACTER" } +!$acc end parallel +!$acc parallel reduction (min:t1) ! { dg-error "OMP DECLARE REDUCTION min not found for type TYPE" } +!$acc end parallel +!$acc parallel reduction (max:ta1) ! { dg-error "OMP DECLARE REDUCTION max not found for type TYPE" } +!$acc end parallel +!$acc parallel reduction (iand:r1) ! { dg-error "OMP DECLARE REDUCTION iand not found for type REAL" } +!$acc end parallel +!$acc parallel reduction (ior:ra1) ! { dg-error "OMP DECLARE REDUCTION ior not found for type REAL" } +!$acc end parallel +!$acc parallel reduction (ieor:d1) ! { dg-error "OMP DECLARE REDUCTION ieor not found for type REAL" } +!$acc end parallel +!$acc parallel reduction (ior:da1) ! { dg-error "OMP DECLARE REDUCTION ior not found for type REAL" } +!$acc end parallel +!$acc parallel reduction (iand:c1) ! { dg-error "OMP DECLARE REDUCTION iand not found for type COMPLEX" } +!$acc end parallel +!$acc parallel reduction (ior:ca1) ! { dg-error "OMP DECLARE REDUCTION ior not found for type COMPLEX" } +!$acc end parallel +!$acc parallel reduction (ieor:l1) ! { dg-error "OMP DECLARE REDUCTION ieor not found for type LOGICAL" } +!$acc end parallel +!$acc parallel reduction (iand:la1) ! { dg-error "OMP DECLARE REDUCTION iand not found for type LOGICAL" } +!$acc end parallel +!$acc parallel reduction (ior:a1) ! { dg-error "OMP DECLARE REDUCTION ior not found for type CHARACTER" } +!$acc end parallel +!$acc parallel reduction (ieor:t1) ! { dg-error "OMP DECLARE REDUCTION ieor not found for type TYPE" } +!$acc end parallel +!$acc parallel reduction (iand:ta1) ! { dg-error "OMP DECLARE REDUCTION iand not found for type TYPE" } +!$acc end parallel + +end subroutine diff --git a/gcc/testsuite/gfortran.dg/goacc/routine-1.f90 b/gcc/testsuite/gfortran.dg/goacc/routine-1.f90 new file mode 100644 index 0000000..67c5f11 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/goacc/routine-1.f90 @@ -0,0 +1,37 @@ +! { dg-do compile } + + integer, parameter :: n = 10 + integer :: a(n), i + integer, external :: fact + i = 1 + !$acc routine (fact) ! { dg-error "Unexpected \\\!\\\$ACC ROUTINE" } + !$acc routine () ! { dg-error "Syntax error in \\\!\\\$ACC ROUTINE \\\( NAME \\\)" } + !$acc parallel + !$acc loop + do i = 1, n + a(i) = fact (i) + call incr (a(i)) + end do + !$acc end parallel + do i = 1, n + write (*, "(I10)") a(i) + end do +end +recursive function fact (x) result (res) + integer, intent(in) :: x + integer :: res + res = 1 + !$acc routine ! { dg-error "Unexpected \\\!\\\$ACC ROUTINE" } + if (x < 1) then + res = 1 + else + res = x * fact (x - 1) + end if +end function fact +subroutine incr (x) + integer, intent(inout) :: x + integer i + i = 0 + !$acc routine ! { dg-error "Unexpected \\\!\\\$ACC ROUTINE" } + x = x + 1 +end subroutine incr diff --git a/gcc/testsuite/gfortran.dg/goacc/routine-2.f90 b/gcc/testsuite/gfortran.dg/goacc/routine-2.f90 new file mode 100644 index 0000000..3be3351 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/goacc/routine-2.f90 @@ -0,0 +1,17 @@ +! { dg-do compile } + + module m1 + contains + recursive function mfact (x) result (res) + integer, intent(in) :: x + integer :: res + integer i + i = 0 + !$acc routine ! { dg-error "Unexpected \\\!\\\$ACC ROUTINE" } + if (x < 1) then + res = 1 + else + res = x * mfact (x - 1) + end if + end function mfact + end module m1 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 diff --git a/gcc/testsuite/gfortran.dg/goacc/subarrays.f95 b/gcc/testsuite/gfortran.dg/goacc/subarrays.f95 new file mode 100644 index 0000000..4b3ef42 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/goacc/subarrays.f95 @@ -0,0 +1,41 @@ +! { dg-do compile } +program test + implicit none + integer :: a(10), b(10, 10), c(3:7), i + + !$acc parallel copy(a(1:5)) + !$acc end parallel + !$acc parallel copy(a(1 + 0 : 5 + 2)) + !$acc end parallel + !$acc parallel copy(a(:3)) + !$acc end parallel + !$acc parallel copy(a(3:)) + !$acc end parallel + !$acc parallel copy(a(:)) + !$acc end parallel + !$acc parallel copy(a(2:3,2:3)) + ! { dg-error "Rank mismatch" "" { target *-*-* } 16 } + ! { dg-error "'a' in MAP clause" "" { target *-*-* } 16 } + !$acc end parallel + !$acc parallel copy (a(:11)) ! { dg-warning "Upper array reference" } + !$acc end parallel + !$acc parallel copy (a(i:)) + !$acc end parallel + + !$acc parallel copy (a(:b)) + ! { dg-error "Array index" "" { target *-*-* } 25 } + ! { dg-error "'a' in MAP clause" "" { target *-*-* } 25 } + !$acc end parallel + + !$acc parallel copy (b(1:3,2:4)) + !$acc end parallel + !$acc parallel copy (b(2:3)) + ! { dg-error "Rank mismatch" "" { target *-*-* } 32 } + ! { dg-error "'b' in MAP clause" "" { target *-*-* } 32 } + !$acc end parallel + !$acc parallel copy (b(1:, 4:6)) + !$acc end parallel + + !$acc parallel copy (c(2:)) ! { dg-warning "Lower array reference" } + !$acc end parallel +end program test