From patchwork Mon Jan 22 20:41:42 2024 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Kwok Cheung Yeung X-Patchwork-Id: 190399 Return-Path: Delivered-To: ouuuleilei@gmail.com Received: by 2002:a05:7301:2bc4:b0:101:a8e8:374 with SMTP id hx4csp2828745dyb; Mon, 22 Jan 2024 12:43:20 -0800 (PST) X-Google-Smtp-Source: AGHT+IEntnRpPYTFQbgcwQDkuSUFlKVsu17uRlOQUxf1VhNIqOa1VYFD/TOC9UMDahcecXuBpNmm X-Received: by 2002:a05:620a:2887:b0:783:64ed:5102 with SMTP id j7-20020a05620a288700b0078364ed5102mr6761118qkp.2.1705956199832; Mon, 22 Jan 2024 12:43:19 -0800 (PST) ARC-Seal: i=2; a=rsa-sha256; t=1705956199; cv=pass; d=google.com; s=arc-20160816; b=YJ/X96D5gfQ3X2WxJFCs5JSxzHY8GVHwBNQQOR2KsNdn12gUWPPanY3DvXGR4nk+ir omBsKOrj2AHcADdP+wAekHVkq2PFCo+PLsAEcxYAJ7LlPdQ7Kbt2MFYxm3OwWgmbsOS2 u1xYj/xHsjAk/7O8+qfHjG37zZKh2x2AwfD+iBsJUmYvdyFnua4MelDhuQ8xBpzdmi2M wbgXhaVln2UJARzjcE3jTO2c9hsyh0baxre3cMRewBcjoEqP5zFLVfd1/LrG7U5zzSuf y/KfY7vq4YL3A6XKtTbMwylf2c/Hr7F5Vc9U13bul69IACsdgwL0EbPyF5x1gHxgOK1Y P5qg== ARC-Message-Signature: i=2; a=rsa-sha256; c=relaxed/relaxed; d=google.com; s=arc-20160816; h=errors-to:list-subscribe:list-help:list-post:list-archive :list-unsubscribe:list-id:precedence:in-reply-to:from:to :content-language:subject:references:user-agent:mime-version:date :message-id:ironport-sdr:arc-filter:dmarc-filter:delivered-to; bh=u68revx6iUykw4JycdnZVCSuIPpM7kuxKmezZcvpEQo=; fh=gHS4W9xE4PfC/XFM8s9PRCXAFAWOviKuMTbKs2XsLT0=; b=PrZJIUGo25lPY/qMTvsQDGt8bvBIxn83KcYYCjrVt1nrBrig+aPAC6xsa407StHQ3Z ZxHh2crJWf4zwjG05+/tCrtPdkB+G4SBow6VRSWOLWgdmdeaLjDDU5L0AhYW4tzKV5ck vMkex5yD/agi5w/IMWTNUevMTYegc7osJx2s7ZFgoX3Px+S+LZ+w5uOxPO6W8YgDGqwf HWeVYrqCdmUUjujnIYsNiShCimX9GUROTziKPAWQIiQ8fgGvTNjD9MaMbuElzUAZYGt7 xVbWooi+y5OhuNsB3LMzoprRaYRhvxkHVu8yYodX55skptFS3GsHWnbiXIap6r8sOpx3 /toQ== ARC-Authentication-Results: i=2; mx.google.com; arc=pass (i=1); spf=pass (google.com: domain of gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org designates 8.43.85.97 as permitted sender) smtp.mailfrom="gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org" Received: from server2.sourceware.org (server2.sourceware.org. [8.43.85.97]) by mx.google.com with ESMTPS id q24-20020ae9e418000000b007833b8cec2fsi6052405qkc.561.2024.01.22.12.43.19 for (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Mon, 22 Jan 2024 12:43:19 -0800 (PST) Received-SPF: pass (google.com: domain of gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org designates 8.43.85.97 as permitted sender) client-ip=8.43.85.97; Authentication-Results: mx.google.com; arc=pass (i=1); spf=pass (google.com: domain of gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org designates 8.43.85.97 as permitted sender) smtp.mailfrom="gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org" Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 6F4E93858409 for ; Mon, 22 Jan 2024 20:43:19 +0000 (GMT) X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from esa1.mentor.iphmx.com (esa1.mentor.iphmx.com [68.232.129.153]) by sourceware.org (Postfix) with ESMTPS id 0603A3858D20; Mon, 22 Jan 2024 20:42:29 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 0603A3858D20 Authentication-Results: sourceware.org; dmarc=none (p=none dis=none) header.from=codesourcery.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=mentor.com ARC-Filter: OpenARC Filter v1.0.0 sourceware.org 0603A3858D20 Authentication-Results: server2.sourceware.org; arc=none smtp.remote-ip=68.232.129.153 ARC-Seal: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1705956152; cv=none; b=WPfGRC9mkXPaj8zCXpDuuMeuOWq4aAx9ZPUpWhXhb5bJVhV1VJmNa7z0x9xvifFE3zdEOUeKf+GD9lrvo8GRmnO+OHcYvASBzAK6n2dV/XvIgcgiucTjqB3SWjimTeipVfOQJeKao5yIghOlupqPfaa9MWTpqvtEHqtISVNhuws= ARC-Message-Signature: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1705956152; c=relaxed/simple; bh=mDaKxokkJDs92hRViJXwplzhz5ohI1NdSwPV1mAIeIc=; h=Message-ID:Date:MIME-Version:Subject:To:From; b=WunwYI1dut79olfha/VvM4liVdvI0Klc3W4WeQSuAb+0eg7vH15AGexnLfl3p52W4+hI8pw4eXCF+bVNfjEf0vgblvIAWDqtj7z+xOAZXJDH5lYYfKfaimqPVHZB19ULWazxDsvaQk4khxCUZNhRXiitLpeZsm2ncrEbQo61Ue4= ARC-Authentication-Results: i=1; server2.sourceware.org X-CSE-ConnectionGUID: K/NJLtPCRiaBJ6fM/RIoDg== X-CSE-MsgGUID: FTbXcqlsROOm607rlp9qSg== X-IronPort-AV: E=Sophos;i="6.05,212,1701158400"; d="scan'208,223";a="32283876" Received: from orw-gwy-01-in.mentorg.com ([192.94.38.165]) by esa1.mentor.iphmx.com with ESMTP; 22 Jan 2024 12:42:28 -0800 IronPort-SDR: e+YMsWF0D2XGBTTJgruuUaPXa3OwrEMTc0HFAvogAwyC+LR1uNTI9eyc+fxqUxMbQwoQBSWn7D NCnvBzHDWZObB7XZqYFyMx8osSWPQCJH+YK5v73UZgWrqSY9cnDnge2xGuh3JZ5aF2p2SCWgDP 5ROwiO+9O7lXVd0SmRiLHaSLJtDlLkbXc4jiy8Oe4bB+1hYcpwt4yHqoi8zWSzwAQPAw10Z8yl SyoM9k0HVmZvxsBuVi2R7UDQbP8iTLqS+hyQx+SYDGkQUF8c0LRTiBVgvz3fiHFWP4g0a34yO5 NpU= Message-ID: <52181f42-9998-45f9-b3b4-ca718c64188e@codesourcery.com> Date: Mon, 22 Jan 2024 20:41:42 +0000 MIME-Version: 1.0 User-Agent: Mozilla Thunderbird References: <37f412ee-58e7-4bde-a763-591268e8f8f4@codesourcery.com> Subject: [PATCH] openmp, fortran: Add Fortran support for indirect clause on the declare target directive Content-Language: en-GB To: gcc-patches , , Jakub Jelinek , Tobias Burnus From: Kwok Cheung Yeung In-Reply-To: <37f412ee-58e7-4bde-a763-591268e8f8f4@codesourcery.com> X-Originating-IP: [137.202.0.90] X-ClientProxiedBy: svr-ies-mbx-14.mgc.mentorg.com (139.181.222.14) To svr-ies-mbx-12.mgc.mentorg.com (139.181.222.12) X-Spam-Status: No, score=-11.7 required=5.0 tests=BAYES_00, GIT_PATCH_0, HEADER_FROM_DIFFERENT_DOMAINS, KAM_DMARC_STATUS, SPF_HELO_PASS, SPF_PASS, TXREP, T_SCC_BODY_TEXT_LINE autolearn=ham autolearn_force=no version=3.4.6 X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on server2.sourceware.org X-BeenThere: gcc-patches@gcc.gnu.org X-Mailman-Version: 2.1.30 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org X-getmail-retrieved-from-mailbox: INBOX X-GMAIL-THRID: 1788824728120162403 X-GMAIL-MSGID: 1788824728120162403 Hi This patch adds support for the indirect clause on the OpenMP 'declare target' directive in Fortran. As with the C and C++ front-ends, this applies the 'omp declare target indirect' attribute on affected function declarations. The C test cases have also been translated to Fortran where appropriate. Okay for mainline? Thanks Kwok From 545bdb2c8ab9a43e79c7a3a2992bd9edc7d08a6f Mon Sep 17 00:00:00 2001 From: Kwok Cheung Yeung Date: Thu, 11 Jan 2024 19:52:53 +0000 Subject: [PATCH 2/2] openmp, fortran: Add Fortran support for indirect clause on the declare target directive 2024-01-19 Kwok Cheung Yeung gcc/fortran/ * dump-parse-tree.cc (show_attr): Handle omp_declare_target_indirect attribute. * f95-lang.cc (gfc_gnu_attributes): Add entry for 'omp declare target indirect'. * gfortran.h (symbol_attribute): Add omp_declare_target_indirect field. (struct gfc_omp_clauses): Add indirect field. * openmp.cc (omp_mask2): Add OMP_CLAUSE_INDIRECT. (gfc_match_omp_clauses): Match indirect clause. (OMP_DECLARE_TARGET_CLAUSES): Add OMP_CLAUSE_INDIRECT. (gfc_match_omp_declare_target): Check omp_device_type and apply omp_declare_target_indirect attribute to symbol if indirect clause active. * trans-decl.cc (add_attributes_to_decl): Add 'omp declare target indirect' attribute if symbol has indirect attribute set. gcc/testsuite/ * gfortran.dg/gomp/declare-target-indirect-1.f90: New. * gfortran.dg/gomp/declare-target-indirect-2.f90: New. libgomp/ * testsuite/libgomp.fortran/declare-target-indirect-1.f90: New. * testsuite/libgomp.fortran/declare-target-indirect-2.f90: New. --- gcc/fortran/dump-parse-tree.cc | 2 + gcc/fortran/f95-lang.cc | 2 + gcc/fortran/gfortran.h | 3 +- gcc/fortran/openmp.cc | 45 +++++++++++++- gcc/fortran/trans-decl.cc | 4 ++ .../gomp/declare-target-indirect-1.f90 | 58 +++++++++++++++++++ .../gomp/declare-target-indirect-2.f90 | 25 ++++++++ .../declare-target-indirect-1.f90 | 39 +++++++++++++ .../declare-target-indirect-2.f90 | 53 +++++++++++++++++ 9 files changed, 229 insertions(+), 2 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/gomp/declare-target-indirect-1.f90 create mode 100644 gcc/testsuite/gfortran.dg/gomp/declare-target-indirect-2.f90 create mode 100644 libgomp/testsuite/libgomp.fortran/declare-target-indirect-1.f90 create mode 100644 libgomp/testsuite/libgomp.fortran/declare-target-indirect-2.f90 diff --git a/gcc/fortran/dump-parse-tree.cc b/gcc/fortran/dump-parse-tree.cc index 1563b810b98..7b154eb3ca7 100644 --- a/gcc/fortran/dump-parse-tree.cc +++ b/gcc/fortran/dump-parse-tree.cc @@ -914,6 +914,8 @@ show_attr (symbol_attribute *attr, const char * module) fputs (" OMP-DECLARE-TARGET", dumpfile); if (attr->omp_declare_target_link) fputs (" OMP-DECLARE-TARGET-LINK", dumpfile); + if (attr->omp_declare_target_indirect) + fputs (" OMP-DECLARE-TARGET-INDIRECT", dumpfile); if (attr->elemental) fputs (" ELEMENTAL", dumpfile); if (attr->pure) diff --git a/gcc/fortran/f95-lang.cc b/gcc/fortran/f95-lang.cc index 358cb17fce2..67fda27aa3e 100644 --- a/gcc/fortran/f95-lang.cc +++ b/gcc/fortran/f95-lang.cc @@ -96,6 +96,8 @@ static const attribute_spec gfc_gnu_attributes[] = gfc_handle_omp_declare_target_attribute, NULL }, { "omp declare target link", 0, 0, true, false, false, false, gfc_handle_omp_declare_target_attribute, NULL }, + { "omp declare target indirect", 0, 0, true, false, false, false, + gfc_handle_omp_declare_target_attribute, NULL }, { "oacc function", 0, -1, true, false, false, false, gfc_handle_omp_declare_target_attribute, NULL }, }; diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index fd73e4ce431..fd843a3241d 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -999,6 +999,7 @@ typedef struct /* Mentioned in OMP DECLARE TARGET. */ unsigned omp_declare_target:1; unsigned omp_declare_target_link:1; + unsigned omp_declare_target_indirect:1; ENUM_BITFIELD (gfc_omp_device_type) omp_device_type:2; unsigned omp_allocate:1; @@ -1584,7 +1585,7 @@ typedef struct gfc_omp_clauses unsigned grainsize_strict:1, num_tasks_strict:1, compare:1, weak:1; unsigned non_rectangular:1, order_concurrent:1; unsigned contains_teams_construct:1, target_first_st_is_teams:1; - unsigned contained_in_target_construct:1; + unsigned contained_in_target_construct:1, indirect:1; ENUM_BITFIELD (gfc_omp_sched_kind) sched_kind:3; ENUM_BITFIELD (gfc_omp_device_type) device_type:2; ENUM_BITFIELD (gfc_omp_memorder) memorder:3; diff --git a/gcc/fortran/openmp.cc b/gcc/fortran/openmp.cc index 0af80d54fad..d1c5c323c54 100644 --- a/gcc/fortran/openmp.cc +++ b/gcc/fortran/openmp.cc @@ -1096,6 +1096,7 @@ enum omp_mask2 OMP_CLAUSE_DOACROSS, /* OpenMP 5.2 */ OMP_CLAUSE_ASSUMPTIONS, /* OpenMP 5.1. */ OMP_CLAUSE_USES_ALLOCATORS, /* OpenMP 5.0 */ + OMP_CLAUSE_INDIRECT, /* OpenMP 5.1 */ /* This must come last. */ OMP_MASK2_LAST }; @@ -2798,6 +2799,32 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, needs_space = true; continue; } + if ((mask & OMP_CLAUSE_INDIRECT) + && (m = gfc_match_dupl_check (!c->indirect, "indirect")) + != MATCH_NO) + { + if (m == MATCH_ERROR) + goto error; + gfc_expr *indirect_expr = NULL; + m = gfc_match (" ( %e )", &indirect_expr); + if (m == MATCH_YES) + { + if (!gfc_resolve_expr (indirect_expr) + || indirect_expr->ts.type != BT_LOGICAL + || indirect_expr->expr_type != EXPR_CONSTANT) + { + gfc_error ("INDIRECT clause at %C requires a constant " + "logical expression"); + gfc_free_expr (indirect_expr); + goto error; + } + c->indirect = indirect_expr->value.logical; + gfc_free_expr (indirect_expr); + } + else + c->indirect = 1; + continue; + } if ((mask & OMP_CLAUSE_IS_DEVICE_PTR) && gfc_match_omp_variable_list ("is_device_ptr (", @@ -4460,7 +4487,7 @@ cleanup: (omp_mask (OMP_CLAUSE_THREADS) | OMP_CLAUSE_SIMD) #define OMP_DECLARE_TARGET_CLAUSES \ (omp_mask (OMP_CLAUSE_ENTER) | OMP_CLAUSE_LINK | OMP_CLAUSE_DEVICE_TYPE \ - | OMP_CLAUSE_TO) + | OMP_CLAUSE_TO | OMP_CLAUSE_INDIRECT) #define OMP_ATOMIC_CLAUSES \ (omp_mask (OMP_CLAUSE_ATOMIC) | OMP_CLAUSE_CAPTURE | OMP_CLAUSE_HINT \ | OMP_CLAUSE_MEMORDER | OMP_CLAUSE_COMPARE | OMP_CLAUSE_FAIL \ @@ -5513,6 +5540,15 @@ gfc_match_omp_declare_target (void) n->sym->name, &n->where); n->sym->attr.omp_device_type = c->device_type; } + if (c->indirect) + { + if (n->sym->attr.omp_device_type != OMP_DEVICE_TYPE_UNSET + && n->sym->attr.omp_device_type != OMP_DEVICE_TYPE_ANY) + gfc_error_now ("DEVICE_TYPE must be ANY when used with " + "INDIRECT at %L", &n->where); + n->sym->attr.omp_declare_target_indirect = c->indirect; + } + n->sym->mark = 1; } else if (n->u.common->omp_declare_target @@ -5558,6 +5594,13 @@ gfc_match_omp_declare_target (void) " TARGET directive to a different DEVICE_TYPE", s->name, &n->where); s->attr.omp_device_type = c->device_type; + + if (c->indirect + && s->attr.omp_device_type != OMP_DEVICE_TYPE_UNSET + && s->attr.omp_device_type != OMP_DEVICE_TYPE_ANY) + gfc_error_now ("DEVICE_TYPE must be ANY when used with " + "INDIRECT at %L", &n->where); + s->attr.omp_declare_target_indirect = c->indirect; } } if (c->device_type diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc index de162f6cc75..6d463036966 100644 --- a/gcc/fortran/trans-decl.cc +++ b/gcc/fortran/trans-decl.cc @@ -1526,6 +1526,10 @@ add_attributes_to_decl (symbol_attribute sym_attr, tree list) list = tree_cons (get_identifier ("omp declare target"), clauses, list); + if (sym_attr.omp_declare_target_indirect) + list = tree_cons (get_identifier ("omp declare target indirect"), + clauses, list); + return list; } diff --git a/gcc/testsuite/gfortran.dg/gomp/declare-target-indirect-1.f90 b/gcc/testsuite/gfortran.dg/gomp/declare-target-indirect-1.f90 new file mode 100644 index 00000000000..560a0541e9a --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/declare-target-indirect-1.f90 @@ -0,0 +1,58 @@ +! { dg-do compile } +! { dg-options "-fopenmp" } + +module m + integer :: a + integer, parameter :: X = 1 + integer, parameter :: Y = 2 + + ! Indirect on a variable should have no effect. + integer :: z + !$omp declare target to (z) indirect +contains + subroutine sub1 + !$omp declare target indirect to (sub1) + end subroutine + + subroutine sub2 + !$omp declare target enter (sub2) indirect (.true.) + end subroutine + + subroutine sub3 + !$omp declare target to (sub3) indirect (.false.) + end subroutine + + subroutine sub4 + !$omp declare target to (sub4) indirect (1) ! { dg-error "INDIRECT clause at .1. requires a constant logical expression" } + end subroutine + + ! Compile-time non-constant expressions are not allowed. + subroutine sub5 + !$omp declare target indirect (a > 0) to (sub5) ! { dg-error "INDIRECT clause at .1. requires a constant logical expression" } + end subroutine + + ! Compile-time constant expressions are permissible. + subroutine sub6 + !$omp declare target indirect (X .eq. Y) to (sub6) + end subroutine + + subroutine sub7 + !$omp declare target indirect (.true.) indirect (.false.) to (sub7) ! { dg-error "Duplicated .indirect. clause at .1." } + end subroutine + + subroutine sub8 + !$omp declare target to (sub8) indirect ("abs") ! { dg-error "INDIRECT clause at .1. requires a constant logical expression" } + end subroutine + + subroutine sub9 + !$omp declare target to (sub9) indirect (5.5) ! { dg-error "INDIRECT clause at .1. requires a constant logical expression" } + end subroutine + + subroutine sub10 + !$omp declare target indirect (.true.) device_type (host) enter (sub10) ! { dg-error "DEVICE_TYPE must be ANY when used with INDIRECT at .1." } + end subroutine + + subroutine sub11 + !$omp declare target indirect (.false.) device_type (nohost) enter (sub11) + end subroutine +end module diff --git a/gcc/testsuite/gfortran.dg/gomp/declare-target-indirect-2.f90 b/gcc/testsuite/gfortran.dg/gomp/declare-target-indirect-2.f90 new file mode 100644 index 00000000000..f6b3ae17856 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/declare-target-indirect-2.f90 @@ -0,0 +1,25 @@ +! { dg-do compile } +! { dg-options "-fopenmp -fdump-tree-gimple" } + +module m +contains + subroutine sub1 + !$omp declare target indirect enter (sub1) + end subroutine + ! { dg-final { scan-tree-dump "__attribute__\\\(\\\(omp declare target, omp declare target indirect\\\)\\\)\\\n.*\\\nvoid sub1" "gimple" } } + + subroutine sub2 + !$omp declare target indirect (.false.) to (sub2) + end subroutine + ! { dg-final { scan-tree-dump "__attribute__\\\(\\\(omp declare target\\\)\\\)\\\n.*\\\nvoid sub2" "gimple" } } + + subroutine sub3 + !$omp declare target indirect (.true.) to (sub3) + end subroutine + ! { dg-final { scan-tree-dump "__attribute__\\\(\\\(omp declare target, omp declare target indirect\\\)\\\)\\\n.*\\\nvoid sub3" "gimple" } } + + subroutine sub4 + !$omp declare target indirect (.false.) enter (sub4) + end subroutine + ! { dg-final { scan-tree-dump "__attribute__\\\(\\\(omp declare target\\\)\\\)\\\n.*\\\nvoid sub4" "gimple" } } +end module diff --git a/libgomp/testsuite/libgomp.fortran/declare-target-indirect-1.f90 b/libgomp/testsuite/libgomp.fortran/declare-target-indirect-1.f90 new file mode 100644 index 00000000000..39a91dfcdca --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/declare-target-indirect-1.f90 @@ -0,0 +1,39 @@ +! { dg-do run } + +module m +contains + integer function foo () + !$omp declare target to (foo) indirect + foo = 5 + end function + + integer function bar () + !$omp declare target to (bar) indirect + bar = 8 + end function + + integer function baz () + !$omp declare target to (baz) indirect + baz = 11 + end function +end module + +program main + use m + implicit none + + integer :: x, expected + procedure (foo), pointer :: foo_ptr, bar_ptr, baz_ptr + + foo_ptr => foo + bar_ptr => bar + baz_ptr => baz + + expected = foo () + bar () + baz () + + !$omp target map (to: foo_ptr, bar_ptr, baz_ptr) map (from: x) + x = foo_ptr () + bar_ptr () + baz_ptr () + !$omp end target + + stop x - expected +end program diff --git a/libgomp/testsuite/libgomp.fortran/declare-target-indirect-2.f90 b/libgomp/testsuite/libgomp.fortran/declare-target-indirect-2.f90 new file mode 100644 index 00000000000..d3baa81dd07 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/declare-target-indirect-2.f90 @@ -0,0 +1,53 @@ +! { dg-do run } + +module m +contains + integer function foo () + !$omp declare target to (foo) indirect + foo = 5 + end function + + integer function bar () + !$omp declare target to (bar) indirect + bar = 8 + end function + + integer function baz () + !$omp declare target to (baz) indirect + baz = 11 + end function +end module + +program main + use m + implicit none + + type fp + procedure (foo), pointer, nopass :: f => null () + end type + + integer, parameter :: N = 256 + integer :: i, x = 0, expected = 0; + type (fp) :: fn_ptr (N) + + do i = 1, N + select case (mod (i, 3)) + case (0) + fn_ptr (i)%f => foo + case (1) + fn_ptr (i)%f => bar + case (2) + fn_ptr (i)%f => baz + end select + expected = expected + fn_ptr (i)%f () + end do + + !$omp target teams distribute parallel do & + !$omp & reduction(+: x) map (to: fn_ptr) map (tofrom: x) + do i = 1, N + x = x + fn_ptr (i)%f () + end do + !$omp end target teams distribute parallel do + + stop x - expected +end program