From patchwork Fri Jul 12 11:39:25 2019 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Kwok Cheung Yeung X-Patchwork-Id: 1131333 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Authentication-Results: ozlabs.org; spf=pass (mailfrom) smtp.mailfrom=gcc.gnu.org (client-ip=209.132.180.131; helo=sourceware.org; envelope-from=gcc-patches-return-504998-incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=) Authentication-Results: ozlabs.org; dmarc=none (p=none dis=none) header.from=codesourcery.com Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b="kYapGcio"; dkim-atps=neutral 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 45lWF52zrpz9sBt for ; Fri, 12 Jul 2019 21:40:07 +1000 (AEST) DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender :subject:from:to:cc:references:message-id:date:mime-version :in-reply-to:content-type:content-transfer-encoding; q=dns; s= default; b=MU8l/TXB4h9zpZnEW6LqVFXA45oMqefvPtJkuSOWewYNny+eOy5/7 7PmTW8l2oI31my65sx7m54Ww1hZOGqTkecG7AbZrcyixYlPt/FLloa473uicoMoc O3IdmhE7WgOIjOxUWMyrM02j3/1FAOuI3AOXxEUT0xVsAI04W8Nn8s= 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 :subject:from:to:cc:references:message-id:date:mime-version :in-reply-to:content-type:content-transfer-encoding; s=default; bh=iNs0DfO+XHyJSTiTmkZlijZWlyw=; b=kYapGciojhYoHIlmTWPDqkx5PY+Q 9ppp3JpwDCv9s9lVRrgiBb+wzGNyB0pcm22tp+jvqtIx7lI6fvnpA+TadRKLR1Bm IWUltsuujO7tcPDej4zRSsztclNRlJRkaqMVEL6dOuf3xXoAIyz5vbawyeplRFOd RotUp8+b1Afnc+Q= Received: (qmail 2959 invoked by alias); 12 Jul 2019 11:39:54 -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 2941 invoked by uid 89); 12 Jul 2019 11:39:53 -0000 Authentication-Results: sourceware.org; auth=none X-Spam-SWARE-Status: No, score=-16.5 required=5.0 tests=AWL, BAYES_00, GIT_PATCH_0, GIT_PATCH_1, GIT_PATCH_2, GIT_PATCH_3, KAM_NUMSUBJECT, RCVD_IN_DNSWL_NONE autolearn=ham version=3.3.1 spammy=2i, UD:f95, STOP 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; Fri, 12 Jul 2019 11:39:49 +0000 Received: from nat-ies.mentorg.com ([192.94.31.2] helo=SVR-IES-MBX-04.mgc.mentorg.com) by relay1.mentorg.com with esmtps (TLSv1.2:ECDHE-RSA-AES256-SHA384:256) id 1hlttz-0005ow-DA from Kwok_Yeung@mentor.com ; Fri, 12 Jul 2019 04:39:47 -0700 Received: from [172.30.65.231] (137.202.0.90) by SVR-IES-MBX-04.mgc.mentorg.com (139.181.222.4) with Microsoft SMTP Server (TLS) id 15.0.1320.4; Fri, 12 Jul 2019 12:39:43 +0100 Subject: [PATCH 5/5, OpenACC] Add tests for Fortran optional arguments in OpenACC 2.6 From: Kwok Cheung Yeung To: , , CC: References: <6aaaeec8-9c6d-9293-5b6c-622d9fcf2664@codesourcery.com> Message-ID: <3f29a1b4-d7ea-166d-14db-deb3c2e07438@codesourcery.com> Date: Fri, 12 Jul 2019 12:39:25 +0100 User-Agent: Mozilla/5.0 (Windows NT 10.0; Win64; x64; rv:60.0) Gecko/20100101 Thunderbird/60.8.0 MIME-Version: 1.0 In-Reply-To: <6aaaeec8-9c6d-9293-5b6c-622d9fcf2664@codesourcery.com> This adds testcases exercising the use of optional arguments in the various OpenACC directives. Where applicable, both the present and non-present cases are tested, with an integer, array of integers and allocatable array of integers as the argument. libgomp/ * testsuite/libgomp.oacc-fortran/optional-cache.f95: New test. * testsuite/libgomp.oacc-fortran/optional-data-copyin-by-value.f90: New test. * testsuite/libgomp.oacc-fortran/optional-data-copyin.f90: New test. * testsuite/libgomp.oacc-fortran/optional-data-copyout.f90: New test. * testsuite/libgomp.oacc-fortran/optional-data-enter-exit.f90: New test. * testsuite/libgomp.oacc-fortran/optional-declare.f90: New test. * testsuite/libgomp.oacc-fortran/optional-firstprivate.f90: New test. * testsuite/libgomp.oacc-fortran/optional-host_data.f90: New test. * testsuite/libgomp.oacc-fortran/optional-nested-calls.f90: New test. * testsuite/libgomp.oacc-fortran/optional-private.f90: New test. * testsuite/libgomp.oacc-fortran/optional-reduction.f90: New test. * testsuite/libgomp.oacc-fortran/optional-update-device.f90: New test. * testsuite/libgomp.oacc-fortran/optional-update-host.f90: New test. --- .../libgomp.oacc-fortran/optional-cache.f95 | 23 ++++ .../optional-data-copyin-by-value.f90 | 29 +++++ .../libgomp.oacc-fortran/optional-data-copyin.f90 | 140 +++++++++++++++++++++ .../libgomp.oacc-fortran/optional-data-copyout.f90 | 96 ++++++++++++++ .../optional-data-enter-exit.f90 | 91 ++++++++++++++ .../libgomp.oacc-fortran/optional-declare.f90 | 87 +++++++++++++ .../libgomp.oacc-fortran/optional-firstprivate.f90 | 112 +++++++++++++++++ .../libgomp.oacc-fortran/optional-host_data.f90 | 39 ++++++ .../libgomp.oacc-fortran/optional-nested-calls.f90 | 135 ++++++++++++++++++++ .../libgomp.oacc-fortran/optional-private.f90 | 115 +++++++++++++++++ .../libgomp.oacc-fortran/optional-reduction.f90 | 69 ++++++++++ .../optional-update-device.f90 | 121 ++++++++++++++++++ .../libgomp.oacc-fortran/optional-update-host.f90 | 115 +++++++++++++++++ 13 files changed, 1172 insertions(+) create mode 100644 libgomp/testsuite/libgomp.oacc-fortran/optional-cache.f95 create mode 100644 libgomp/testsuite/libgomp.oacc-fortran/optional-data-copyin-by-value.f90 create mode 100644 libgomp/testsuite/libgomp.oacc-fortran/optional-data-copyin.f90 create mode 100644 libgomp/testsuite/libgomp.oacc-fortran/optional-data-copyout.f90 create mode 100644 libgomp/testsuite/libgomp.oacc-fortran/optional-data-enter-exit.f90 create mode 100644 libgomp/testsuite/libgomp.oacc-fortran/optional-declare.f90 create mode 100644 libgomp/testsuite/libgomp.oacc-fortran/optional-firstprivate.f90 create mode 100644 libgomp/testsuite/libgomp.oacc-fortran/optional-host_data.f90 create mode 100644 libgomp/testsuite/libgomp.oacc-fortran/optional-nested-calls.f90 create mode 100644 libgomp/testsuite/libgomp.oacc-fortran/optional-private.f90 create mode 100644 libgomp/testsuite/libgomp.oacc-fortran/optional-reduction.f90 create mode 100644 libgomp/testsuite/libgomp.oacc-fortran/optional-update-device.f90 create mode 100644 libgomp/testsuite/libgomp.oacc-fortran/optional-update-host.f90 diff --git a/libgomp/testsuite/libgomp.oacc-fortran/optional-cache.f95 b/libgomp/testsuite/libgomp.oacc-fortran/optional-cache.f95 new file mode 100644 index 0000000..d828497 --- /dev/null +++ b/libgomp/testsuite/libgomp.oacc-fortran/optional-cache.f95 @@ -0,0 +1,23 @@ +! Test that the cache directives work with optional arguments. The effect +! of giving a non-present argument to the cache directive is not tested as +! it is undefined. The test is based on gfortran.dg/goacc/cache-1.f95. + +! { dg-additional-options "-std=f2008" } + +program cache_test + implicit none + integer :: d(10), e(5,13) + + call do_test(d, e) +contains + subroutine do_test(d, e) + integer, optional :: d(10), e(5,13) + integer :: i + do concurrent (i=1:5) + !$acc cache (d(1:3)) + !$acc cache (d(i:i+2)) + !$acc cache (e(1:3,2:4)) + !$acc cache (e(i:i+2,i+1:i+3)) + enddo + end +end diff --git a/libgomp/testsuite/libgomp.oacc-fortran/optional-data-copyin-by-value.f90 b/libgomp/testsuite/libgomp.oacc-fortran/optional-data-copyin-by-value.f90 new file mode 100644 index 0000000..5cadeed --- /dev/null +++ b/libgomp/testsuite/libgomp.oacc-fortran/optional-data-copyin-by-value.f90 @@ -0,0 +1,29 @@ +! Test OpenACC data regions with optional arguments passed by value. + +! { dg-do run } + +program test + implicit none + + integer :: res + + if (foo(27) .ne. 27) stop 1 + if (foo(16, 18) .ne. 288) stop 1 +contains + function foo(x, y) + integer, value :: x + integer, value, optional :: y + integer :: res, foo + + !$acc data copyin(x, y) copyout(res) + !$acc parallel + res = x + if (present(y)) then + res = res * y + end if + !$acc end parallel + !$acc end data + + foo = res + end function foo +end program test diff --git a/libgomp/testsuite/libgomp.oacc-fortran/optional-data-copyin.f90 b/libgomp/testsuite/libgomp.oacc-fortran/optional-data-copyin.f90 new file mode 100644 index 0000000..a30908d --- /dev/null +++ b/libgomp/testsuite/libgomp.oacc-fortran/optional-data-copyin.f90 @@ -0,0 +1,140 @@ +! Test OpenACC data regions with a copy-in of optional arguments. + +! { dg-do run } + +program test + implicit none + + integer, parameter :: n = 64 + integer :: i + integer :: a_int, b_int, c_int, res_int + integer :: a_arr(n), b_arr(n), c_arr(n), res_arr(n) + integer, allocatable :: a_alloc(:), b_alloc(:), c_alloc(:), res_alloc(:) + + a_int = 7 + b_int = 3 + c_int = 11 + + call test_int(res_int, a_int) + if (res_int .ne. a_int) stop 1 + + call test_int(res_int, a_int, b_int) + if (res_int .ne. a_int * b_int) stop 2 + + call test_int(res_int, a_int, b_int, c_int) + if (res_int .ne. a_int * b_int + c_int) stop 3 + + do i = 1, n + a_arr(i) = i + b_arr(i) = n - i + 1 + c_arr(i) = i * 3 + end do + + call test_array(res_arr, a_arr) + do i = 1, n + if (res_arr(i) .ne. a_arr(i)) stop 4 + end do + + call test_array(res_arr, a_arr, b_arr) + do i = 1, n + if (res_arr(i) .ne. a_arr(i) * b_arr(i)) stop 5 + end do + + call test_array(res_arr, a_arr, b_arr, c_arr) + do i = 1, n + if (res_arr(i) .ne. a_arr(i) * b_arr(i) + c_arr(i)) stop 6 + end do + + allocate (a_alloc(n)) + allocate (b_alloc(n)) + allocate (c_alloc(n)) + allocate (res_alloc(n)) + + do i = 1, n + a_alloc(i) = i + b_alloc(i) = n - i + 1 + c_alloc(i) = i * 3 + end do + + call test_allocatable(res_alloc, a_alloc) + do i = 1, n + if (res_alloc(i) .ne. a_alloc(i)) stop 7 + end do + + call test_allocatable(res_alloc, a_alloc, b_alloc) + do i = 1, n + if (res_alloc(i) .ne. a_alloc(i) * b_alloc(i)) stop 8 + end do + + call test_allocatable(res_alloc, a_alloc, b_alloc, c_alloc) + do i = 1, n + if (res_alloc(i) .ne. a_alloc(i) * b_alloc(i) + c_alloc(i)) stop 9 + end do + + deallocate (a_alloc) + deallocate (b_alloc) + deallocate (c_alloc) + deallocate (res_alloc) +contains + subroutine test_int(res, a, b, c) + integer :: res + integer :: a + integer, optional :: b, c + + !$acc data copyin(a, b, c) copyout(res) + !$acc parallel + res = a + + if (present(b)) res = res * b + + if (present(c)) res = res + c + !$acc end parallel + !$acc end data + end subroutine test_int + + subroutine test_array(res, a, b, c) + integer :: res(n) + integer :: a(n) + integer, optional :: b(n), c(n) + + !$acc data copyin(a, b, c) copyout(res) + !$acc parallel loop + do i = 1, n + res(i) = a(i) + end do + + !$acc parallel loop + do i = 1, n + if (present(b)) res(i) = res(i) * b(i) + end do + + !$acc parallel loop + do i = 1, n + if (present(c)) res(i) = res(i) + c(i) + end do + !$acc end data + end subroutine test_array + + subroutine test_allocatable(res, a, b, c) + integer, allocatable :: res(:) + integer, allocatable :: a(:) + integer, allocatable, optional :: b(:), c(:) + + !$acc data copyin(a, b, c) copyout(res) + !$acc parallel loop + do i = 1, n + res(i) = a(i) + end do + + !$acc parallel loop + do i = 1, n + if (present(b)) res(i) = res(i) * b(i) + end do + + !$acc parallel loop + do i = 1, n + if (present(c)) res(i) = res(i) + c(i) + end do + !$acc end data + end subroutine test_allocatable +end program test diff --git a/libgomp/testsuite/libgomp.oacc-fortran/optional-data-copyout.f90 b/libgomp/testsuite/libgomp.oacc-fortran/optional-data-copyout.f90 new file mode 100644 index 0000000..feaa31f --- /dev/null +++ b/libgomp/testsuite/libgomp.oacc-fortran/optional-data-copyout.f90 @@ -0,0 +1,96 @@ +! Test OpenACC data regions with a copy-out of optional arguments. + +! { dg-do run } + +program test + implicit none + + integer, parameter :: n = 64 + integer :: i + integer :: a_int, b_int, res_int + integer :: a_arr(n), b_arr(n), res_arr(n) + integer, allocatable :: a_alloc(:), b_alloc(:), res_alloc(:) + + res_int = 0 + + call test_int(a_int, b_int) + if (res_int .ne. 0) stop 1 + + call test_int(a_int, b_int, res_int) + if (res_int .ne. a_int * b_int) stop 2 + + res_arr(:) = 0 + do i = 1, n + a_arr(i) = i + b_arr(i) = n - i + 1 + end do + + call test_array(a_arr, b_arr) + do i = 1, n + if (res_arr(i) .ne. 0) stop 3 + end do + + call test_array(a_arr, b_arr, res_arr) + do i = 1, n + if (res_arr(i) .ne. a_arr(i) * b_arr(i)) stop 4 + end do + + allocate (a_alloc(n)) + allocate (b_alloc(n)) + allocate (res_alloc(n)) + + res_alloc(:) = 0 + do i = 1, n + a_alloc(i) = i + b_alloc(i) = n - i + 1 + end do + + call test_allocatable(a_alloc, b_alloc) + do i = 1, n + if (res_alloc(i) .ne. 0) stop 5 + end do + + call test_allocatable(a_alloc, b_alloc, res_alloc) + do i = 1, n + if (res_alloc(i) .ne. a_alloc(i) * b_alloc(i)) stop 6 + end do + + deallocate (a_alloc) + deallocate (b_alloc) + deallocate (res_alloc) +contains + subroutine test_int(a, b, res) + integer :: a, b + integer, optional :: res + + !$acc data copyin(a, b) copyout(res) + !$acc parallel + if (present(res)) res = a * b + !$acc end parallel + !$acc end data + end subroutine test_int + + subroutine test_array(a, b, res) + integer :: a(n), b(n) + integer, optional :: res(n) + + !$acc data copyin(a, b) copyout(res) + !$acc parallel loop + do i = 1, n + if (present(res)) res(i) = a(i) * b(i) + end do + !$acc end data + end subroutine test_array + + subroutine test_allocatable(a, b, res) + integer, allocatable :: a(:), b(:) + integer, allocatable, optional :: res(:) + + !$acc data copyin(a, b) copyout(res) + !$acc parallel loop + do i = 1, n + if (present(res)) res(i) = a(i) * b(i) + end do + !$acc end data + end subroutine test_allocatable +end program test diff --git a/libgomp/testsuite/libgomp.oacc-fortran/optional-data-enter-exit.f90 b/libgomp/testsuite/libgomp.oacc-fortran/optional-data-enter-exit.f90 new file mode 100644 index 0000000..9ed0f75 --- /dev/null +++ b/libgomp/testsuite/libgomp.oacc-fortran/optional-data-enter-exit.f90 @@ -0,0 +1,91 @@ +! Test OpenACC unstructured enter data/exit data regions with optional +! arguments. + +! { dg-do run } + +program test + implicit none + + integer, parameter :: n = 64 + integer :: a(n), b(n), c(n), res(n) + integer :: x, y, z, r, i + + do i = 1, n + a(i) = i + b(i) = n - i + 1 + c(i) = i * 3 + end do + + res = test_array(a) + do i = 1, n + if (res(i) .ne. a(i)) stop 1 + end do + + res = test_array(a, b) + do i = 1, n + if (res(i) .ne. a(i) * b(i)) stop 2 + end do + + res = test_array(a, b, c) + do i = 1, n + if (res(i) .ne. a(i) * b(i) + c(i)) stop 3 + end do + + x = 7 + y = 3 + z = 11 + + r = test_int(x) + if (r .ne. x) stop 4 + + r = test_int(x, y) + if (r .ne. x * y) stop 5 + + r = test_int(x, y, z) + if (r .ne. x * y + z) stop 6 +contains + function test_array(a, b, c) + integer :: a(n) + integer, optional :: b(n), c(n) + integer :: test_array(n), res(n) + + !$acc enter data copyin(a, b, c) create(res) + !$acc parallel loop + do i = 1, n + res(i) = a(i) + end do + + !$acc parallel loop + do i = 1, n + if (present(b)) then + res(i) = res(i) * b(i) + end if + end do + + !$acc parallel loop + do i = 1, n + if (present(c)) then + res(i) = res(i) + c(i) + end if + end do + !$acc exit data copyout(res) delete(a, b, c) + + test_array = res + end function test_array + + function test_int(a, b, c) + integer :: a + integer, optional :: b, c + integer :: test_int, res + + !$acc enter data copyin(a, b, c) create(res) + !$acc parallel present(a, b, c, res) + res = a + if (present(b)) res = res * b + if (present(c)) res = res + c + !$acc end parallel + !$acc exit data copyout(res) delete(a, b, c) + + test_int = res + end function test_int +end program test diff --git a/libgomp/testsuite/libgomp.oacc-fortran/optional-declare.f90 b/libgomp/testsuite/libgomp.oacc-fortran/optional-declare.f90 new file mode 100644 index 0000000..074e5a2 --- /dev/null +++ b/libgomp/testsuite/libgomp.oacc-fortran/optional-declare.f90 @@ -0,0 +1,87 @@ +! Test OpenACC declare directives with optional arguments. + +! { dg-do run } + +program test + implicit none + + integer, parameter :: n = 64 + integer :: i + integer :: a_int, b_int, c_int, res_int + integer :: a_arr(n), b_arr(n), c_arr(n), res_arr(n) + + a_int = 7 + b_int = 3 + c_int = 11 + + call test_int(res_int, a_int) + if (res_int .ne. a_int) stop 1 + + call test_int(res_int, a_int, b_int) + if (res_int .ne. a_int * b_int) stop 2 + + call test_int(res_int, a_int, b_int, c_int) + if (res_int .ne. a_int * b_int + c_int) stop 3 + + do i = 1, n + a_arr(i) = i + b_arr(i) = n - i + 1 + c_arr(i) = i * 3 + end do + + call test_array(res_arr, a_arr) + do i = 1, n + if (res_arr(i) .ne. a_arr(i)) stop 4 + end do + + call test_array(res_arr, a_arr, b_arr) + do i = 1, n + if (res_arr(i) .ne. a_arr(i) * b_arr(i)) stop 5 + end do + + call test_array(res_arr, a_arr, b_arr, c_arr) + do i = 1, n + if (res_arr(i) .ne. a_arr(i) * b_arr(i) + c_arr(i)) stop 6 + end do +contains + subroutine test_int(res, a, b, c) + integer :: a + integer, optional :: b, c + !$acc declare present_or_copyin(a, b, c) + integer :: res + !$acc declare present_or_copyout(res) + + !$acc parallel + res = a + if (present(b)) res = res * b + if (present(c)) res = res + c + !$acc end parallel + end subroutine test_int + + subroutine test_array(res, a, b, c) + integer :: a(n) + integer, optional :: b(n), c(n) + !$acc declare present_or_copyin(a, b, c) + integer :: res(n) + !$acc declare present_or_copyout(res) + + !$acc parallel loop + do i = 1, n + res(i) = a(i) + end do + + !$acc parallel loop + do i = 1, n + if (present(b)) then + res(i) = res(i) * b(i) + end if + end do + + !$acc parallel loop + do i = 1, n + if (present(c)) then + res(i) = res(i) + c(i) + end if + end do + end subroutine test_array +end program test diff --git a/libgomp/testsuite/libgomp.oacc-fortran/optional-firstprivate.f90 b/libgomp/testsuite/libgomp.oacc-fortran/optional-firstprivate.f90 new file mode 100644 index 0000000..693e611 --- /dev/null +++ b/libgomp/testsuite/libgomp.oacc-fortran/optional-firstprivate.f90 @@ -0,0 +1,112 @@ +! Test that optional arguments work in firstprivate clauses. The effect of +! non-present arguments in firstprivate clauses is undefined, and is not +! tested for. + +! { dg-do run } + +program test_firstprivate + implicit none + integer, parameter :: n = 64 + + integer :: i, j + integer :: a_int, b_int, c_int, res_int + integer :: a_arr(n), b_arr(n), c_arr(n), res_arr(n) + integer, allocatable :: a_alloc(:), b_alloc(:), c_alloc(:), res_alloc(:) + + a_int = 14 + b_int = 5 + c_int = 12 + + call test_int(res_int, a_int, b_int, c_int) + if (res_int .ne. a_int * b_int + c_int) stop 1 + + do i = 1, n + a_arr(i) = i + b_arr(i) = n - i + 1 + c_arr(i) = i * 3 + end do + + call test_array(res_arr, a_arr, b_arr, c_arr) + do i = 1, n + if (res_arr(i) .ne. a_arr(i) * b_arr(i) + c_arr(i)) stop 2 + end do + + allocate(a_alloc(n)) + allocate(b_alloc(n)) + allocate(c_alloc(n)) + allocate(res_alloc(n)) + + do i = 1, n + a_arr(i) = i + b_arr(i) = n - i + 1 + c_arr(i) = i * 3 + end do + + call test_allocatable(res_alloc, a_alloc, b_alloc, c_alloc) + do i = 1, n + if (res_alloc(i) .ne. a_alloc(i) * b_alloc(i) + c_alloc(i)) stop 2 + end do + + deallocate(a_alloc) + deallocate(b_alloc) + deallocate(c_alloc) + deallocate(res_alloc) +contains + subroutine test_int(res, a, b, c) + integer :: a + integer, optional :: b, c + integer :: res + + !$acc parallel firstprivate(a, b, c) copyout(res) + res = a + if (present(b)) res = res * b + if (present(c)) res = res + c + !$acc end parallel + end subroutine test_int + + subroutine test_array(res, a, b, c) + integer :: a(n) + integer, optional :: b(n), c(n) + integer :: res(n) + + !$acc data copyin(a, b, c) copyout(res) + !$acc parallel loop firstprivate(a) + do i = 1, n + res(i) = a(i) + end do + + !$acc parallel loop firstprivate(b) + do i = 1, n + if (present(b)) res(i) = res(i) * b(i) + end do + + !$acc parallel loop firstprivate(c) + do i = 1, n + if (present(c)) res(i) = res(i) + c(i) + end do + !$acc end data + end subroutine test_array + + subroutine test_allocatable(res, a, b, c) + integer, allocatable :: a(:) + integer, allocatable, optional :: b(:), c(:) + integer, allocatable :: res(:) + + !$acc data copyin(a, b, c) copyout(res) + !$acc parallel loop firstprivate(a) + do i = 1, n + res(i) = a(i) + end do + + !$acc parallel loop firstprivate(b) + do i = 1, n + if (present(b)) res(i) = res(i) * b(i) + end do + + !$acc parallel loop firstprivate(c) + do i = 1, n + if (present(c)) res(i) = res(i) + c(i) + end do + !$acc end data + end subroutine test_allocatable +end program test_firstprivate diff --git a/libgomp/testsuite/libgomp.oacc-fortran/optional-host_data.f90 b/libgomp/testsuite/libgomp.oacc-fortran/optional-host_data.f90 new file mode 100644 index 0000000..a6e41e2 --- /dev/null +++ b/libgomp/testsuite/libgomp.oacc-fortran/optional-host_data.f90 @@ -0,0 +1,39 @@ +! Test the host_data construct with optional arguments. +! Based on host_data-1.f90. + +! { dg-do run } +! { dg-additional-options "-cpp" } + +program test + implicit none + + integer, target :: i + integer, pointer :: ip, iph + + ! Assign the same targets + ip => i + iph => i + + call foo(iph) + call foo(iph, ip) +contains + subroutine foo(iph, ip) + integer, pointer :: iph + integer, pointer, optional :: ip + + !$acc data copyin(i) + !$acc host_data use_device(ip) + + ! Test how the pointers compare inside a host_data construct + if (present(ip)) then +#if ACC_MEM_SHARED + if (.not. associated(ip, iph)) STOP 1 +#else + if (associated(ip, iph)) STOP 2 +#endif + end if + + !$acc end host_data + !$acc end data + end subroutine foo +end program test diff --git a/libgomp/testsuite/libgomp.oacc-fortran/optional-nested-calls.f90 b/libgomp/testsuite/libgomp.oacc-fortran/optional-nested-calls.f90 new file mode 100644 index 0000000..279139f --- /dev/null +++ b/libgomp/testsuite/libgomp.oacc-fortran/optional-nested-calls.f90 @@ -0,0 +1,135 @@ +! Test propagation of optional arguments from within an OpenACC parallel region. + +! { dg-do run } + +program test + implicit none + + integer, parameter :: n = 64 + integer :: i + integer :: res_int + integer :: a_arr(n), b_arr(n), res_arr(n) + integer, allocatable :: a_alloc(:), b_alloc(:), res_alloc(:) + + call test_int_caller(res_int, 5) + if (res_int .ne. 10) stop 1 + + call test_int_caller(res_int, 2, 3) + if (res_int .ne. 11) stop 2 + + do i = 1, n + a_arr(i) = i + b_arr(i) = n - i + 1 + end do + + call test_array_caller(res_arr, a_arr) + do i = 1, n + if (res_arr(i) .ne. 2 * a_arr(i)) stop 3 + end do + + call test_array_caller(res_arr, a_arr, b_arr) + do i = 1, n + if (res_arr(i) .ne. a_arr(i) * b_arr(i) + a_arr(i) + b_arr(i)) stop 4 + end do + + allocate(a_alloc(n)) + allocate(b_alloc(n)) + allocate(res_alloc(n)) + + do i = 1, n + a_alloc(i) = i + b_alloc(i) = n - i + 1 + end do + + call test_array_caller(res_arr, a_arr) + do i = 1, n + if (res_arr(i) .ne. 2 * a_alloc(i)) stop 5 + end do + + call test_array_caller(res_arr, a_arr, b_arr) + do i = 1, n + if (res_arr(i) .ne. a_arr(i) * b_alloc(i) + a_alloc(i) + b_alloc(i)) stop 6 + end do + + deallocate(a_alloc) + deallocate(b_alloc) + deallocate(res_alloc) +contains + subroutine test_int_caller(res, a, b) + integer :: res, a + integer, optional :: b + + !$acc data copyin(a, b) copyout (res) + !$acc parallel + res = a + if (present(b)) res = res * b + call test_int_callee(res, a, b) + !$acc end parallel + !$acc end data + end subroutine test_int_caller + + subroutine test_int_callee(res, a, b) + !$acc routine seq + integer :: res, a + integer, optional :: b + + res = res + a + if (present(b)) res = res + b + end subroutine test_int_callee + + subroutine test_array_caller(res, a, b) + integer :: res(n), a(n), i + integer, optional :: b(n) + + !$acc data copyin(a, b) copyout(res) + !$acc parallel + !$acc loop seq + do i = 1, n + res(i) = a(i) + if (present(b)) res(i) = res(i) * b(i) + end do + call test_array_callee(res, a, b) + !$acc end parallel + !$acc end data + end subroutine test_array_caller + + subroutine test_array_callee(res, a, b) + !$acc routine seq + integer :: res(n), a(n), i + integer, optional :: b(n) + + do i = 1, n + res(i) = res(i) + a(i) + if (present(b)) res(i) = res(i) + b(i) + end do + end subroutine test_array_callee + + subroutine test_allocatable_caller(res, a, b) + integer :: i + integer, allocatable :: res(:), a(:) + integer, allocatable, optional :: b(:) + + !$acc data copyin(a, b) copyout(res) + !$acc parallel + !$acc loop seq + do i = 1, n + res(i) = a(i) + if (present(b)) res(i) = res(i) * b(i) + end do + call test_array_callee(res, a, b) + !$acc end parallel + !$acc end data + end subroutine test_allocatable_caller + + subroutine test_allocatable_callee(res, a, b) + !$acc routine seq + integer :: i + integer, allocatable :: res(:), a(:) + integer, allocatable, optional :: b(:) + + do i = 1, n + res(i) = res(i) + a(i) + if (present(b)) res(i) = res(i) + b(i) + end do + end subroutine test_allocatable_callee +end program test diff --git a/libgomp/testsuite/libgomp.oacc-fortran/optional-private.f90 b/libgomp/testsuite/libgomp.oacc-fortran/optional-private.f90 new file mode 100644 index 0000000..0320bbb --- /dev/null +++ b/libgomp/testsuite/libgomp.oacc-fortran/optional-private.f90 @@ -0,0 +1,115 @@ +! Test that optional arguments work in private clauses. The effect of +! non-present arguments in private clauses is undefined, and is not tested +! for. The tests are based on those in private-variables.f90. + +! { dg-do run } + +program main + implicit none + + type vec3 + integer x, y, z, attr(13) + end type vec3 + integer :: x + type(vec3) :: pt + integer :: arr(2) + + call t1(x) + call t2(pt) + call t3(arr) +contains + + ! Test of gang-private variables declared on loop directive. + + subroutine t1(x) + integer, optional :: x + integer :: i, arr(32) + + do i = 1, 32 + arr(i) = i + end do + + !$acc parallel copy(arr) num_gangs(32) num_workers(8) vector_length(32) + !$acc loop gang private(x) + do i = 1, 32 + x = i * 2; + arr(i) = arr(i) + x + end do + !$acc end parallel + + do i = 1, 32 + if (arr(i) .ne. i * 3) STOP 1 + end do + end subroutine t1 + + + ! Test of gang-private addressable variable declared on loop directive, with + ! broadcasting to partitioned workers. + + subroutine t2(pt) + integer i, j, arr(0:32*32) + type(vec3), optional :: pt + + do i = 0, 32*32-1 + arr(i) = i + end do + + !$acc parallel copy(arr) num_gangs(32) num_workers(8) vector_length(32) + !$acc loop gang private(pt) + do i = 0, 31 + pt%x = i + pt%y = i * 2 + pt%z = i * 4 + pt%attr(5) = i * 6 + + !$acc loop vector + do j = 0, 31 + arr(i * 32 + j) = arr(i * 32 + j) + pt%x + pt%y + pt%z + pt%attr(5); + end do + end do + !$acc end parallel + + do i = 0, 32 * 32 - 1 + if (arr(i) .ne. i + (i / 32) * 13) STOP 2 + end do + end subroutine t2 + + ! Test of vector-private variables declared on loop directive. Array type. + + subroutine t3(pt) + integer, optional :: pt(2) + integer :: i, j, k, idx, arr(0:32*32*32) + + do i = 0, 32*32*32-1 + arr(i) = i + end do + + !$acc parallel copy(arr) num_gangs(32) num_workers(8) vector_length(32) + !$acc loop gang + do i = 0, 31 + !$acc loop worker + do j = 0, 31 + !$acc loop vector private(pt) + do k = 0, 31 + pt(1) = ieor(i, j * 3) + pt(2) = ior(i, j * 5) + arr(i * 1024 + j * 32 + k) = arr(i * 1024 + j * 32 + k) + pt(1) * k + arr(i * 1024 + j * 32 + k) = arr(i * 1024 + j * 32 + k) + pt(2) * k + end do + end do + end do + !$acc end parallel + + do i = 0, 32 - 1 + do j = 0, 32 -1 + do k = 0, 32 - 1 + idx = i * 1024 + j * 32 + k + if (arr(idx) .ne. idx + ieor(i, j * 3) * k + ior(i, j * 5) * k) then + STOP 3 + end if + end do + end do + end do + end subroutine t3 + +end program main diff --git a/libgomp/testsuite/libgomp.oacc-fortran/optional-reduction.f90 b/libgomp/testsuite/libgomp.oacc-fortran/optional-reduction.f90 new file mode 100644 index 0000000..b76db3e --- /dev/null +++ b/libgomp/testsuite/libgomp.oacc-fortran/optional-reduction.f90 @@ -0,0 +1,69 @@ +! Test optional arguments in reduction clauses. The effect of +! non-present arguments in reduction clauses is undefined, and is not tested +! for. The tests are based on those in reduction-1.f90. + +! { dg-do run } +! { dg-additional-options "-w" } + +program optional_reduction + implicit none + + integer :: rg, rw, rv, rc + + rg = 0 + rw = 0 + rv = 0 + rc = 0 + + call do_test(rg, rw, rv, rc) +contains + subroutine do_test(rg, rw, rv, rc) + integer, parameter :: n = 10, ng = 8, nw = 4, vl = 32 + integer, optional :: rg, rw, rv, rc + integer :: i, vresult + integer, dimension (n) :: array + + vresult = 0 + do i = 1, n + array(i) = i + end do + + !$acc parallel num_gangs(ng) copy(rg) + !$acc loop reduction(+:rg) gang + do i = 1, n + rg = rg + array(i) + end do + !$acc end parallel + + !$acc parallel num_workers(nw) copy(rw) + !$acc loop reduction(+:rw) worker + do i = 1, n + rw = rw + array(i) + end do + !$acc end parallel + + !$acc parallel vector_length(vl) copy(rv) + !$acc loop reduction(+:rv) vector + do i = 1, n + rv = rv + array(i) + end do + !$acc end parallel + + !$acc parallel num_gangs(ng) num_workers(nw) vector_length(vl) copy(rc) + !$acc loop reduction(+:rc) gang worker vector + do i = 1, n + rc = rc + array(i) + end do + !$acc end parallel + + ! Verify the results + do i = 1, n + vresult = vresult + array(i) + end do + + if (rg .ne. vresult) STOP 1 + if (rw .ne. vresult) STOP 2 + if (rv .ne. vresult) STOP 3 + if (rc .ne. vresult) STOP 4 + end subroutine do_test +end program optional_reduction diff --git a/libgomp/testsuite/libgomp.oacc-fortran/optional-update-device.f90 b/libgomp/testsuite/libgomp.oacc-fortran/optional-update-device.f90 new file mode 100644 index 0000000..57f6900 --- /dev/null +++ b/libgomp/testsuite/libgomp.oacc-fortran/optional-update-device.f90 @@ -0,0 +1,121 @@ +! Test OpenACC update to device with an optional argument. + +! { dg-do run } + +program optional_update_device + implicit none + + integer, parameter :: n = 64 + integer :: i + integer :: a_int, b_int, res_int + integer :: a_arr(n), b_arr(n), res_arr(n) + integer, allocatable :: a_alloc(:), b_alloc(:), res_alloc(:) + + a_int = 5 + b_int = 11 + + call test_int(res_int, a_int) + if (res_int .ne. a_int) stop 1 + + call test_int(res_int, a_int, b_int) + if (res_int .ne. a_int * b_int) stop 2 + + res_arr(:) = 0 + do i = 1, n + a_arr(i) = i + b_arr(i) = n - i + 1 + end do + + call test_array(res_arr, a_arr) + do i = 1, n + if (res_arr(i) .ne. a_arr(i)) stop 3 + end do + + call test_array(res_arr, a_arr, b_arr) + do i = 1, n + if (res_arr(i) .ne. a_arr(i) * b_arr(i)) stop 4 + end do + + allocate (a_alloc(n)) + allocate (b_alloc(n)) + allocate (res_alloc(n)) + + res_alloc(:) = 0 + do i = 1, n + a_alloc(i) = i + b_alloc(i) = n - i + 1 + end do + + call test_allocatable(res_alloc, a_alloc) + do i = 1, n + if (res_alloc(i) .ne. a_alloc(i)) stop 5 + end do + + call test_allocatable(res_alloc, a_alloc, b_alloc) + do i = 1, n + if (res_alloc(i) .ne. a_alloc(i) * b_alloc(i)) stop 6 + end do + + deallocate (a_alloc) + deallocate (b_alloc) + deallocate (res_alloc) +contains + subroutine test_int(res, a, b) + integer :: res + integer :: a + integer, optional :: b + + !$acc data create(a, b, res) + !$acc update device(a, b) + !$acc parallel + res = a + if (present(b)) res = res * b + !$acc end parallel + !$acc update self(res) + !$acc end data + end subroutine test_int + + subroutine test_array(res, a, b) + integer :: res(n) + integer :: a(n) + integer, optional :: b(n) + + !$acc data create(a, b, res) + !$acc update device(a, b) + !$acc parallel loop + do i = 1, n + res(i) = a(i) + end do + + !$acc parallel loop + do i = 1, n + if (present(b)) then + res(i) = res(i) * b(i) + end if + end do + !$acc update self(res) + !$acc end data + end subroutine test_array + + subroutine test_allocatable(res, a, b) + integer, allocatable :: res(:) + integer, allocatable :: a(:) + integer, allocatable, optional :: b(:) + + !$acc data create(a, b, res) + !$acc update device(a, b) + !$acc parallel loop + do i = 1, n + res(i) = a(i) + end do + + !$acc parallel loop + do i = 1, n + if (present(b)) then + res(i) = res(i) * b(i) + end if + end do + !$acc update self(res) + !$acc end data + end subroutine test_allocatable +end program optional_update_device diff --git a/libgomp/testsuite/libgomp.oacc-fortran/optional-update-host.f90 b/libgomp/testsuite/libgomp.oacc-fortran/optional-update-host.f90 new file mode 100644 index 0000000..0f3a903 --- /dev/null +++ b/libgomp/testsuite/libgomp.oacc-fortran/optional-update-host.f90 @@ -0,0 +1,115 @@ +! Test OpenACC update to host with an optional argument. + +! { dg-do run } + +program optional_update_host + implicit none + + integer, parameter :: n = 64 + integer :: i + integer :: a_int, b_int, res_int + integer :: a_arr(n), b_arr(n), res_arr(n) + integer, allocatable :: a_alloc(:), b_alloc(:), res_alloc(:) + + a_int = 5 + b_int = 11 + res_int = 0 + + call test_int(a_int, b_int) + if (res_int .ne. 0) stop 1 + + call test_int(a_int, b_int, res_int) + if (res_int .ne. a_int * b_int) stop 2 + + res_arr(:) = 0 + do i = 1, n + a_arr(i) = i + b_arr(i) = n - i + 1 + end do + + call test_array(a_arr, b_arr) + do i = 1, n + if (res_arr(i) .ne. 0) stop 1 + end do + + call test_array(a_arr, b_arr, res_arr) + do i = 1, n + if (res_arr(i) .ne. a_arr(i) * b_arr(i)) stop 2 + end do + + allocate(a_alloc(n)) + allocate(b_alloc(n)) + allocate(res_alloc(n)) + + res_alloc(:) = 0 + do i = 1, n + a_alloc(i) = i + b_alloc(i) = n - i + 1 + end do + + call test_allocatable(a_alloc, b_alloc) + do i = 1, n + if (res_alloc(i) .ne. 0) stop 1 + end do + + call test_allocatable(a_alloc, b_alloc, res_alloc) + do i = 1, n + if (res_alloc(i) .ne. a_alloc(i) * b_alloc(i)) stop 2 + end do + + deallocate(a_alloc) + deallocate(b_alloc) + deallocate(res_alloc) +contains + subroutine test_int(a, b, res) + integer :: a, b + integer, optional :: res + + !$acc data create(a, b, res) + !$acc update device(a, b) + !$acc parallel + if (present(res)) res = a + if (present(res)) res = res * b + !$acc end parallel + !$acc update self(res) + !$acc end data + end subroutine test_int + + subroutine test_array(a, b, res) + integer :: a(n), b(n) + integer, optional :: res(n) + + !$acc data create(a, b, res) + !$acc update device(a, b) + !$acc parallel loop + do i = 1, n + if (present(res)) res(i) = a(i) + end do + + !$acc parallel loop + do i = 1, n + if (present(res)) res(i) = res(i) * b(i) + end do + !$acc update self(res) + !$acc end data + end subroutine test_array + + subroutine test_allocatable(a, b, res) + integer, allocatable :: a(:), b(:) + integer, allocatable, optional :: res(:) + + !$acc data create(a, b, res) + !$acc update device(a, b) + !$acc parallel loop + do i = 1, n + if (present(res)) res(i) = a(i) + end do + + !$acc parallel loop + do i = 1, n + if (present(res)) res(i) = res(i) * b(i) + end do + !$acc update self(res) + !$acc end data + end subroutine test_allocatable +end program optional_update_host