From patchwork Fri Jul 12 11:35:05 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: 1131323 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-504994-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="DaB2nhpl"; 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 45lW876k4bz9sBF for ; Fri, 12 Jul 2019 21:35:50 +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=TzeKtdrnqTnc4g0ezwy5BeS/YhqGAo6foqdYrotEHDiw6n3XcPeXV oXTfk2pypUbk+oEZuBpbS8fS3i7jkMJH9Su5skEoQTIvaHwN7PGc7UPRZXis1wVQ HvpTS9Kd0sIXD0iQ7Pi34IIvpkhPJYJGZJhvsNQFbqPPhP/E4afgg0= 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=02k1MEHe4+Nh3fbCrDX26YwSZus=; b=DaB2nhplVe0BoWIHUnrhkrJaKDn3 qLVvYzyvAeqkG36uzNx0oRG0A270D3Ifjea+SDngG1yZfIeQmWdL1Ul+P+PKh2E7 r+gR9Kac+ZpmfRYkj7spffsJSTNqXo6STAko1ypCYGt3w/tT3Wyc8TP8+094kkyr Zh6FMSLktjlPfnk= Received: (qmail 117995 invoked by alias); 12 Jul 2019 11:35:39 -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 117970 invoked by uid 89); 12 Jul 2019 11:35:38 -0000 Authentication-Results: sourceware.org; auth=none X-Spam-SWARE-Status: No, score=-15.4 required=5.0 tests=AWL, BAYES_00, GIT_PATCH_0, GIT_PATCH_1, GIT_PATCH_2, GIT_PATCH_3, RCVD_IN_DNSWL_NONE, SPF_PASS autolearn=ham version=3.3.1 spammy=H*i:sk:6aaaeec, H*f:sk:6aaaeec 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:35:28 +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 1hltpn-0005Us-99 from Kwok_Yeung@mentor.com ; Fri, 12 Jul 2019 04:35:27 -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:35:23 +0100 Subject: [PATCH 1/5, OpenACC] Allow NULL as an argument to OpenACC 2.6 directives From: Kwok Cheung Yeung To: , , CC: References: <6aaaeec8-9c6d-9293-5b6c-622d9fcf2664@codesourcery.com> Message-ID: Date: Fri, 12 Jul 2019 12:35:05 +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> Fortran pass-by-reference optional arguments behave much like normal Fortran arguments when lowered to GENERIC/GIMPLE, except they can be null (representing a non-present argument). Some parts of libgomp (those dealing with updating mappings) currently do not expect to take a null address and fail. These need to be changed to deal with the null appropriately, by turning the operation into a no-op (as you never need to update a non-present argument). libgomp/ * oacc-mem.c (update_dev_host): Return early if the host address is NULL. (gomp_acc_insert_pointer): Likewise. * testsuite/libgomp.oacc-c-c++-common/lib-43.c: Remove. * testsuite/libgomp.oacc-c-c++-common/lib-47.c: Likewise. --- libgomp/oacc-mem.c | 9 ++++ .../testsuite/libgomp.oacc-c-c++-common/lib-43.c | 51 ---------------------- .../testsuite/libgomp.oacc-c-c++-common/lib-47.c | 49 --------------------- 3 files changed, 9 insertions(+), 100 deletions(-) delete mode 100644 libgomp/testsuite/libgomp.oacc-c-c++-common/lib-43.c delete mode 100644 libgomp/testsuite/libgomp.oacc-c-c++-common/lib-47.c diff --git a/libgomp/oacc-mem.c b/libgomp/oacc-mem.c index 2f27100..8cc5120 100644 --- a/libgomp/oacc-mem.c +++ b/libgomp/oacc-mem.c @@ -831,6 +831,12 @@ update_dev_host (int is_dev, void *h, size_t s, int async) if (acc_dev->capabilities & GOMP_OFFLOAD_CAP_SHARED_MEM) return; + /* Fortran optional arguments that are non-present result in a + null host address here. This can safely be ignored as it is + not possible to 'update' a non-present optional argument. */ + if (h == NULL) + return; + acc_prof_info prof_info; acc_api_info api_info; bool profiling_p = GOACC_PROFILING_SETUP_P (thr, &prof_info, &api_info); @@ -901,6 +907,9 @@ gomp_acc_insert_pointer (size_t mapnum, void **hostaddrs, size_t *sizes, struct goacc_thread *thr = goacc_thread (); struct gomp_device_descr *acc_dev = thr->dev; + if (*hostaddrs == NULL) + return; + if (acc_is_present (*hostaddrs, *sizes)) { splay_tree_key n; diff --git a/libgomp/testsuite/libgomp.oacc-c-c++-common/lib-43.c b/libgomp/testsuite/libgomp.oacc-c-c++-common/lib-43.c deleted file mode 100644 index 5db2912..0000000 --- a/libgomp/testsuite/libgomp.oacc-c-c++-common/lib-43.c +++ /dev/null @@ -1,51 +0,0 @@ -/* Exercise acc_update_device with a NULL data address on nvidia targets. */ - -/* { dg-do run { target openacc_nvidia_accel_selected } } */ - -#include -#include -#include - -int -main (int argc, char **argv) -{ - const int N = 256; - int i; - unsigned char *h; - void *d; - - h = (unsigned char *) malloc (N); - - for (i = 0; i < N; i++) - { - h[i] = i; - } - - d = acc_copyin (h, N); - if (!d) - abort (); - - for (i = 0; i < N; i++) - { - h[i] = 0xab; - } - - fprintf (stderr, "CheCKpOInT\n"); - acc_update_device (0, N); - - acc_copyout (h, N); - - for (i = 0; i < N; i++) - { - if (h[i] != 0xab) - abort (); - } - - free (h); - - return 0; -} - -/* { dg-output "CheCKpOInT(\n|\r\n|\r).*" } */ -/* { dg-output "\\\[\[^\n\r]*,256\\\] is not mapped" } */ -/* { dg-shouldfail "" } */ diff --git a/libgomp/testsuite/libgomp.oacc-c-c++-common/lib-47.c b/libgomp/testsuite/libgomp.oacc-c-c++-common/lib-47.c deleted file mode 100644 index c214042..0000000 --- a/libgomp/testsuite/libgomp.oacc-c-c++-common/lib-47.c +++ /dev/null @@ -1,49 +0,0 @@ -/* Exercise acc_update_self with a NULL data mapping on nvidia targets. */ - -/* { dg-do run { target openacc_nvidia_accel_selected } } */ - -#include -#include -#include -#include - -int -main (int argc, char **argv) -{ - const int N = 256; - int i; - unsigned char *h; - void *d; - - h = (unsigned char *) malloc (N); - - for (i = 0; i < N; i++) - { - h[i] = i; - } - - d = acc_copyin (h, N); - if (!d) - abort (); - - memset (&h[0], 0, N); - - fprintf (stderr, "CheCKpOInT\n"); - acc_update_self (0, N); - - for (i = 0; i < N; i++) - { - if (h[i] != i) - abort (); - } - - acc_delete (h, N); - - free (h); - - return 0; -} - -/* { dg-output "CheCKpOInT(\n|\r\n|\r).*" } */ -/* { dg-output "\\\[\[^\n\r]*,256\\\] is not mapped" } */ -/* { dg-shouldfail "" } */ From patchwork Fri Jul 12 11:36:13 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: 1131324 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-504995-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="X7DNGU7O"; 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 45lW9L2wfPz9sBF for ; Fri, 12 Jul 2019 21:36:54 +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=tTEnx65F8VwxSrOxrlwRtvNKkgC29NmJ3Ya0JId7MjTG9MLG8D2p1 7IeeBLUiZj14F3JI4jxZQgm7jAGU1VE/t3qSyG1RyHKjUGs/AwjrZeJHnXFIKfjH CkNEDaMOdDx04/cJd8q8LMOfSu91PCXxz3T7zkHAL8AHF+xqpbP0u0= 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=rCyrsWzhcdaA5X396zQ1pP9O8WE=; b=X7DNGU7OggQ9K4HXIoxIdmtHKg4n 9thkIgH0Lv9tLab1kQ0mbem++nWJCQyTEEMdwvXo9Dfu/WwLvU2GjuiJU0uDP88Z qh56I8+j5V/08CIKiQwSONKwR2xl27Pw2jmWZ2VK+PEllhsLb+qYfal0iV5Sxbs4 PLy+ZQaLjYPxJgA= Received: (qmail 120331 invoked by alias); 12 Jul 2019 11:36:46 -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 120314 invoked by uid 89); 12 Jul 2019 11:36:46 -0000 Authentication-Results: sourceware.org; auth=none X-Spam-SWARE-Status: No, score=-15.8 required=5.0 tests=AWL, BAYES_00, GIT_PATCH_0, GIT_PATCH_1, GIT_PATCH_2, GIT_PATCH_3, RCVD_IN_DNSWL_NONE, SPF_PASS autolearn=ham version=3.3.1 spammy= 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:36:36 +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 1hltqs-0005bD-Rl from Kwok_Yeung@mentor.com ; Fri, 12 Jul 2019 04:36:34 -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:36:31 +0100 Subject: [PATCH 2/5, OpenACC] Support Fortran optional arguments in the firstprivate clause From: Kwok Cheung Yeung To: , , CC: References: <6aaaeec8-9c6d-9293-5b6c-622d9fcf2664@codesourcery.com> Message-ID: Date: Fri, 12 Jul 2019 12:36:13 +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> Reference types used by Fortran often need to be treated specially in the OACC lowering to deal with the referenced object as well as the reference itself. However, as optional arguments can be null, they are pointer types rather than reference types, so the code to detect these situations needs to be updated. gcc/ * omp-general.c (omp_is_optional_argument): New. * omp-general.h (omp_is_optional_argument): New. * omp-low.c (lower_omp_target): Use size of referenced object when optional argument used as argument to firstprivate. Create temporary for received value and take the address for new_var if the original variable was an optional argument. --- gcc/omp-general.c | 14 ++++++++++++++ gcc/omp-general.h | 1 + gcc/omp-low.c | 8 +++++--- 3 files changed, 20 insertions(+), 3 deletions(-) value. */ @@ -11461,7 +11462,8 @@ lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx) { gcc_checking_assert (is_gimple_omp_oacc (ctx->stmt)); s = TREE_TYPE (ovar); - if (TREE_CODE (s) == REFERENCE_TYPE) + if (TREE_CODE (s) == REFERENCE_TYPE + || omp_is_optional_argument (ovar)) s = TREE_TYPE (s); s = TYPE_SIZE_UNIT (s); } diff --git a/gcc/omp-general.c b/gcc/omp-general.c index 8086f9a..e5173b8 100644 --- a/gcc/omp-general.c +++ b/gcc/omp-general.c @@ -48,6 +48,20 @@ omp_find_clause (tree clauses, enum omp_clause_code kind) return NULL_TREE; } +/* Return true if DECL is a Fortran optional argument. */ + +bool +omp_is_optional_argument (tree decl) +{ + /* A passed-by-reference Fortran optional argument is similar to + a normal argument, but since it can be null the type is a + POINTER_TYPE rather than a REFERENCE_TYPE. */ + return lang_GNU_Fortran () + && TREE_CODE (decl) == PARM_DECL + && DECL_BY_REFERENCE (decl) + && TREE_CODE (TREE_TYPE (decl)) == POINTER_TYPE; +} + /* Return true if DECL is a reference type. */ bool diff --git a/gcc/omp-general.h b/gcc/omp-general.h index 80d42af..bbaa7b1 100644 --- a/gcc/omp-general.h +++ b/gcc/omp-general.h @@ -73,6 +73,7 @@ struct omp_for_data #define OACC_FN_ATTRIB "oacc function" extern tree omp_find_clause (tree clauses, enum omp_clause_code kind); +extern bool omp_is_optional_argument (tree decl); extern bool omp_is_reference (tree decl); extern void omp_adjust_for_condition (location_t loc, enum tree_code *cond_code, tree *n2, tree v, tree step); diff --git a/gcc/omp-low.c b/gcc/omp-low.c index a855c5b..625df1e 100644 --- a/gcc/omp-low.c +++ b/gcc/omp-low.c @@ -11172,8 +11172,9 @@ lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx) if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_FIRSTPRIVATE) { gcc_assert (is_gimple_omp_oacc (ctx->stmt)); - if (omp_is_reference (new_var) - && TREE_CODE (TREE_TYPE (new_var)) != POINTER_TYPE) + if ((omp_is_reference (new_var) + && TREE_CODE (TREE_TYPE (new_var)) != POINTER_TYPE) + || omp_is_optional_argument (var)) { /* Create a local object to hold the instance From patchwork Fri Jul 12 11:37:11 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: 1131325 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-504996-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="azdUCQOz"; 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 45lWBf0jy4z9sBF for ; Fri, 12 Jul 2019 21:38:01 +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=pDkxjMq9dP42wopuzC3cHcLfi94V/sJbplCtCIG1yW73P2Nhwanje ESULhq0dDQxEOsFNjYUNemh/YdXggDD5xc2o1ax6Mc1cX4Zw/XmnATY+3NGUhDWi hlv1NLe8kpskbSF+yn8qRpVq7dLKCatxLr9GU6pMVKDwNY0NRUvGpM= 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=wsdLIQVyptToso7oBWQoOX6RMmM=; b=azdUCQOz7CL4dfxyulyXqJUBAvGr mhaa4vwlBbhJXZY6rh/DvD4GO0TNMFFfPAExQRcxUqTRtJRnoowf12/PyGxkgBlZ kHiA3ttf5/6ulDKKiZQnuH+AI8Dq2SkbXdApoPWwAI4hl8IGu/YR4eciG/j+Up9E l7H9K85El3On7/g= Received: (qmail 126387 invoked by alias); 12 Jul 2019 11:37:50 -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 126371 invoked by uid 89); 12 Jul 2019 11:37:50 -0000 Authentication-Results: sourceware.org; auth=none X-Spam-SWARE-Status: No, score=-16.1 required=5.0 tests=AWL, BAYES_00, GIT_PATCH_0, GIT_PATCH_1, GIT_PATCH_2, GIT_PATCH_3, RCVD_IN_DNSWL_NONE autolearn=ham version=3.3.1 spammy=sk:GOMP_MA, sk:gfc_con, transopenmpc, sk:gfc_tra 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:37:35 +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 1hltrp-0005hh-9x from Kwok_Yeung@mentor.com ; Fri, 12 Jul 2019 04:37:33 -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:37:29 +0100 Subject: [PATCH 3/5, OpenACC] Add support for allocatable arrays as optional arguments From: Kwok Cheung Yeung To: , , CC: References: <6aaaeec8-9c6d-9293-5b6c-622d9fcf2664@codesourcery.com> Message-ID: <195d49b5-806e-cadb-c634-b1edd6daa643@codesourcery.com> Date: Fri, 12 Jul 2019 12:37:11 +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 patch allows allocatable arrays passed as Fortran optional arguments to be used in OpenACC. The GIMPLE code generated by the current lowering unconditionally attempts to access fields within the structure representing the array, resulting in a null dereference if the array is non-present. This patch generates extra code to test if the argument is null. If so, it sets the size of the array contents to zero, and the pointers to data to null. This avoids the null dereferences, prevents libgomp from trying to copy non-existant data, and preserves the null pointer used by PRESENT to detect non-present arguments. gcc/fortran/ * trans-openmp.c (gfc_build_conditional_assign): New. (gfc_build_conditional_assign_expr): New. (gfc_omp_finish_clause): Add conditionals to set the clause declaration to null and size to zero if the declaration is a non-present optional argument. (gfc_trans_omp_clauses): Likewise. --- gcc/fortran/trans-openmp.c | 164 ++++++++++++++++++++++++++++++++++++++------- 1 file changed, 138 insertions(+), 26 deletions(-) ptr = build_fold_indirect_ref (ptr); @@ -2190,34 +2306,30 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, /* We have to check for n->sym->attr.dimension because of scalar coarrays. */ - if (n->sym->attr.pointer && n->sym->attr.dimension) + if ((n->sym->attr.pointer || n->sym->attr.optional) + && n->sym->attr.dimension) { stmtblock_t cond_block; tree size = gfc_create_var (gfc_array_index_type, NULL); - tree tem, then_b, else_b, zero, cond; + tree cond = n->sym->attr.optional + ? TREE_OPERAND (decl, 0) + : gfc_conv_descriptor_data_get (decl); gfc_init_block (&cond_block); - tem - = gfc_full_array_size (&cond_block, decl, - GFC_TYPE_ARRAY_RANK (type)); - gfc_add_modify (&cond_block, size, tem); - then_b = gfc_finish_block (&cond_block); - gfc_init_block (&cond_block); - zero = build_int_cst (gfc_array_index_type, 0); - gfc_add_modify (&cond_block, size, zero); - else_b = gfc_finish_block (&cond_block); - tem = gfc_conv_descriptor_data_get (decl); - tem = fold_convert (pvoid_type_node, tem); - cond = fold_build2_loc (input_location, NE_EXPR, - logical_type_node, - tem, null_pointer_node); - gfc_add_expr_to_block (block, - build3_loc (input_location, - COND_EXPR, - void_type_node, - cond, then_b, - else_b)); + gfc_add_modify (&cond_block, size, + gfc_full_array_size ( + &cond_block, decl, + GFC_TYPE_ARRAY_RANK (type))); + tree then_b = gfc_finish_block (&cond_block); + + gfc_build_conditional_assign ( + block, + size, + cond, + then_b, + build_int_cst (gfc_array_index_type, 0)); + OMP_CLAUSE_SIZE (node) = size; } else if (n->sym->attr.dimension) diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c index 8eae7bc..8bfeeeb 100644 --- a/gcc/fortran/trans-openmp.c +++ b/gcc/fortran/trans-openmp.c @@ -1067,6 +1067,62 @@ gfc_omp_clause_dtor (tree clause, tree decl) return tem; } +/* Build a conditional expression in BLOCK. If COND_VAL is not + null, then the block THEN_B is executed, otherwise ELSE_VAL + is assigned to VAL. */ + +static void +gfc_build_conditional_assign (stmtblock_t *block, + tree val, + tree cond_val, + tree then_b, + tree else_val) +{ + stmtblock_t cond_block; + tree cond, else_b; + tree val_ty = TREE_TYPE (val); + + gfc_init_block (&cond_block); + gfc_add_modify (&cond_block, val, fold_convert (val_ty, else_val)); + else_b = gfc_finish_block (&cond_block); + cond = fold_convert (pvoid_type_node, cond_val); + cond = fold_build2_loc (input_location, NE_EXPR, + logical_type_node, + cond, null_pointer_node); + gfc_add_expr_to_block (block, + build3_loc (input_location, + COND_EXPR, + void_type_node, + cond, then_b, + else_b)); +} + +/* Build a conditional expression in BLOCK, returning a temporary + variable containing the result. If COND_VAL is not null, then + THEN_VAL will be assigned to the variable, otherwise ELSE_VAL + is assigned. + */ + +static tree +gfc_build_conditional_assign_expr (stmtblock_t *block, + tree cond_val, + tree then_val, + tree else_val) +{ + tree val; + tree val_ty = TREE_TYPE (then_val); + stmtblock_t cond_block; + + val = create_tmp_var (val_ty); + + gfc_init_block (&cond_block); + gfc_add_modify (&cond_block, val, then_val); + tree then_b = gfc_finish_block (&cond_block); + + gfc_build_conditional_assign (block, val, cond_val, then_b, else_val); + + return val; +} void gfc_omp_finish_clause (tree c, gimple_seq *pre_p) @@ -1124,17 +1180,46 @@ gfc_omp_finish_clause (tree c, gimple_seq *pre_p) stmtblock_t block; gfc_start_block (&block); tree type = TREE_TYPE (decl); - tree ptr = gfc_conv_descriptor_data_get (decl); + bool optional_arg_p = + TREE_CODE (decl) == INDIRECT_REF + && TREE_CODE (TREE_OPERAND (decl, 0)) == PARM_DECL + && DECL_BY_REFERENCE (TREE_OPERAND (decl, 0)) + && TREE_CODE (TREE_TYPE (TREE_OPERAND (decl, 0))) == POINTER_TYPE; + tree ptr; + + if (optional_arg_p) + ptr = gfc_build_conditional_assign_expr ( + &block, + TREE_OPERAND (decl, 0), + gfc_conv_descriptor_data_get (decl), + null_pointer_node); + else + ptr = gfc_conv_descriptor_data_get (decl); ptr = fold_convert (build_pointer_type (char_type_node), ptr); ptr = build_fold_indirect_ref (ptr); OMP_CLAUSE_DECL (c) = ptr; c2 = build_omp_clause (input_location, OMP_CLAUSE_MAP); OMP_CLAUSE_SET_MAP_KIND (c2, GOMP_MAP_TO_PSET); - OMP_CLAUSE_DECL (c2) = decl; + if (optional_arg_p) + { + ptr = create_tmp_var (TREE_TYPE (TREE_OPERAND (decl, 0))); + gfc_add_modify (&block, ptr, TREE_OPERAND (decl, 0)); + + OMP_CLAUSE_DECL (c2) = build_fold_indirect_ref (ptr); + } + else + OMP_CLAUSE_DECL (c2) = decl; OMP_CLAUSE_SIZE (c2) = TYPE_SIZE_UNIT (type); c3 = build_omp_clause (OMP_CLAUSE_LOCATION (c), OMP_CLAUSE_MAP); OMP_CLAUSE_SET_MAP_KIND (c3, GOMP_MAP_POINTER); - OMP_CLAUSE_DECL (c3) = gfc_conv_descriptor_data_get (decl); + if (optional_arg_p) + OMP_CLAUSE_DECL (c3) = gfc_build_conditional_assign_expr ( + &block, + TREE_OPERAND (decl, 0), + gfc_conv_descriptor_data_get (decl), + null_pointer_node); + else + OMP_CLAUSE_DECL (c3) = gfc_conv_descriptor_data_get (decl); OMP_CLAUSE_SIZE (c3) = size_int (0); tree size = create_tmp_var (gfc_array_index_type); tree elemsz = TYPE_SIZE_UNIT (gfc_get_element_type (type)); @@ -1165,6 +1250,27 @@ gfc_omp_finish_clause (tree c, gimple_seq *pre_p) void_type_node, cond, then_b, else_b)); } + else if (optional_arg_p) + { + stmtblock_t cond_block; + tree then_b; + + gfc_init_block (&cond_block); + gfc_add_modify (&cond_block, size, + gfc_full_array_size (&cond_block, decl, + GFC_TYPE_ARRAY_RANK (type))); + gfc_add_modify (&cond_block, size, + fold_build2 (MULT_EXPR, gfc_array_index_type, + size, elemsz)); + then_b = gfc_finish_block (&cond_block); + + gfc_build_conditional_assign ( + &block, + size, + TREE_OPERAND (decl, 0), + then_b, + build_int_cst (gfc_array_index_type, 0)); + } else { gfc_add_modify (&block, size, @@ -2171,7 +2277,17 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (decl))) { tree type = TREE_TYPE (decl); - tree ptr = gfc_conv_descriptor_data_get (decl); + tree ptr; + + if (n->sym->attr.optional) + ptr = gfc_build_conditional_assign_expr ( + block, + TREE_OPERAND (decl, 0), + gfc_conv_descriptor_data_get (decl), + null_pointer_node); + else + ptr = gfc_conv_descriptor_data_get (decl); + ptr = fold_convert (build_pointer_type (char_type_node), ptr); From patchwork Fri Jul 12 11:38:27 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: 1131326 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-504997-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="ADBtNtK+"; 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 45lWCz6qt1z9sBF for ; Fri, 12 Jul 2019 21:39:11 +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=CB9tMndZGSrko7slj7JbhpSS3+0UqGExV+bE4BoSRmUzmcl5isaH6 3zYjK2CklFDqfY/8UDV7QG2KEYw1adpG/E0t1k+Q1RIhuUAwu04DUeUvlNWdkYNT fLQJJ0KBV9SJLhVH3Tj6UOaWIWvIh9vROewTxQ1oCarqfyaqzFUEpM= 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=p2W7qGGrghuGsGLOnvOaAMGO/Fc=; b=ADBtNtK+zFsdjvh7vL/Ay3cThHbI iIfLGMxBaCXZWX0f2HeFI1n1QkZWaBS+TsmB4Qr91IiAMHL9p4T2StX77rmV9HoC jNinV3ZAuIKnL0QDAbvMZzkeVX5/T75li/InCAjA4gJbJN4E8axZcTqipNrMiiZZ ldR7L4QAMWQxuwc= Received: (qmail 462 invoked by alias); 12 Jul 2019 11:39:00 -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 447 invoked by uid 89); 12 Jul 2019 11:39:00 -0000 Authentication-Results: sourceware.org; auth=none X-Spam-SWARE-Status: No, score=-16.4 required=5.0 tests=AWL, BAYES_00, GIT_PATCH_0, GIT_PATCH_1, GIT_PATCH_2, GIT_PATCH_3, RCVD_IN_DNSWL_NONE, SPF_PASS autolearn=ham version=3.3.1 spammy=sk:UNKNOWN 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:38:50 +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 1hltt2-0005km-Jt from Kwok_Yeung@mentor.com ; Fri, 12 Jul 2019 04:38:48 -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:38:44 +0100 Subject: [PATCH 4/5, OpenACC] Allow optional arguments to be used in the use_device OpenACC clause From: Kwok Cheung Yeung To: , , CC: References: <6aaaeec8-9c6d-9293-5b6c-622d9fcf2664@codesourcery.com> Message-ID: <2c2c6f22-9482-699c-0088-7b00f8969611@codesourcery.com> Date: Fri, 12 Jul 2019 12:38:27 +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 patch fixes a similar situation that occurs with the use_device clause, where the lowering would result in a null dereference if applied to a non-present optional argument. This patch builds a conditional check that skips the dereference if the argument is non-present, and ensures that optional arguments are treated like references. gcc/ * omp-low.c (lower_omp_target): For use_device clauses, generate conditional statements to treat Fortran optional arguments like references if non-null, or propogate null arguments into offloaded code otherwise. --- gcc/omp-low.c | 77 +++++++++++++++++++++++++++++++++++++++++++++++++++++++---- 1 file changed, 73 insertions(+), 4 deletions(-) CONSTRUCTOR_APPEND_ELT (vsize, purpose, s); @@ -11828,11 +11861,43 @@ lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx) { tree type = TREE_TYPE (var); tree new_var = lookup_decl (var, ctx); - if (omp_is_reference (var)) + tree opt_arg_label = NULL_TREE; + + if (omp_is_reference (var) || omp_is_optional_argument (var)) { type = TREE_TYPE (type); if (TREE_CODE (type) != ARRAY_TYPE) { + if (omp_is_optional_argument (var)) + { + tree null_label + = create_artificial_label (UNKNOWN_LOCATION); + tree notnull_label + = create_artificial_label (UNKNOWN_LOCATION); + opt_arg_label + = create_artificial_label (UNKNOWN_LOCATION); + glabel *null_glabel + = gimple_build_label (null_label); + glabel *notnull_glabel + = gimple_build_label (notnull_label); + ggoto *opt_arg_ggoto + = gimple_build_goto (opt_arg_label); + gcond *cond; + + gimplify_expr (&x, &new_body, NULL, is_gimple_val, + fb_rvalue); + cond = gimple_build_cond (EQ_EXPR, x, + null_pointer_node, + null_label, + notnull_label); + gimple_seq_add_stmt (&new_body, cond); + gimple_seq_add_stmt (&new_body, null_glabel); + gimplify_assign (new_var, null_pointer_node, + &new_body); + gimple_seq_add_stmt (&new_body, opt_arg_ggoto); + gimple_seq_add_stmt (&new_body, notnull_glabel); + } + tree v = create_tmp_var_raw (type, get_name (var)); gimple_add_tmp_var (v); TREE_ADDRESSABLE (v) = 1; @@ -11849,6 +11914,10 @@ lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx) gimplify_expr (&x, &new_body, NULL, is_gimple_val, fb_rvalue); gimple_seq_add_stmt (&new_body, gimple_build_assign (new_var, x)); + + if (opt_arg_label != NULL_TREE) + gimple_seq_add_stmt (&new_body, + gimple_build_label (opt_arg_label)); } break; } diff --git a/gcc/omp-low.c b/gcc/omp-low.c index 625df1e..2dfeca5 100644 --- a/gcc/omp-low.c +++ b/gcc/omp-low.c @@ -11635,18 +11635,51 @@ lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx) tkind = GOMP_MAP_FIRSTPRIVATE_INT; type = TREE_TYPE (ovar); if (TREE_CODE (type) == ARRAY_TYPE) - var = build_fold_addr_expr (var); + { + var = build_fold_addr_expr (var); + gimplify_assign (x, var, &ilist); + } else { - if (omp_is_reference (ovar)) + tree opt_arg_label; + bool optional_arg_p = omp_is_optional_argument (ovar); + + if (optional_arg_p) + { + tree null_label + = create_artificial_label (UNKNOWN_LOCATION); + tree notnull_label + = create_artificial_label (UNKNOWN_LOCATION); + opt_arg_label + = create_artificial_label (UNKNOWN_LOCATION); + tree new_x = copy_node (x); + gcond *cond = gimple_build_cond (EQ_EXPR, ovar, + null_pointer_node, + null_label, + notnull_label); + gimple_seq_add_stmt (&ilist, cond); + gimple_seq_add_stmt (&ilist, + gimple_build_label (null_label)); + gimplify_assign (new_x, null_pointer_node, &ilist); + gimple_seq_add_stmt (&ilist, + gimple_build_goto (opt_arg_label)); + gimple_seq_add_stmt (&ilist, + gimple_build_label (notnull_label)); + } + + if (omp_is_reference (ovar) || optional_arg_p) { type = TREE_TYPE (type); if (TREE_CODE (type) != ARRAY_TYPE) var = build_simple_mem_ref (var); var = fold_convert (TREE_TYPE (x), var); } + + gimplify_assign (x, var, &ilist); + if (optional_arg_p) + gimple_seq_add_stmt (&ilist, + gimple_build_label (opt_arg_label)); } - gimplify_assign (x, var, &ilist); s = size_int (0); purpose = size_int (map_idx++); 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