From patchwork Tue Oct 15 21:32:32 2019 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Tobias Burnus X-Patchwork-Id: 1177426 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-511067-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="R/+KVDrx"; 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 46t7vW6mfhz9sP4 for ; Wed, 16 Oct 2019 08:33:09 +1100 (AEDT) DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:from :to:subject:cc:message-id:date:mime-version:content-type; q=dns; s=default; b=qWMxM/6q8zqKnPYPHpxhVbH411YOwGxfTSGAUlunC5OXCAHhSP hvKj6NNBSQsMrcR7Z9QaDR4ySGb2eZzmI2RzXgJcw2+4g9KfQnk17oBaC4Aop/n4 2nMdm7HCeBwJFQyeGnztCJK+L/nSQH+My1cI6LlxPsk9DXe7gyyp1XSMk= 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:from :to:subject:cc:message-id:date:mime-version:content-type; s= default; bh=2Pdp4ocgRnsMMBiS9rz3VzBXyW4=; b=R/+KVDrxdnHP3RfAiDYU NkJVBnf7Hxh/3QXrpDkb6rsCqp7iVTp5SbUsuLuxtKBTXSeXWC1Sdo5Gtq4Iy3Uh RBwL1S3/KNo8SpsiDs88PEQ9o0/bHrm/8irFUEJ16637Krf0cqQnH1uwJlgtFTvi 3ZrTdqoGlVIZdg2VJpB8rG8= Received: (qmail 28762 invoked by alias); 15 Oct 2019 21:32:53 -0000 Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org Received: (qmail 28679 invoked by uid 89); 15 Oct 2019 21:32:53 -0000 Authentication-Results: sourceware.org; auth=none X-Spam-SWARE-Status: No, score=-18.4 required=5.0 tests=AWL, BAYES_00, GARBLED_SUBJECT, GIT_PATCH_0, GIT_PATCH_1, GIT_PATCH_2, GIT_PATCH_3, SPF_PASS autolearn=ham version=3.3.1 spammy=1.9, studied, agrees, Hence X-HELO: esa3.mentor.iphmx.com Received: from esa3.mentor.iphmx.com (HELO esa3.mentor.iphmx.com) (68.232.137.180) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Tue, 15 Oct 2019 21:32:49 +0000 IronPort-SDR: gm8LIVRVy46Sz5wfvWCZuDWdo4VT8zmlyDFK1BrIIUbBC4jgHHQ834QHaf/z1n6vhG4rYpuxhq M4py7d7MUzeoQNBIHDLsK63LUk0rdUEjkM4VPLALcVAwhdwNoesBaWnVOJ7dUWcRP0MADzBTra snsxVjhkACxltSVJw5dL/QksTX7CL2Mw5EI0O7IrTuw4IBfF8t2++mpqEJh4mcq5C0zsVxS3a2 KuDPH2Nl6ecMUPsrcOJmuxL7JKcbNj2oqXI3qRzBrCF9BIhZzTTI1E41lWJQuNDzflsv4nMqLg oIY= Received: from orw-gwy-01-in.mentorg.com ([192.94.38.165]) by esa3.mentor.iphmx.com with ESMTP; 15 Oct 2019 13:32:47 -0800 IronPort-SDR: 9IrghOT+3K2ZOnfiPdmorlbzrMd8dApAbKt/RGCLqsRr2yt4o0eD04IKJ+abRfIMwuSqjZ74LP AbNa8AlvoPUpNZzihaAYAzMnpdEuMg7jeHUHa7geiU9IPO9ysNsLKDSFyRYZNen3BMcYMs/LSz HrKS8yQCofp3aK1ihXng/lHAf8YuFqZXqCyDGWgLahPcz7YboglMEHBuZoVVeNgHIXCXjxrUJq KITAo8V2Ez5ClAgdhBSYSf4/zIraVeQcBNhwwy9OVdPxbdYgnUVbS9L7/az4aPNGpUDU5158dD fkw= From: Tobias Burnus To: gcc-patches , fortran , Thomas Schwinge Subject: =?utf-8?q?=5BPatch=5D=5BFortran=5D_OpenACC_=E2=80=93_permit_comm?= =?utf-8?q?on_blocks_in_some_clauses?= CC: Jakub Jelinek Message-ID: Date: Tue, 15 Oct 2019 23:32:32 +0200 User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:68.0) Gecko/20100101 Thunderbird/68.1.0 MIME-Version: 1.0 X-IsSubscribed: yes This OpenACC-only patch extends the support for /common/ blocks. [In OpenMP (4.0 to 5.0, unchanged) and gfortran, common blocks are supported in copyin/copyprivate, in firstprivate/lastprivate/private/shared, in threadprivate and in declare target.] For OpenACC, gfortran already supports common blocks for device_resident/usedevice/cache/flush/link. This patch adds them (for OpenACC only) to copy/copyin/copyout, create/delete, host, pcopy/pcopy_in/pcopy_out, present_or_copy, present_or_copy_in, present_or_copy_out, present_or_create and self. [Of those, only "copy()" is also an OpenMP clause name.] [Cf. OpenACC 2.7 in 1.9 (for the p* variants) and 2.13; the latter is new since OpenACC 2.0.] I think the Fortran part is obvious, once one agrees on the list of clauses; and OK from a Fortran's maintainer view. gcc/gimplify.c: oacc_default_clause contains some changes; there are additionally two lines which only differ for ORT_ACC – Hence, it is an OpenACC-only change! The ME change is about privatizing common blocks (I haven't studied this part closer.) @Thomas: Please review @Jakub, all: comments and approvals are welcome. Tobias PS: This patch is the rediffed OG9 (alias OG8) patch 0793cef408c9937f4c4e2423dd1f7d6a97b9bed3 by Cesar Philippidis from 2016. (Which was on gomp-4_0-branch as r240165). Due to the wonders of GIT – when not requiring linear history and due to rebasing with GCC9, it is also part of the OG9 commit ac6c90812344f4f4cfe4d2f5901c1a9d038a4000 – which in addition also does some other things like handling OpenACC device pointers. 2019-10-15 Cesar Philippidis Tobias Burnus gcc/fortran/ * openmp.c (gfc_match_omp_map_clause): Add and pass allow_commons argument. (gfc_match_omp_clauses): Update calls to permit common blocks for OpenACC's copy/copyin/copyout, create/delete, host, pcopy/pcopy_in/pcopy_out, present_or_copy, present_or_copy_in, present_or_copy_out, present_or_create and self. gcc/ * gimplify.c (oacc_default_clause): Privatize fortran common blocks. (omp_notice_variable): Defer the expansion of DECL_VALUE_EXPR for common block decls. gcc/testsuite/ * gfortran.dg/goacc/common-block-1.f90: New test. * gfortran.dg/goacc/common-block-2.f90: New test. libgomp/ * testsuite/libgomp.oacc-fortran/common-block-1.f90: New test. * testsuite/libgomp.oacc-fortran/common-block-2.f90: New test. * testsuite/libgomp.oacc-fortran/common-block-3.f90: New test. diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c index 5c91fcdfd31..dbcb647ea6a 100644 --- a/gcc/fortran/openmp.c +++ b/gcc/fortran/openmp.c @@ -926,10 +926,11 @@ omp_inv_mask::omp_inv_mask (const omp_mask &m) : omp_mask (m) mapping. */ static bool -gfc_match_omp_map_clause (gfc_omp_namelist **list, gfc_omp_map_op map_op) +gfc_match_omp_map_clause (gfc_omp_namelist **list, gfc_omp_map_op map_op, + bool allow_common) { gfc_omp_namelist **head = NULL; - if (gfc_match_omp_variable_list ("", list, false, NULL, &head, true) + if (gfc_match_omp_variable_list ("", list, allow_common, NULL, &head, true) == MATCH_YES) { gfc_omp_namelist *n; @@ -1051,7 +1052,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, if ((mask & OMP_CLAUSE_COPY) && gfc_match ("copy ( ") == MATCH_YES && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP], - OMP_MAP_TOFROM)) + OMP_MAP_TOFROM, openacc)) continue; if (mask & OMP_CLAUSE_COPYIN) { @@ -1059,7 +1060,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, { if (gfc_match ("copyin ( ") == MATCH_YES && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP], - OMP_MAP_TO)) + OMP_MAP_TO, true)) continue; } else if (gfc_match_omp_variable_list ("copyin (", @@ -1070,7 +1071,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, if ((mask & OMP_CLAUSE_COPYOUT) && gfc_match ("copyout ( ") == MATCH_YES && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP], - OMP_MAP_FROM)) + OMP_MAP_FROM, true)) continue; if ((mask & OMP_CLAUSE_COPYPRIVATE) && gfc_match_omp_variable_list ("copyprivate (", @@ -1080,7 +1081,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, if ((mask & OMP_CLAUSE_CREATE) && gfc_match ("create ( ") == MATCH_YES && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP], - OMP_MAP_ALLOC)) + OMP_MAP_ALLOC, true)) continue; break; case 'd': @@ -1116,7 +1117,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, if ((mask & OMP_CLAUSE_DELETE) && gfc_match ("delete ( ") == MATCH_YES && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP], - OMP_MAP_RELEASE)) + OMP_MAP_RELEASE, true)) continue; if ((mask & OMP_CLAUSE_DEPEND) && gfc_match ("depend ( ") == MATCH_YES) @@ -1168,12 +1169,12 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, && openacc && gfc_match ("device ( ") == MATCH_YES && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP], - OMP_MAP_FORCE_TO)) + OMP_MAP_FORCE_TO, true)) continue; if ((mask & OMP_CLAUSE_DEVICEPTR) && gfc_match ("deviceptr ( ") == MATCH_YES && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP], - OMP_MAP_FORCE_DEVICEPTR)) + OMP_MAP_FORCE_DEVICEPTR, false)) continue; if ((mask & OMP_CLAUSE_DEVICE_RESIDENT) && gfc_match_omp_variable_list @@ -1251,7 +1252,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, if ((mask & OMP_CLAUSE_HOST_SELF) && gfc_match ("host ( ") == MATCH_YES && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP], - OMP_MAP_FORCE_FROM)) + OMP_MAP_FORCE_FROM, true)) continue; break; case 'i': @@ -1523,47 +1524,47 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, if ((mask & OMP_CLAUSE_COPY) && gfc_match ("pcopy ( ") == MATCH_YES && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP], - OMP_MAP_TOFROM)) + OMP_MAP_TOFROM, true)) continue; if ((mask & OMP_CLAUSE_COPYIN) && gfc_match ("pcopyin ( ") == MATCH_YES && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP], - OMP_MAP_TO)) + OMP_MAP_TO, true)) continue; if ((mask & OMP_CLAUSE_COPYOUT) && gfc_match ("pcopyout ( ") == MATCH_YES && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP], - OMP_MAP_FROM)) + OMP_MAP_FROM, true)) continue; if ((mask & OMP_CLAUSE_CREATE) && gfc_match ("pcreate ( ") == MATCH_YES && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP], - OMP_MAP_ALLOC)) + OMP_MAP_ALLOC, true)) continue; if ((mask & OMP_CLAUSE_PRESENT) && gfc_match ("present ( ") == MATCH_YES && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP], - OMP_MAP_FORCE_PRESENT)) + OMP_MAP_FORCE_PRESENT, false)) continue; if ((mask & OMP_CLAUSE_COPY) && gfc_match ("present_or_copy ( ") == MATCH_YES && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP], - OMP_MAP_TOFROM)) + OMP_MAP_TOFROM, true)) continue; if ((mask & OMP_CLAUSE_COPYIN) && gfc_match ("present_or_copyin ( ") == MATCH_YES && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP], - OMP_MAP_TO)) + OMP_MAP_TO, true)) continue; if ((mask & OMP_CLAUSE_COPYOUT) && gfc_match ("present_or_copyout ( ") == MATCH_YES && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP], - OMP_MAP_FROM)) + OMP_MAP_FROM, true)) continue; if ((mask & OMP_CLAUSE_CREATE) && gfc_match ("present_or_create ( ") == MATCH_YES && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP], - OMP_MAP_ALLOC)) + OMP_MAP_ALLOC, true)) continue; if ((mask & OMP_CLAUSE_PRIORITY) && c->priority == NULL @@ -1781,7 +1782,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, if ((mask & OMP_CLAUSE_HOST_SELF) && gfc_match ("self ( ") == MATCH_YES && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP], - OMP_MAP_FORCE_FROM)) + OMP_MAP_FORCE_FROM, true)) continue; if ((mask & OMP_CLAUSE_SEQ) && !c->seq diff --git a/gcc/gimplify.c b/gcc/gimplify.c index 836706961f3..258b756ef70 100644 --- a/gcc/gimplify.c +++ b/gcc/gimplify.c @@ -7218,15 +7218,20 @@ oacc_default_clause (struct gimplify_omp_ctx *ctx, tree decl, unsigned flags) { const char *rkind; bool on_device = false; + bool is_private = false; bool declared = is_oacc_declared (decl); tree type = TREE_TYPE (decl); if (lang_hooks.decls.omp_privatize_by_reference (decl)) type = TREE_TYPE (type); + if (RECORD_OR_UNION_TYPE_P (type)) + is_private = lang_hooks.decls.omp_disregard_value_expr (decl, false); + if ((ctx->region_type & (ORT_ACC_PARALLEL | ORT_ACC_KERNELS)) != 0 && is_global_var (decl) - && device_resident_p (decl)) + && device_resident_p (decl) + && !is_private) { on_device = true; flags |= GOVD_MAP_TO_ONLY; @@ -7237,7 +7242,9 @@ oacc_default_clause (struct gimplify_omp_ctx *ctx, tree decl, unsigned flags) case ORT_ACC_KERNELS: rkind = "kernels"; - if (AGGREGATE_TYPE_P (type)) + if (is_private) + flags |= GOVD_MAP; + else if (AGGREGATE_TYPE_P (type)) { /* Aggregates default to 'present_or_copy', or 'present'. */ if (ctx->default_kind != OMP_CLAUSE_DEFAULT_PRESENT) @@ -7254,7 +7261,9 @@ oacc_default_clause (struct gimplify_omp_ctx *ctx, tree decl, unsigned flags) case ORT_ACC_PARALLEL: rkind = "parallel"; - if (on_device || declared) + if (is_private) + flags |= GOVD_FIRSTPRIVATE; + else if (on_device || declared) flags |= GOVD_MAP; else if (AGGREGATE_TYPE_P (type)) { @@ -7320,7 +7329,8 @@ omp_notice_variable (struct gimplify_omp_ctx *ctx, tree decl, bool in_code) { tree value = get_base_address (DECL_VALUE_EXPR (decl)); - if (value && DECL_P (value) && DECL_THREAD_LOCAL_P (value)) + if (!(ctx->region_type & ORT_ACC) + && value && DECL_P (value) && DECL_THREAD_LOCAL_P (value)) return omp_notice_threadprivate_variable (ctx, decl, value); } @@ -7352,7 +7362,8 @@ omp_notice_variable (struct gimplify_omp_ctx *ctx, tree decl, bool in_code) n = splay_tree_lookup (ctx->variables, (splay_tree_key)decl); if ((ctx->region_type & ORT_TARGET) != 0) { - ret = lang_hooks.decls.omp_disregard_value_expr (decl, true); + shared = !(ctx->region_type & ORT_ACC); + ret = lang_hooks.decls.omp_disregard_value_expr (decl, shared); if (n == NULL) { unsigned nflags = flags; @@ -7520,6 +7531,8 @@ omp_notice_variable (struct gimplify_omp_ctx *ctx, tree decl, bool in_code) } shared = ((flags | n->value) & GOVD_SHARED) != 0; + if (ctx->region_type & ORT_ACC) + shared = false; ret = lang_hooks.decls.omp_disregard_value_expr (decl, shared); /* If nothing changed, there's nothing left to do. */ diff --git a/gcc/testsuite/gfortran.dg/goacc/common-block-1.f90 b/gcc/testsuite/gfortran.dg/goacc/common-block-1.f90 new file mode 100644 index 00000000000..1cbbb49d638 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/goacc/common-block-1.f90 @@ -0,0 +1,69 @@ +! Test data clauses involving common blocks and common block data. +! Specifically, validates early matching errors. + +subroutine subtest + implicit none + integer, parameter :: n = 10 + integer a(n), b(n), c, d(n), e + real*4 x(n), y(n), z, w(n), v + common /blockA/ a, c, x + common /blockB/ b, y, z + !$acc declare link(/blockA/, /blockB/, e, v) +end subroutine subtest + +program test + implicit none + integer, parameter :: n = 10 + integer a(n), b(n), c, d(n), e + real*4 x(n), y(n), z, w(n), v + common /blockA/ a, c, x + common /blockB/ b, y, z + !$acc declare link(/blockA/, /blockB/, e, v) + + !$acc data copy(/blockA/, /blockB/, e, v) + !$acc end data + + !$acc data copyin(/blockA/, /blockB/, e, v) + !$acc end data + + !$acc data copyout(/blockA/, /blockB/, e, v) + !$acc end data + + !$acc data create(/blockA/, /blockB/, e, v) + !$acc end data + + !$acc data copyout(/blockA/, /blockB/, e, v) + !$acc end data + + !$acc data pcopy(/blockA/, /blockB/, e, v) + !$acc end data + + !$acc data pcopyin(/blockA/, /blockB/, e, v) + !$acc end data + + !$acc data pcopyout(/blockA/, /blockB/, e, v) + !$acc end data + + !$acc data pcreate(/blockA/, /blockB/, e, v) + !$acc end data + + !$acc data pcopyout(/blockA/, /blockB/, e, v) + !$acc end data + + !$acc data present(/blockA/, /blockB/, e, v) ! { dg-error "Syntax error in OpenMP variable list" } + !$acc end data ! { dg-error "Unexpected ..ACC END DATA statement" } + + !$acc parallel private(/blockA/, /blockB/, e, v) + !$acc end parallel + + !$acc parallel firstprivate(/blockA/, /blockB/, e, v) + !$acc end parallel + + !$acc exit data delete(/blockA/, /blockB/, e, v) + + !$acc data deviceptr(/blockA/, /blockB/, e, v) ! { dg-error "Syntax error in OpenMP variable list" } + !$acc end data ! { dg-error "Unexpected ..ACC END DATA statement" } + + !$acc data deviceptr(/blockA/, /blockB/, e, v) ! { dg-error "Syntax error in OpenMP variable list" } + !$acc end data ! { dg-error "Unexpected ..ACC END DATA statement" } +end program test diff --git a/gcc/testsuite/gfortran.dg/goacc/common-block-2.f90 b/gcc/testsuite/gfortran.dg/goacc/common-block-2.f90 new file mode 100644 index 00000000000..b83638918a3 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/goacc/common-block-2.f90 @@ -0,0 +1,49 @@ +! Test data clauses involving common blocks and common block data. +! Specifically, resolver errors such as duplicate data clauses. + +program test + implicit none + integer, parameter :: n = 10 + integer a(n), b(n), c, d(n), e + real*4 x(n), y(n), z, w(n), v + common /blockA/ a, c, x + common /blockB/ b, y, z + + !$acc data copy(/blockA/, /blockB/, e, v, a) ! { dg-error "Symbol .a. present on multiple clauses" } + !$acc end data + + !$acc data copyin(/blockA/, /blockB/, e, v, a) ! { dg-error "Symbol .a. present on multiple clauses" } + !$acc end data + + !$acc data copyout(/blockA/, /blockB/, e, v, a) ! { dg-error "Symbol .a. present on multiple clauses" } + !$acc end data + + !$acc data create(/blockA/, /blockB/, e, v, a) ! { dg-error "Symbol .a. present on multiple clauses" } + !$acc end data + + !$acc data copyout(/blockA/, /blockB/, e, v, a) ! { dg-error "Symbol .a. present on multiple clauses" } + !$acc end data + + !$acc data pcopy(/blockA/, /blockB/, e, v, a) ! { dg-error "Symbol .a. present on multiple clauses" } + !$acc end data + + !$acc data pcopyin(/blockA/, /blockB/, e, v, a) ! { dg-error "Symbol .a. present on multiple clauses" } + !$acc end data + + !$acc data pcopyout(/blockA/, /blockB/, e, v, a) ! { dg-error "Symbol .a. present on multiple clauses" } + !$acc end data + + !$acc data pcreate(/blockA/, /blockB/, e, v, a) ! { dg-error "Symbol .a. present on multiple clauses" } + !$acc end data + + !$acc data pcopyout(/blockA/, /blockB/, e, v, a) ! { dg-error "Symbol .a. present on multiple clauses" } + !$acc end data + + !$acc parallel private(/blockA/, /blockB/, e, v, a) ! { dg-error "Symbol .a. present on multiple clauses" } + !$acc end parallel + + !$acc parallel firstprivate(/blockA/, /blockB/, e, v, a) ! { dg-error "Symbol .a. present on multiple clauses" } + !$acc end parallel + + !$acc exit data delete(/blockA/, /blockB/, e, v, a) ! { dg-error "Symbol .a. present on multiple clauses" } +end program test diff --git a/libgomp/testsuite/libgomp.oacc-fortran/common-block-1.f90 b/libgomp/testsuite/libgomp.oacc-fortran/common-block-1.f90 new file mode 100644 index 00000000000..a17a33536f3 --- /dev/null +++ b/libgomp/testsuite/libgomp.oacc-fortran/common-block-1.f90 @@ -0,0 +1,105 @@ +! Test data located inside common blocks. This test does not exercise +! ACC DECLARE. + +module const + integer, parameter :: n = 100 +end module const + +subroutine check + use const + + implicit none + integer i, x(n), y + common /BLOCK/ x, y + + do i = 1, n + if (x(i) .ne. y) call abort + end do +end subroutine check + +module m + use const + integer a(n), b + common /BLOCK/ a, b + +contains + subroutine mod_implicit_incr + implicit none + integer i + + !$acc parallel loop + do i = 1, n + a(i) = b + end do + !$acc end parallel loop + + call check + end subroutine mod_implicit_incr + + subroutine mod_explicit_incr + implicit none + integer i + + !$acc parallel loop copy(a(1:n)) copyin(b) + do i = 1, n + a(i) = b + end do + !$acc end parallel loop + + call check + end subroutine mod_explicit_incr +end module m + +subroutine sub_implicit_incr + use const + + implicit none + integer i, x(n), y + common /BLOCK/ x, y + + !$acc parallel loop + do i = 1, n + x(i) = y + end do + !$acc end parallel loop + + call check +end subroutine sub_implicit_incr + +subroutine sub_explicit_incr + use const + + implicit none + integer i, x(n), y + common /BLOCK/ x, y + + !$acc parallel loop copy(x(1:n)) copyin(y) + do i = 1, n + x(i) = y + end do + !$acc end parallel loop + + call check +end subroutine sub_explicit_incr + +program main + use m + + implicit none + + a(:) = -1 + b = 5 + call mod_implicit_incr + + a(:) = -2 + b = 6 + call mod_explicit_incr + + a(:) = -3 + b = 7 + call sub_implicit_incr + + a(:) = -4 + b = 8 + call sub_explicit_incr +end program main diff --git a/libgomp/testsuite/libgomp.oacc-fortran/common-block-2.f90 b/libgomp/testsuite/libgomp.oacc-fortran/common-block-2.f90 new file mode 100644 index 00000000000..e27a225a024 --- /dev/null +++ b/libgomp/testsuite/libgomp.oacc-fortran/common-block-2.f90 @@ -0,0 +1,150 @@ +! Test data located inside common blocks. This test does not exercise +! ACC DECLARE. All data clauses are explicit. + +module consts + integer, parameter :: n = 100 +end module consts + +subroutine validate + use consts + + implicit none + integer i, j + real*4 x(n), y(n), z + common /BLOCK/ x, y, z, j + + do i = 1, n + if (abs(x(i) - i - z) .ge. 0.0001) call abort + end do +end subroutine validate + +subroutine incr + use consts + + implicit none + integer i, j + real*4 x(n), y(n), z + common /BLOCK/ x, y, z, j + + !$acc parallel loop pcopy(/BLOCK/) + do i = 1, n + x(i) = x(i) + z + end do + !$acc end parallel loop +end subroutine incr + +program main + use consts + + implicit none + integer i, j + real*4 a(n), b(n), c + common /BLOCK/ a, b, c, j + + ! Test copyout, pcopy, device + + !$acc data copyout(a, c) + + c = 1.0 + + !$acc update device(c) + + !$acc parallel loop pcopy(a) + do i = 1, n + a(i) = i + end do + !$acc end parallel loop + + call incr + call incr + call incr + !$acc end data + + c = 3.0 + call validate + + ! Test pcopy without copyout + + c = 2.0 + call incr + c = 5.0 + call validate + + ! Test create, delete, host, copyout, copyin + + !$acc enter data create(b) + + !$acc parallel loop pcopy(b) + do i = 1, n + b(i) = i + end do + !$acc end parallel loop + + !$acc update host (b) + + !$acc parallel loop pcopy(b) copyout(a) copyin(c) + do i = 1, n + a(i) = b(i) + c + end do + !$acc end parallel loop + + !$acc exit data delete(b) + + call validate + + a(:) = b(:) + c = 0.0 + call validate + + ! Test copy + + c = 1.0 + !$acc parallel loop copy(/BLOCK/) + do i = 1, n + a(i) = b(i) + c + end do + !$acc end parallel loop + + call validate + + ! Test pcopyin, pcopyout FIXME + + c = 2.0 + !$acc data copyin(b, c) copyout(a) + + !$acc parallel loop pcopyin(b, c) pcopyout(a) + do i = 1, n + a(i) = b(i) + c + end do + !$acc end parallel loop + + !$acc end data + + call validate + + ! Test reduction, private + + j = 0 + + !$acc parallel private(i) copy(j) + !$acc loop reduction(+:j) + do i = 1, n + j = j + 1 + end do + !$acc end parallel + + if (j .ne. n) call abort + + ! Test firstprivate, copy + + a(:) = 0 + c = j + + !$acc parallel loop firstprivate(c) copyout(a) + do i = 1, n + a(i) = i + c + end do + !$acc end parallel loop + + call validate +end program main diff --git a/libgomp/testsuite/libgomp.oacc-fortran/common-block-3.f90 b/libgomp/testsuite/libgomp.oacc-fortran/common-block-3.f90 new file mode 100644 index 00000000000..90448d2da72 --- /dev/null +++ b/libgomp/testsuite/libgomp.oacc-fortran/common-block-3.f90 @@ -0,0 +1,137 @@ +! Test data located inside common blocks. This test does not exercise +! ACC DECLARE. Most of the data clauses are implicit. + +module consts + integer, parameter :: n = 100 +end module consts + +subroutine validate + use consts + + implicit none + integer i, j + real*4 x(n), y(n), z + common /BLOCK/ x, y, z, j + + do i = 1, n + if (abs(x(i) - i - z) .ge. 0.0001) call abort + end do +end subroutine validate + +subroutine incr_parallel + use consts + + implicit none + integer i, j + real*4 x(n), y(n), z + common /BLOCK/ x, y, z, j + + !$acc parallel loop + do i = 1, n + x(i) = x(i) + z + end do + !$acc end parallel loop +end subroutine incr_parallel + +subroutine incr_kernels + use consts + + implicit none + integer i, j + real*4 x(n), y(n), z + common /BLOCK/ x, y, z, j + + !$acc kernels + do i = 1, n + x(i) = x(i) + z + end do + !$acc end kernels +end subroutine incr_kernels + +program main + use consts + + implicit none + integer i, j + real*4 a(n), b(n), c + common /BLOCK/ a, b, c, j + + !$acc data copyout(a, c) + + c = 1.0 + + !$acc update device(c) + + !$acc parallel loop + do i = 1, n + a(i) = i + end do + !$acc end parallel loop + + call incr_parallel + call incr_parallel + call incr_parallel + !$acc end data + + c = 3.0 + call validate + + ! Test pcopy without copyout + + c = 2.0 + call incr_kernels + c = 5.0 + call validate + + !$acc kernels + do i = 1, n + b(i) = i + end do + !$acc end kernels + + !$acc parallel loop + do i = 1, n + a(i) = b(i) + c + end do + !$acc end parallel loop + + call validate + + a(:) = b(:) + c = 0.0 + call validate + + ! Test copy + + c = 1.0 + !$acc parallel loop + do i = 1, n + a(i) = b(i) + c + end do + !$acc end parallel loop + + call validate + + c = 2.0 + !$acc data copyin(b, c) copyout(a) + + !$acc kernels + do i = 1, n + a(i) = b(i) + c + end do + !$acc end kernels + + !$acc end data + + call validate + + j = 0 + + !$acc parallel loop reduction(+:j) + do i = 1, n + j = j + 1 + end do + !$acc end parallel loop + + if (j .ne. n) call abort +end program main