From patchwork Mon Feb 5 21:37:45 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: 1895430 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@legolas.ozlabs.org Authentication-Results: legolas.ozlabs.org; dkim=pass (2048-bit key; unprotected) header.d=baylibre-com.20230601.gappssmtp.com header.i=@baylibre-com.20230601.gappssmtp.com header.a=rsa-sha256 header.s=20230601 header.b=S1r+RR/E; dkim-atps=neutral Authentication-Results: legolas.ozlabs.org; spf=pass (sender SPF authorized) smtp.mailfrom=gcc.gnu.org (client-ip=2620:52:3:1:0:246e:9693:128c; helo=server2.sourceware.org; envelope-from=gcc-patches-bounces+incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=patchwork.ozlabs.org) Received: from server2.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 ECDSA (secp384r1) server-digest SHA384) (No client certificate requested) by legolas.ozlabs.org (Postfix) with ESMTPS id 4TTKWB7181z23gM for ; Tue, 6 Feb 2024 08:38:30 +1100 (AEDT) Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id ECA0E3858028 for ; Mon, 5 Feb 2024 21:38:28 +0000 (GMT) X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from mail-wr1-x42f.google.com (mail-wr1-x42f.google.com [IPv6:2a00:1450:4864:20::42f]) by sourceware.org (Postfix) with ESMTPS id 11C1F3858C2D for ; Mon, 5 Feb 2024 21:37:57 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 11C1F3858C2D Authentication-Results: sourceware.org; dmarc=none (p=none dis=none) header.from=baylibre.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=baylibre.com ARC-Filter: OpenARC Filter v1.0.0 sourceware.org 11C1F3858C2D Authentication-Results: server2.sourceware.org; arc=none smtp.remote-ip=2a00:1450:4864:20::42f ARC-Seal: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1707169080; cv=none; b=x03ecA2Qm/yw932L9eNCu97u0EMeOfYwWkshnZotGF93MIp9OO3Eplzp82lKfnzZDPP+g2u6Rw2h0uoGueM4gIQSdBLOKMlVLtnQR66uMkKKeYx8fQQQZ6JSqRU5h9MQAEpyEs32BWB11vBS4OrPtAf3nERoPVOqNkxBcoMGh7g= ARC-Message-Signature: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1707169080; c=relaxed/simple; bh=bmJpa0xNhcqH/QSHzSHq7Dqo+H8sEAeRdG3U/2M0/wI=; h=DKIM-Signature:Message-ID:Date:MIME-Version:To:Subject:From; b=S0sdsSyBXzJ3T+LPKV1IkM/VIa/PzcmmogmQgiyIhzc4pFMfL2dt/qTg7cOZ7c7lYhEsztsQCZEjvwq7Y2MBgLHJgEKUd2ABhLbAxaq/MGkbgm9ohmUZLtk2C7Utpa9vvFMiwrHP3SLGKVRr3HZJm7FXGTBM60CFgsRQxDhTo88= ARC-Authentication-Results: i=1; server2.sourceware.org Received: by mail-wr1-x42f.google.com with SMTP id ffacd0b85a97d-337d05b8942so3733834f8f.3 for ; Mon, 05 Feb 2024 13:37:57 -0800 (PST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=baylibre-com.20230601.gappssmtp.com; s=20230601; t=1707169076; x=1707773876; darn=gcc.gnu.org; h=in-reply-to:from:cc:content-language:subject:references:to :user-agent:mime-version:date:message-id:from:to:cc:subject:date :message-id:reply-to; bh=9ddbkryqXaUasU+dVP9EfbzH6a8uyjI+QHEnHH6sA4U=; b=S1r+RR/EdW4Vvx1Kmam2BfXlLFdp5igmXMtHFbRQsOI8bxVgKFZuvoaY6AsJjpl5Dz N0xzvVaCUXxSpqNatoFJ1GvWbBbGEfOEVfDS4S2ly9ATk6WMhVCsZstb5CWxpUvU7rSx FicYBWqFS0ISiDScch4C00Fdxy1INGmjTpqz1wo5aBOyRJuTjTKefN/SH58cOPPjgulG osYSj4bntFKWo92gh1aExRcHhzbGu+Y4g5304VfcJpVu8TYUgiWGYYpv97yGXM/6RLfb vjGxx8lST0gX2tgh9C6Ze4zkYfka9hlp3YZr0Z+LaUbmauUMTXe54zDb9ZzCNDAYnG/Z jxQw== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20230601; t=1707169076; x=1707773876; h=in-reply-to:from:cc:content-language:subject:references:to :user-agent:mime-version:date:message-id:x-gm-message-state:from:to :cc:subject:date:message-id:reply-to; bh=9ddbkryqXaUasU+dVP9EfbzH6a8uyjI+QHEnHH6sA4U=; b=QPoAOsJckRzSr+ZhPYtLRukU1Jw/Md4f0eDsyaR0lZaMUIxJYnkb16xSkT0oM/wO/F NFPmq0E52i6lZySqKBcjOXkfyfMK7VFdl0obIR4uEnm6r+Qx5RdiE54G2QqGjK+TC6Lb 2c1YVeBkuM/mm8QRtifTbhpGn9edL1J2ofAAY+xTge21QGmijyD3TZHEAv8jG4qOVuQ7 qZDwhXwIBdAiAp13CnXjDswDeltHYFDthpqAyR4q0/Z3barMVALiWzN1L7HpiKeoMQUC OrinXrrkF0WlxNfKXn3dQ1EypNlDjSYjzt4aswaMru1NAu9eMoGzQltQZC6SO3vhDKe5 VoTA== X-Gm-Message-State: AOJu0Ywzd8TpmyvqfryxJkyf74rnyW3sD+06lB2Qzr7eRfHbVYqZN75i cHvJkWifDdSxD92ucybnfxR+WBI4beDZs6aPmHI84u/XPL78hx3PR+t3UApxH1w= X-Google-Smtp-Source: AGHT+IEYzHXk+9Ndk8DkjeSlkE1hpx8tZ008lFiZZbYpF2GkYnVOJgbjqGA5n9Z89ONNgInBpFvY5w== X-Received: by 2002:a5d:4d8b:0:b0:333:3dd:6cc3 with SMTP id b11-20020a5d4d8b000000b0033303dd6cc3mr436875wru.21.1707169075676; Mon, 05 Feb 2024 13:37:55 -0800 (PST) X-Forwarded-Encrypted: i=0; AJvYcCUCakqEU0+cm7YKLeRTMBEjkb5Sd+K2Wh2/gZpjHv3s4suUKTfP7ocFJDuDr4lPkb3f38Rf1AHXk7k22z+dNNvhGeNrvZ2e3vFIhGUeyHQLHVZX5+f4VFeG3xSjqA== Received: from ?IPV6:2a00:23c6:88e4:c502:1df0:9d5b:de1b:cbd0? ([2a00:23c6:88e4:c502:1df0:9d5b:de1b:cbd0]) by smtp.gmail.com with ESMTPSA id s9-20020a05600c45c900b0040fddaf9ff4sm2667342wmo.40.2024.02.05.13.37.55 (version=TLS1_3 cipher=TLS_AES_128_GCM_SHA256 bits=128/128); Mon, 05 Feb 2024 13:37:55 -0800 (PST) Message-ID: Date: Mon, 5 Feb 2024 21:37:45 +0000 MIME-Version: 1.0 User-Agent: Mozilla Thunderbird To: tburnus@baylibre.com References: <3290a0f5-3b9d-4c3c-b7c5-e9ddec4520c7@baylibre.com> Subject: [PATCH v2] openmp, fortran: Add Fortran support for indirect clause on the declare target directive Content-Language: en-GB Cc: Jakub Jelinek , gcc-patches , fortran@gcc.gnu.org From: Kwok Cheung Yeung In-Reply-To: <3290a0f5-3b9d-4c3c-b7c5-e9ddec4520c7@baylibre.com> X-Spam-Status: No, score=-13.5 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, GIT_PATCH_0, RCVD_IN_DNSWL_NONE, SPF_HELO_NONE, 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+incoming=patchwork.ozlabs.org@gcc.gnu.org Hi As previously discussed, this version of the patch adds code to emit a warning when a directive like this: !$omp declare target indirect(.true.) is encountered (i.e. a target directive containing at least one clause, but no to/enter clause, which appears to violate the OpenMP standard). A test is also added to gfortran.dg/gomp/declare-target-indirect-1.f90 to test for this. I have also added a declare-target-indirect-3.f90 test to libgomp to check that procedures passed via a dummy argument work properly when used in an indirect call. Okay for mainline? Thanks Kwok From f6662a7bc76d400fecb5013ad6d6ab3b00b8a6e7 Mon Sep 17 00:00:00 2001 From: Kwok Cheung Yeung Date: Mon, 5 Feb 2024 20:31:49 +0000 Subject: [PATCH] openmp, fortran: Add Fortran support for indirect clause on the declare target directive 2024-02-05 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. Show warning if there are only device_type and/or indirect clauses on the directive. * 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-4.f90 (f1): Update expected warning. * 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. * testsuite/libgomp.fortran/declare-target-indirect-3.f90: New. --- gcc/fortran/dump-parse-tree.cc | 2 + gcc/fortran/f95-lang.cc | 2 + gcc/fortran/gfortran.h | 3 +- gcc/fortran/openmp.cc | 50 ++++++++++++++- gcc/fortran/trans-decl.cc | 4 ++ .../gfortran.dg/gomp/declare-target-4.f90 | 2 +- .../gomp/declare-target-indirect-1.f90 | 62 +++++++++++++++++++ .../gomp/declare-target-indirect-2.f90 | 25 ++++++++ .../declare-target-indirect-1.f90 | 39 ++++++++++++ .../declare-target-indirect-2.f90 | 53 ++++++++++++++++ .../declare-target-indirect-3.f90 | 25 ++++++++ 11 files changed, 262 insertions(+), 5 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 create mode 100644 libgomp/testsuite/libgomp.fortran/declare-target-indirect-3.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..30aba4421ff 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,15 +5594,23 @@ 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 + if ((c->device_type || c->indirect) && !c->lists[OMP_LIST_ENTER] && !c->lists[OMP_LIST_TO] && !c->lists[OMP_LIST_LINK]) gfc_warning_now (OPT_Wopenmp, "OMP DECLARE TARGET directive at %L with only " - "DEVICE_TYPE clause is ignored", &old_loc); + "DEVICE_TYPE or INDIRECT clauses is ignored", + &old_loc); gfc_buffer_error (true); 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-4.f90 b/gcc/testsuite/gfortran.dg/gomp/declare-target-4.f90 index 4f5de4bd8c7..55534d8fe99 100644 --- a/gcc/testsuite/gfortran.dg/gomp/declare-target-4.f90 +++ b/gcc/testsuite/gfortran.dg/gomp/declare-target-4.f90 @@ -2,7 +2,7 @@ ! { dg-additional-options "-fdump-tree-original" } subroutine f1 - !$omp declare target device_type (any) ! { dg-warning "OMP DECLARE TARGET directive at .1. with only DEVICE_TYPE clause is ignored" } + !$omp declare target device_type (any) ! { dg-warning "OMP DECLARE TARGET directive at .1. with only DEVICE_TYPE or INDIRECT clauses is ignored" } end subroutine subroutine f2 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..504c1a29813 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/declare-target-indirect-1.f90 @@ -0,0 +1,62 @@ +! { 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 ! { dg-warning "OMP DECLARE TARGET directive at .1. with only DEVICE_TYPE or INDIRECT clauses is ignored" } + end subroutine + + subroutine sub8 + !$omp declare target indirect (.true.) indirect (.false.) to (sub8) ! { dg-error "Duplicated .indirect. clause at .1." } + end subroutine + + subroutine sub9 + !$omp declare target to (sub9) indirect ("abs") ! { dg-error "INDIRECT clause at .1. requires a constant logical expression" } + end subroutine + + subroutine sub10 + !$omp declare target to (sub10) indirect (5.5) ! { dg-error "INDIRECT clause at .1. requires a constant logical expression" } + end subroutine + + subroutine sub11 + !$omp declare target indirect (.true.) device_type (host) enter (sub11) ! { dg-error "DEVICE_TYPE must be ANY when used with INDIRECT at .1." } + end subroutine + + subroutine sub12 + !$omp declare target indirect (.false.) device_type (nohost) enter (sub12) + 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 diff --git a/libgomp/testsuite/libgomp.fortran/declare-target-indirect-3.f90 b/libgomp/testsuite/libgomp.fortran/declare-target-indirect-3.f90 new file mode 100644 index 00000000000..ff99892f25c --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/declare-target-indirect-3.f90 @@ -0,0 +1,25 @@ +! { dg-do run } + +! Check that indirect calls work on procedures passed in via a dummy argument + +module m +contains + subroutine bar + !$omp declare target enter(bar) indirect + end subroutine + + subroutine foo(f) + procedure(bar) :: f + + !$omp target + call f + !$omp end target + end subroutine +end module + +program main + use m + implicit none + + call foo(bar) +end program