From patchwork Thu Apr 23 06:52:39 2020 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Tobias Burnus X-Patchwork-Id: 1275603 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Authentication-Results: ozlabs.org; spf=pass (sender SPF authorized) smtp.mailfrom=gcc.gnu.org (client-ip=2620:52:3:1:0:246e:9693:128c; helo=sourceware.org; envelope-from=gcc-patches-bounces@gcc.gnu.org; receiver=) Authentication-Results: ozlabs.org; dmarc=none (p=none dis=none) header.from=codesourcery.com Received: from sourceware.org (server2.sourceware.org [IPv6:2620:52:3:1:0:246e:9693:128c]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits) key-exchange X25519 server-signature RSA-PSS (4096 bits) server-digest SHA256) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id 4977Kv6xyYz9sSM for ; Thu, 23 Apr 2020 16:53:05 +1000 (AEST) Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 5437D3851C24; Thu, 23 Apr 2020 06:52:56 +0000 (GMT) X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from esa3.mentor.iphmx.com (esa3.mentor.iphmx.com [68.232.137.180]) by sourceware.org (Postfix) with ESMTPS id 48988385DC0B; Thu, 23 Apr 2020 06:52:52 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.3.2 sourceware.org 48988385DC0B Authentication-Results: sourceware.org; dmarc=none (p=none dis=none) header.from=codesourcery.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=Tobias_Burnus@mentor.com IronPort-SDR: PTZDn3QP1fBE7RXFc2P6xC2EIY8demTEDpMzNrI5CmX2IueOGzWy5q96qV35dVWXxz140Oc3FA M1hY+7vo7mMld980IUoIrcyWczUTgVaNo4cLQfl/SwqlV8tbFs/N6UDNOnfu0E+SUsE2NJhUoy YGQ9QLWOHbZ4cNNR5gBJ4W0Q+txVqLAtiBeLO/HbT9U7qKYBgV698yCVsgslZmozpfLfRVUrYC vCYkqaMJsR5aM8wvOb5oPjMjQypm+RN1ztX/gfPcp49kwT0wpKwKc7ICATkoXkLfLXu8HynO1v Wog= X-IronPort-AV: E=Sophos;i="5.73,306,1583222400"; d="diff'?scan'208";a="48156067" Received: from orw-gwy-01-in.mentorg.com ([192.94.38.165]) by esa3.mentor.iphmx.com with ESMTP; 22 Apr 2020 22:52:50 -0800 IronPort-SDR: jNcIr2af6g65qw58GPkgIExFPC+T+qN1P+5/TR+pucDDu3CKRYUZXa804A91J7g3P1MnOJhS/R n0hPrn94xn23F40rNZ62VifywvBJN2O1NfJZVU1noHVGhU2tS4aXqJ+9lAM3h9c5BWpTZsgp5M UR27pg/IakBR5yQlueGqvI4nsy7NP5z581gH0QjxFEEnCF1rinf/PUnoL10b6+M/3dKUboikpz 0Jya1fABH0YkZfOYEiE2nwjZBFE7Kfjhq4keBwC5OwGLoUguaoQySZ8tRvq1juQZSs1IjVFlBS qJg= To: gcc-patches , fortran , Jakub Jelinek From: Tobias Burnus Subject: [Patch][Fortran] OpenMP - permit lastprivate in distribute + SIMD fixes (PR94690) Message-ID: Date: Thu, 23 Apr 2020 08:52:39 +0200 User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:68.0) Gecko/20100101 Thunderbird/68.7.0 MIME-Version: 1.0 Content-Language: en-US X-Originating-IP: [137.202.0.90] X-ClientProxiedBy: svr-ies-mbx-06.mgc.mentorg.com (139.181.222.6) To svr-ies-mbx-01.mgc.mentorg.com (139.181.222.1) X-Spam-Status: No, score=-23.5 required=5.0 tests=BAYES_00, GIT_PATCH_0, GIT_PATCH_1, GIT_PATCH_2, GIT_PATCH_3, HEADER_FROM_DIFFERENT_DOMAINS, KAM_DMARC_STATUS, SCC_10_SHORT_WORD_LINES, SCC_5_SHORT_WORD_LINES, SPF_HELO_NONE, SPF_PASS, TXREP autolearn=ham autolearn_force=no version=3.4.2 X-Spam-Checker-Version: SpamAssassin 3.4.2 (2018-09-13) on server2.sourceware.org X-BeenThere: gcc-patches@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: gcc-patches-bounces@gcc.gnu.org Sender: "Gcc-patches" As found via sollve_vv: the Fortran OpenMP parser missed 'lastprivate' as permitted clause in 'distribute'. Additionally, when copying + fortanifying the libgomp.c*/pr66199-[3-9].c test case, I found an issue with loops. Standard gfortran DO loops use "while()" – probably a legacy because very old Fortran had single tripes. For SIMD loops, a "normal" "for" loop is used. The middle end takes care of most semantic like adding a '(last)private'. For normal DO loops, the FE adds the 'private' to the loop variable. This patch now removes most handling from SIMD loops but keeps it for other constructs. "!simple" means that an auxiliary loop variable ("count.0") is used and the original loop variable is then "j = ... count.0 ...". Issues encountered (see PR): - no truncation warnings (fixed, cf. PR94709) - gfc_trans_omp_do added always a private(loopvar), even if an explicit 'lastprivate(loopvar)' was present (see PR for which test case) - gfc_trans_omp_do [for *-7.f90, function f4] added a 'lastprivate' to the 'simd' for: !$omp distribute collapse(2) !$omp simd collapse(2) This confused the ME as none was added higher up; now the ME handles all. Once removing this from gfc_trans_omp_do, gfortran.dg/target1.f90 failed teams got a private() which was then not repeated at "distribute simd". The reason is that gfc_resolve_do_iterator added it to 'teams' but 'gfc_trans_omp_do' not (no longer) to 'simd'. Solution: Not adding it to SIMD loops. I am not completely happy how it is done – nor am I sure that there are no further pitholes. I also do not see a good way to ensure that newer "something something SIMD" directives get properly added to gfc_resolve_do_iterator. OK for the trunk? Tobias ----------------- Mentor Graphics (Deutschland) GmbH, Arnulfstraße 201, 80634 München / Germany Registergericht München HRB 106955, Geschäftsführer: Thomas Heurung, Alexander Walter [Fortran] OpenMP - permit lastprivate in distribute + SIMD fixes (PR94690) PR fortran/94690 * openmp.c (OMP_DISTRIBUTE_CLAUSES): Add OMP_CLAUSE_LASTPRIVATE. * trans-openmp.c (gfc_trans_omp_do): Don't add private/lastprivate for dovar_found == 0, unless !simple. * openmp.c (gfc_resolve_do_iterator): Skip the private handling for SIMD as that is handled by ME code. PR fortran/94690 * libgomp.fortran/pr66199-3.f90: New. * libgomp.fortran/pr66199-4.f90: New. * libgomp.fortran/pr66199-5.f90: New. * libgomp.fortran/pr66199-6.f90: New. * libgomp.fortran/pr66199-7.f90: New. * libgomp.fortran/pr66199-8.f90: New. * libgomp.fortran/pr66199-9.f90: New. gcc/fortran/openmp.c | 27 ++++++++- gcc/fortran/trans-openmp.c | 27 +++++---- libgomp/testsuite/libgomp.fortran/pr66199-3.f90 | 53 +++++++++++++++++ libgomp/testsuite/libgomp.fortran/pr66199-4.f90 | 60 +++++++++++++++++++ libgomp/testsuite/libgomp.fortran/pr66199-5.f90 | 71 +++++++++++++++++++++++ libgomp/testsuite/libgomp.fortran/pr66199-6.f90 | 42 ++++++++++++++ libgomp/testsuite/libgomp.fortran/pr66199-7.f90 | 72 +++++++++++++++++++++++ libgomp/testsuite/libgomp.fortran/pr66199-8.f90 | 76 +++++++++++++++++++++++++ libgomp/testsuite/libgomp.fortran/pr66199-9.f90 | 46 +++++++++++++++ 9 files changed, 459 insertions(+), 15 deletions(-) diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c index 930bca541b9..310d4e030d2 100644 --- a/gcc/fortran/openmp.c +++ b/gcc/fortran/openmp.c @@ -2595,7 +2595,7 @@ cleanup: | OMP_CLAUSE_SHARED | OMP_CLAUSE_REDUCTION) #define OMP_DISTRIBUTE_CLAUSES \ (omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_FIRSTPRIVATE \ - | OMP_CLAUSE_COLLAPSE | OMP_CLAUSE_DIST_SCHEDULE) + | OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_COLLAPSE | OMP_CLAUSE_DIST_SCHEDULE) #define OMP_SINGLE_CLAUSES \ (omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_FIRSTPRIVATE) #define OMP_ORDERED_CLAUSES \ @@ -5682,6 +5682,31 @@ gfc_resolve_do_iterator (gfc_code *code, gfc_symbol *sym, bool add_clause) if (omp_current_ctx->sharing_clauses->contains (sym)) return; + if (omp_current_ctx->is_openmp && omp_current_ctx->code->block) + { + /* SIMD is handled differently and, hence, ignored here. */ + gfc_code *omp_code = omp_current_ctx->code->block; + for ( ; omp_code->next; omp_code = omp_code->next) + switch (omp_code->op) + { + case EXEC_OMP_SIMD: + case EXEC_OMP_DO_SIMD: + case EXEC_OMP_PARALLEL_DO_SIMD: + case EXEC_OMP_DISTRIBUTE_SIMD: + case EXEC_OMP_DISTRIBUTE_PARALLEL_DO_SIMD: + case EXEC_OMP_TEAMS_DISTRIBUTE_SIMD: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD: + case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: + case EXEC_OMP_TARGET_PARALLEL_DO_SIMD: + case EXEC_OMP_TARGET_SIMD: + case EXEC_OMP_TASKLOOP_SIMD: + return; + default: + break; + } + } + if (! omp_current_ctx->private_iterators->add (sym) && add_clause) { gfc_omp_clauses *omp_clauses = omp_current_ctx->code->ext.omp_clauses; diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c index 66669550499..d107a7c3b4a 100644 --- a/gcc/fortran/trans-openmp.c +++ b/gcc/fortran/trans-openmp.c @@ -4296,23 +4296,22 @@ gfc_trans_omp_do (gfc_code *code, gfc_exec_op op, stmtblock_t *pblock, break; } } - if (!dovar_found) + if (!dovar_found && op == EXEC_OMP_SIMD) { - if (op == EXEC_OMP_SIMD) + if (collapse == 1) { - if (collapse == 1) - { - tmp = build_omp_clause (input_location, OMP_CLAUSE_LINEAR); - OMP_CLAUSE_LINEAR_STEP (tmp) = step; - OMP_CLAUSE_LINEAR_NO_COPYIN (tmp) = 1; - } - else - tmp = build_omp_clause (input_location, OMP_CLAUSE_LASTPRIVATE); - if (!simple) - dovar_found = 2; + tmp = build_omp_clause (input_location, OMP_CLAUSE_LINEAR); + OMP_CLAUSE_LINEAR_STEP (tmp) = step; + OMP_CLAUSE_LINEAR_NO_COPYIN (tmp) = 1; + OMP_CLAUSE_DECL (tmp) = dovar_decl; + omp_clauses = gfc_trans_add_clause (tmp, omp_clauses); } - else - tmp = build_omp_clause (input_location, OMP_CLAUSE_PRIVATE); + if (!simple) + dovar_found = 2; + } + else if (!dovar_found && !simple) + { + tmp = build_omp_clause (input_location, OMP_CLAUSE_PRIVATE); OMP_CLAUSE_DECL (tmp) = dovar_decl; omp_clauses = gfc_trans_add_clause (tmp, omp_clauses); } diff --git a/libgomp/testsuite/libgomp.fortran/pr66199-3.f90 b/libgomp/testsuite/libgomp.fortran/pr66199-3.f90 new file mode 100644 index 00000000000..7c596dc1739 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/pr66199-3.f90 @@ -0,0 +1,53 @@ +! { dg-do run } +! +! PR fortran/94690 +! PR middle-end/66199 + +module m + integer u(0:1024-1), v(0:1024-1), w(0:1024-1) +contains + +integer(8) function f1 (a, b) + implicit none + integer, value :: a, b + integer(8) :: d + !$omp parallel do lastprivate (d) default(none) firstprivate (a, b) shared(u, v, w) + do d = a, b-1 + u(d) = v(d) + w(d) + end do + f1 = d +end + +integer(8) function f2 (a, b, c) + implicit none + integer, value :: a, b, c + integer(8) :: d, e + !$omp parallel do lastprivate (d) default(none) firstprivate (a, b) shared(u, v, w) linear(c:5) lastprivate(e) + do d = a, b-1 + u(d) = v(d) + w(d) + c = c + 5 + e = c + end do + f2 = d + c + e +end + +integer(8) function f3 (a1, b1, a2, b2) + implicit none + integer, value :: a1, b1, a2, b2 + integer(8) d1, d2 + !$omp parallel do default(none) firstprivate (a1, b1, a2, b2) shared(u, v, w) lastprivate(d1, d2) collapse(2) + do d1 = a1, b1-1 + do d2 = a2, b2-1 + u(d1 * 32 + d2) = v(d1 * 32 + d2) + w(d1 * 32 + d2) + end do + end do + f3 = d1 + d2 +end +end module m + +program main + use m + if (f1 (0, 1024) /= 1024) stop 1 + if (f2 (0, 1024, 17) /= 1024 + 2 * (17 + 5 * 1024)) stop 2 + if (f3 (0, 32, 0, 32) /= 64) stop 3 +end program main diff --git a/libgomp/testsuite/libgomp.fortran/pr66199-4.f90 b/libgomp/testsuite/libgomp.fortran/pr66199-4.f90 new file mode 100644 index 00000000000..17b62a6bb95 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/pr66199-4.f90 @@ -0,0 +1,60 @@ +! { dg-do run } +! +! PR fortran/94690 +! PR middle-end/66199 + +module m + implicit none + integer u(0:1023), v(0:1023), w(0:1023) + !$omp declare target (u, v, w) + +contains + +subroutine f1 (a, b) + integer a, b, d + !$omp target teams distribute parallel do default(none) firstprivate (a, b) shared(u, v, w) + do d = a, b-1 + u(d) = v(d) + w(d) + end do +end + +subroutine f2 (a, b, c) + integer a, b, c, d, e + !$omp target teams distribute parallel do default(none) firstprivate (a, b, c) shared(u, v, w) lastprivate(d, e) + do d = a, b-1 + u(d) = v(d) + w(d) + e = c + d * 5 + end do +end + +subroutine f3 (a1, b1, a2, b2) + integer :: a1, b1, a2, b2, d1, d2 + !$omp target teams distribute parallel do default(none) firstprivate (a1, b1, a2, b2) shared(u, v, w) & + !$omp& lastprivate(d1, d2) collapse(2) + do d1 = a1, b1-1 + do d2 = a2, b2-1 + u(d1 * 32 + d2) = v(d1 * 32 + d2) + w(d1 * 32 + d2) + end do + end do +end + +subroutine f4 (a1, b1, a2, b2) + integer :: a1, b1, a2, b2, d1, d2 + !$omp target teams distribute parallel do default(none) firstprivate (a1, b1, a2, b2) shared(u, v, w) & + !$omp& collapse(2) + do d1 = a1, b1-1 + do d2 = a2, b2-1 + u(d1 * 32 + d2) = v(d1 * 32 + d2) + w(d1 * 32 + d2) + end do + end do +end +end module m + +program main + use m + implicit none + call f1 (0, 1024) + call f2 (0, 1024, 17) + call f3 (0, 32, 0, 32) + call f4 (0, 32, 0, 32) +end diff --git a/libgomp/testsuite/libgomp.fortran/pr66199-5.f90 b/libgomp/testsuite/libgomp.fortran/pr66199-5.f90 new file mode 100644 index 00000000000..9482f08fc02 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/pr66199-5.f90 @@ -0,0 +1,71 @@ +! { dg-do run } +! +! PR fortran/94690 +! PR middle-end/66199 + +module m + implicit none + integer u(0:1023), v(0:1023), w(0:1023) + !$omp declare target (u, v, w) + +contains + +integer function f1 (a, b) + integer :: a, b, d + !$omp target map(from: d) + !$omp teams distribute parallel do simd default(none) firstprivate (a, b) shared(u, v, w) + do d = a, b-1 + u(d) = v(d) + w(d) + end do + !$omp end target + f1 = d +end + +integer function f2 (a, b, c) + integer :: a, b, c, d, e + !$omp target map(from: d, e) + !$omp teams distribute parallel do simd default(none) firstprivate (a, b, c) shared(u, v, w) linear(d) lastprivate(e) + do d = a, b-1 + u(d) = v(d) + w(d) + e = c + d * 5 + end do + !$omp end target + f2 = d + e +end + +integer function f3 (a1, b1, a2, b2) + integer :: a1, b1, a2, b2, d1, d2 + !$omp target map(from: d1, d2) + !$omp teams distribute parallel do simd default(none) firstprivate (a1, b1, a2, b2) shared(u, v, w) lastprivate(d1, d2) & + !$omp& collapse(2) + do d1 = a1, b1-1 + do d2 = a2, b2-1 + u(d1 * 32 + d2) = v(d1 * 32 + d2) + w(d1 * 32 + d2) + end do + end do + !$omp end target + f3 = d1 + d2 +end + +integer function f4 (a1, b1, a2, b2) + integer :: a1, b1, a2, b2, d1, d2 + !$omp target map(from: d1, d2) + !$omp teams distribute parallel do simd default(none) firstprivate (a1, b1, a2, b2) shared(u, v, w) collapse(2) + do d1 = a1, b1-1 + do d2 = a2, b2-1 + u(d1 * 32 + d2) = v(d1 * 32 + d2) + w(d1 * 32 + d2) + end do + end do + !$omp end target + f4 = d1 + d2 +end +end module + +program main + use m + implicit none + if (f1 (0, 1024) /= 1024) stop 1 + if (f2 (0, 1024, 17) /= 1024 + (17 + 5 * 1023)) stop 2 + if (f3 (0, 32, 0, 32) /= 64) stop 3 + if (f4 (0, 32, 0, 32) /= 64) stop 3 +end diff --git a/libgomp/testsuite/libgomp.fortran/pr66199-6.f90 b/libgomp/testsuite/libgomp.fortran/pr66199-6.f90 new file mode 100644 index 00000000000..f73f6833bb5 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/pr66199-6.f90 @@ -0,0 +1,42 @@ +! { dg-do run } +! +! PR fortran/94690 +! PR middle-end/66199 + +module m + implicit none + integer :: u(0:1023), v(0:1023), w(0:1023) + !$omp declare target (u, v, w) + +contains + +integer function f2 (a, b, c) + integer :: a, b, c, d, e + !$omp target map(from: d, e) + !$omp teams distribute parallel do default(none) firstprivate (a, b, c) shared(u, v, w) lastprivate(d, e) + do d = a, b-1 + u(d) = v(d) + w(d) + e = c + d * 5 + end do + !$omp end target + f2 = d + e +end + +integer function f3 (a1, b1, a2, b2) + integer :: a1, b1, a2, b2, d1, d2 + !$omp target map(from: d1, d2) + !$omp teams distribute parallel do default(none) firstprivate (a1, b1, a2, b2) shared(u, v, w) lastprivate(d1, d2) collapse(2) + do d1 = a1, b1-1 + do d2 = a2, b2-1 + u(d1 * 32 + d2) = v(d1 * 32 + d2) + w(d1 * 32 + d2) + end do + end do + !$omp end target + f3 = d1 + d2 +end +end module m + +use m + if (f2 (0, 1024, 17) /= 1024 + (17 + 5 * 1023)) stop 1 + if (f3 (0, 32, 0, 32) /= 64) stop 2 +end diff --git a/libgomp/testsuite/libgomp.fortran/pr66199-7.f90 b/libgomp/testsuite/libgomp.fortran/pr66199-7.f90 new file mode 100644 index 00000000000..2bd94683163 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/pr66199-7.f90 @@ -0,0 +1,72 @@ +! { dg-do run } +! +! PR fortran/94690 +! PR middle-end/66199 + +module m + implicit none + integer u(1024), v(1024), w(1024) + !$omp declare target (v, u, w) + +contains + +integer function f1 (a, b) + integer :: a, b, d + !$omp target map(from: d) + !$omp teams distribute simd default(none) firstprivate (a, b) shared(u, v, w) + do d = a, b-1 + u(d) = v(d) + w(d) + end do + !$omp end teams distribute simd + !$omp end target + f1 = d +end + +integer function f2 (a, b, c) + integer a, b, c, d, e + !$omp target map(from: d, e) + !$omp teams distribute simd default(none) firstprivate (a, b, c) shared(u, v, w) linear(d) lastprivate(e) + do d = a, b-1 + u(d) = v(d) + w(d) + e = c + d * 5 + end do + !$omp end teams distribute simd + !$omp end target + f2 = d + e +end + +integer function f3 (a1, b1, a2, b2) + integer :: a1, b1, a2, b2, d1, d2 + !$omp target map(from: d1, d2) + !$omp teams distribute simd default(none) firstprivate (a1, b1, a2, b2) shared(u, v, w) lastprivate(d1, d2) collapse(2) + do d1 = a1, b1-1 + do d2 = a2, b2-1 + u(d1 * 32 + d2) = v(d1 * 32 + d2) + w(d1 * 32 + d2) + end do + end do + !$omp end teams distribute simd + !$omp end target + f3 = d1 + d2 +end + +integer function f4 (a1, b1, a2, b2) + integer :: a1, b1, a2, b2, d1, d2 + !$omp target map(from: d1, d2) + !$omp teams distribute simd default(none) firstprivate (a1, b1, a2, b2) shared(u, v, w) collapse(2) + do d1 = a1, b1-1 + do d2 = a2, b2-1 + u(d1 * 32 + d2) = v(d1 * 32 + d2) + w(d1 * 32 + d2) + end do + end do + !$omp end teams distribute simd + !$omp end target + f4 = d1 + d2 +end +end module + +use m + if (f1 (0, 1024) /= 1024) stop 1 + if (f2 (0, 1024, 17) /= 1024 + (17 + 5 * 1023)) stop 2 + if (f3 (0, 32, 0, 32) /= 64) stop 3 + if (f4 (0, 32, 0, 32) /= 64) stop 4 +end diff --git a/libgomp/testsuite/libgomp.fortran/pr66199-8.f90 b/libgomp/testsuite/libgomp.fortran/pr66199-8.f90 new file mode 100644 index 00000000000..8a21c6f2b2a --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/pr66199-8.f90 @@ -0,0 +1,76 @@ +! { dg-do run } +! +! PR fortran/94690 +! PR middle-end/66199 + +module m + implicit none + integer u(0:1023), v(0:1023), w(0:1023) + !$omp declare target (u, v, w) + +contains + +integer function f1 (a, b) + integer :: a, b, d + !$omp target map(from: d) + !$omp teams default(none) shared(a, b, d, u, v, w) + !$omp distribute simd firstprivate (a, b) + do d = a, b-1 + u(d) = v(d) + w(d) + end do + !$omp end teams + !$omp end target + f1 = d +end + +integer function f2 (a, b, c) + integer a, b, c, d, e + !$omp target map(from: d, e) + !$omp teams default(none) firstprivate (a, b, c) shared(d, e, u, v, w) + !$omp distribute simd linear(d) lastprivate(e) + do d = a, b-1 + u(d) = v(d) + w(d) + e = c + d * 5 + end do + !$omp end teams + !$omp end target + f2 = d + e +end + +integer function f3 (a1, b1, a2, b2) + integer a1, b1, a2, b2, d1, d2 + !$omp target map(from: d1, d2) + !$omp teams default(none) shared(a1, b1, a2, b2, d1, d2, u, v, w) + !$omp distribute simd firstprivate (a1, b1, a2, b2) lastprivate(d1, d2) collapse(2) + do d1 = a1, b1-1 + do d2 = a2, b2-1 + u(d1 * 32 + d2) = v(d1 * 32 + d2) + w(d1 * 32 + d2) + end do + end do + !$omp end teams + !$omp end target + f3 = d1 + d2 +end + +integer function f4 (a1, b1, a2, b2) + integer a1, b1, a2, b2, d1, d2 + !$omp target map(from: d1, d2) + !$omp teams default(none) firstprivate (a1, b1, a2, b2) shared(d1, d2, u, v, w) + !$omp distribute simd collapse(2) + do d1 = a1, b1-1 + do d2 = a2, b2-1 + u(d1 * 32 + d2) = v(d1 * 32 + d2) + w(d1 * 32 + d2) + end do + end do + !$omp end teams + !$omp end target + f4 = d1 + d2 +end +end module m + +use m + if (f1 (0, 1024) /= 1024) stop 1 + if (f2 (0, 1024, 17) /= 1024 + (17 + 5 * 1023)) stop 2 + if (f3 (0, 32, 0, 32) /= 64) stop 3 + if (f4 (0, 32, 0, 32) /= 64) stop 4 +end diff --git a/libgomp/testsuite/libgomp.fortran/pr66199-9.f90 b/libgomp/testsuite/libgomp.fortran/pr66199-9.f90 new file mode 100644 index 00000000000..5dde7f83116 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/pr66199-9.f90 @@ -0,0 +1,46 @@ +! { dg-do run } +! +! PR fortran/94690 +! PR middle-end/66199 + +module m + implicit none + integer u(1024), v(1024), w(1024) + !$omp declare target (u, v, w) + +contains + +integer function f2 (a, b, c) + integer :: a, b, c, d, e + !$omp target map(from: d, e) + !$omp teams default(none) firstprivate (a, b, c) shared(d, e, u, v, w) + !$omp distribute lastprivate(d, e) + do d = a, b-1 + u(d) = v(d) + w(d) + e = c + d * 5 + end do + !$omp end teams + !$omp end target + f2 = d + e +end + +integer function f3 (a1, b1, a2, b2) + integer :: a1, b1, a2, b2, d1, d2 + !$omp target map(from: d1, d2) + !$omp teams default(none) shared(a1, b1, a2, b2, d1, d2, u, v, w) + !$omp distribute firstprivate (a1, b1, a2, b2) lastprivate(d1, d2) collapse(2) + do d1 = a1, b1-1 + do d2 = a2, b2-1 + u(d1 * 32 + d2) = v(d1 * 32 + d2) + w(d1 * 32 + d2) + end do + end do + !$omp end teams + !$omp end target + f3 = d1 + d2 +end +end module + +use m + if (f2 (0, 1024, 17) /= 1024 + (17 + 5 * 1023)) stop 1 + if (f3 (0, 32, 0, 32) /= 64) stop 2 +end