From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from esa2.mentor.iphmx.com (esa2.mentor.iphmx.com [68.232.141.98]) by sourceware.org (Postfix) with ESMTPS id 59BEE3851C3B; Thu, 20 Aug 2020 09:51:50 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.3.2 sourceware.org 59BEE3851C3B 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: vIbYDX35qAel13cLY1GzfmpNHTz7/ngwQOx+LItiyFCcpwxiuOkweO7AzgCrVBphH4K2xrkQUA eH0oIihhoir7hrV5N3ymofUvFDmS9DE/GzlFxjRoo+g91Ft5Drtc0mNa88ZxWR4drD5QSS/GSS UR2+HW4JLKPC+FOtDNN0UFOISwK8avNu9bqGDGfYET2uZvzgE0qI6k9843nj3nMwFkZoxtri7L bDd54jKmyNCZkGwgvpiBfeErN+NHsGff3uYSRwg0xnjJqELmv4OG0lYb38pK8DNfs2yC8ffWxQ /ro= X-IronPort-AV: E=Sophos;i="5.76,332,1592899200"; d="diff'?scan'208";a="52113697" Received: from orw-gwy-02-in.mentorg.com ([192.94.38.167]) by esa2.mentor.iphmx.com with ESMTP; 20 Aug 2020 01:51:49 -0800 IronPort-SDR: XbSpn7fLOqE3LneOUyOZS5t1lH1PDGSLkfJ28XD+9HEO2lM1s6iuKI6TNw1WNsPWFybw6qIugy EgSY+lQjfb/6r57ckMLMy5LrHMP7mD6uT1O0oGDtI1yfQUzaiCaDrHZIUFqpqF4z4vnNlrM+bb ntjzJMumf4YeaUyamTG66BDhnnA7dRvaGQo2m4t/hl1w6LVjNcJQEVDsJWIQsaPSNh9Ttromli B1xKO1eWVIbe3mv7HIzCFkFMljyNOYWLgrkzETjlq26SHdDaIlEhdp9Z4yZpe1qvEzQ0jREwB9 88s= Subject: Re: [Patch] Fortran: Add 'device_type' clause to OpenMP's declare target To: Andre Vehreschild , Jakub Jelinek CC: Tobias Burnus , gcc-patches , fortran References: <20200818193349.09639c4a@vepi2> <78b99997-f3dd-1f73-625e-818868e53244@net-b.de> From: Tobias Burnus Message-ID: <82b801e4-e5dc-1ba7-6fb3-da680f345fd8@codesourcery.com> Date: Thu, 20 Aug 2020 11:51:50 +0200 User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:68.0) Gecko/20100101 Thunderbird/68.11.0 MIME-Version: 1.0 In-Reply-To: <78b99997-f3dd-1f73-625e-818868e53244@net-b.de> Content-Type: multipart/mixed; boundary="------------26E412DCD8957E65057D5193" Content-Language: en-US X-Originating-IP: [137.202.0.90] X-ClientProxiedBy: svr-ies-mbx-02.mgc.mentorg.com (139.181.222.2) To svr-ies-mbx-01.mgc.mentorg.com (139.181.222.1) X-Spam-Status: No, score=-13.2 required=5.0 tests=BAYES_00, GIT_PATCH_0, HEADER_FROM_DIFFERENT_DOMAINS, KAM_DMARC_STATUS, NICE_REPLY_A, SPF_HELO_PASS, 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: fortran@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Fortran mailing list List-Unsubscribe: , List-Archive: List-Help: List-Subscribe: , X-List-Received-Date: Thu, 20 Aug 2020 09:51:53 -0000 --------------26E412DCD8957E65057D5193 Content-Type: text/plain; charset="utf-8"; format=flowed Content-Transfer-Encoding: quoted-printable Updated patch =E2=80=93 taking Andre's suggestions into account + extending the testcase, which now catches the previous (NO)HOST module issue. OK? Tobias On 8/19/20 2:51 PM, Tobias Burnus wrote: > Am 18.08.20 um 19:33 schrieb Andre Vehreschild: >> + case OMP_DEVICE_TYPE_HOST: >> + MIO_NAME (ab_attribute) (AB_OMP_DEVICE_TYPE_NOHOST, attr_bits); >> Why also NOHOST here? > Copy and paste error. ... >> + tree clauses =3D NULL_TREE; >> Would you mind using "omp_clauses" or the like here? Done now. ----------------- Mentor Graphics (Deutschland) GmbH, Arnulfstra=C3=9Fe 201, 80634 M=C3=BCnch= en / Germany Registergericht M=C3=BCnchen HRB 106955, Gesch=C3=A4ftsf=C3=BChrer: Thomas = Heurung, Alexander Walter --------------26E412DCD8957E65057D5193 Content-Type: text/x-patch; charset="UTF-8"; name="omp-devtype-v2.diff" Content-Transfer-Encoding: 7bit Content-Disposition: attachment; filename="omp-devtype-v2.diff" Fortran: Add 'device_type' clause to OpenMP's declare target gcc/fortran/ChangeLog: * gfortran.h (enum gfc_omp_device_type): New. (symbol_attribute, gfc_omp_clauses, gfc_common_head): Use it. * module.c (enum ab_attribute): Add AB_OMP_DEVICE_TYPE_HOST, AB_OMP_DEVICE_TYPE_NOHOST and AB_OMP_DEVICE_TYPE_ANY. (attr_bits, mio_symbol_attribute): Handle it. (load_commons, write_common_0): Handle omp_device_type flag. * openmp.c (enum omp_mask1): Add OMP_CLAUSE_DEVICE_TYPE (OMP_DECLARE_TARGET_CLAUSES): Likewise. (gfc_match_omp_clauses): Match 'device_type'. (gfc_match_omp_declare_target): Handle it. * trans-common.c (build_common_decl): Write device-type clause. * trans-decl.c (add_attributes_to_decl): Likewise. gcc/testsuite/ChangeLog: * gfortran.dg/gomp/declare-target-4.f90: New test. * gfortran.dg/gomp/declare-target-5.f90: New test. gcc/fortran/gfortran.h | 10 +++ gcc/fortran/module.c | 33 ++++++++- gcc/fortran/openmp.c | 50 ++++++++++++- gcc/fortran/trans-common.c | 25 ++++++- gcc/fortran/trans-decl.c | 22 +++++- .../gfortran.dg/gomp/declare-target-4.f90 | 81 ++++++++++++++++++++++ .../gfortran.dg/gomp/declare-target-5.f90 | 63 +++++++++++++++++ 7 files changed, 277 insertions(+), 7 deletions(-) diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 559d3c6b8b8..d0cea838444 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -753,6 +753,13 @@ CInteropKind_t; that the list is initialized. */ extern CInteropKind_t c_interop_kinds_table[]; +enum gfc_omp_device_type +{ + OMP_DEVICE_TYPE_UNSET, + OMP_DEVICE_TYPE_HOST, + OMP_DEVICE_TYPE_NOHOST, + OMP_DEVICE_TYPE_ANY +}; /* Structure and list of supported extension attributes. */ typedef enum @@ -919,6 +926,7 @@ typedef struct /* Mentioned in OMP DECLARE TARGET. */ unsigned omp_declare_target:1; unsigned omp_declare_target_link:1; + ENUM_BITFIELD (gfc_omp_device_type) omp_device_type:2; /* Mentioned in OACC DECLARE. */ unsigned oacc_declare_create:1; @@ -1360,6 +1368,7 @@ typedef struct gfc_omp_clauses struct gfc_expr *num_threads; gfc_omp_namelist *lists[OMP_LIST_NUM]; enum gfc_omp_sched_kind sched_kind; + enum gfc_omp_device_type device_type; struct gfc_expr *chunk_size; enum gfc_omp_default_sharing default_sharing; int collapse, orderedc; @@ -1699,6 +1708,7 @@ typedef struct gfc_common_head char use_assoc, saved, threadprivate; unsigned char omp_declare_target : 1; unsigned char omp_declare_target_link : 1; + ENUM_BITFIELD (gfc_omp_device_type) omp_device_type:2; /* Provide sufficient space to hold "symbol.symbol.eq.1234567890". */ char name[2*GFC_MAX_SYMBOL_LEN + 1 + 14 + 1]; struct gfc_symbol *head; diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c index 5114d5534b8..714fbd9c299 100644 --- a/gcc/fortran/module.c +++ b/gcc/fortran/module.c @@ -2051,7 +2051,8 @@ enum ab_attribute AB_OMP_REQ_REVERSE_OFFLOAD, AB_OMP_REQ_UNIFIED_ADDRESS, AB_OMP_REQ_UNIFIED_SHARED_MEMORY, AB_OMP_REQ_DYNAMIC_ALLOCATORS, AB_OMP_REQ_MEM_ORDER_SEQ_CST, AB_OMP_REQ_MEM_ORDER_ACQ_REL, - AB_OMP_REQ_MEM_ORDER_RELAXED + AB_OMP_REQ_MEM_ORDER_RELAXED, AB_OMP_DEVICE_TYPE_NOHOST, + AB_OMP_DEVICE_TYPE_HOST, AB_OMP_DEVICE_TYPE_ANY }; static const mstring attr_bits[] = @@ -2132,6 +2133,9 @@ static const mstring attr_bits[] = minit ("OMP_REQ_MEM_ORDER_SEQ_CST", AB_OMP_REQ_MEM_ORDER_SEQ_CST), minit ("OMP_REQ_MEM_ORDER_ACQ_REL", AB_OMP_REQ_MEM_ORDER_ACQ_REL), minit ("OMP_REQ_MEM_ORDER_RELAXED", AB_OMP_REQ_MEM_ORDER_RELAXED), + minit ("OMP_DEVICE_TYPE_HOST", AB_OMP_DEVICE_TYPE_HOST), + minit ("OMP_DEVICE_TYPE_NOHOST", AB_OMP_DEVICE_TYPE_NOHOST), + minit ("OMP_DEVICE_TYPE_ANYHOST", AB_OMP_DEVICE_TYPE_ANY), minit (NULL, -1) }; @@ -2397,6 +2401,22 @@ mio_symbol_attribute (symbol_attribute *attr) == OMP_REQ_ATOMIC_MEM_ORDER_RELAXED) MIO_NAME (ab_attribute) (AB_OMP_REQ_MEM_ORDER_RELAXED, attr_bits); } + switch (attr->omp_device_type) + { + case OMP_DEVICE_TYPE_UNSET: + break; + case OMP_DEVICE_TYPE_HOST: + MIO_NAME (ab_attribute) (AB_OMP_DEVICE_TYPE_HOST, attr_bits); + break; + case OMP_DEVICE_TYPE_NOHOST: + MIO_NAME (ab_attribute) (AB_OMP_DEVICE_TYPE_NOHOST, attr_bits); + break; + case OMP_DEVICE_TYPE_ANY: + MIO_NAME (ab_attribute) (AB_OMP_DEVICE_TYPE_ANY, attr_bits); + break; + default: + gcc_unreachable (); + } mio_rparen (); } else @@ -2661,6 +2681,15 @@ mio_symbol_attribute (symbol_attribute *attr) "relaxed", &gfc_current_locus, module_name); break; + case AB_OMP_DEVICE_TYPE_HOST: + attr->omp_device_type = OMP_DEVICE_TYPE_HOST; + break; + case AB_OMP_DEVICE_TYPE_NOHOST: + attr->omp_device_type = OMP_DEVICE_TYPE_NOHOST; + break; + case AB_OMP_DEVICE_TYPE_ANY: + attr->omp_device_type = OMP_DEVICE_TYPE_ANY; + break; } } } @@ -4849,6 +4878,7 @@ load_commons (void) p->saved = 1; if (flags & 2) p->threadprivate = 1; + p->omp_device_type = (gfc_omp_device_type) ((flags >> 2) & 3); p->use_assoc = 1; /* Get whether this was a bind(c) common or not. */ @@ -5713,6 +5743,7 @@ write_common_0 (gfc_symtree *st, bool this_module) flags = p->saved ? 1 : 0; if (p->threadprivate) flags |= 2; + flags |= p->omp_device_type << 2; mio_integer (&flags); /* Write out whether the common block is bind(c) or not. */ diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c index 4d33a450a33..235a26987c6 100644 --- a/gcc/fortran/openmp.c +++ b/gcc/fortran/openmp.c @@ -752,7 +752,7 @@ cleanup: return MATCH_ERROR; } -/* OpenMP 4.5 clauses. */ +/* OpenMP clauses. */ enum omp_mask1 { OMP_CLAUSE_PRIVATE, @@ -800,7 +800,8 @@ enum omp_mask1 OMP_CLAUSE_SIMD, OMP_CLAUSE_THREADS, OMP_CLAUSE_USE_DEVICE_PTR, - OMP_CLAUSE_USE_DEVICE_ADDR, /* Actually, OpenMP 5.0. */ + OMP_CLAUSE_USE_DEVICE_ADDR, /* OpenMP 5.0. */ + OMP_CLAUSE_DEVICE_TYPE, /* OpenMP 5.0. */ OMP_CLAUSE_NOWAIT, /* This must come last. */ OMP_MASK1_LAST @@ -1214,6 +1215,24 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, OMP_MAP_FORCE_DEVICEPTR, false, allow_derived)) continue; + if ((mask & OMP_CLAUSE_DEVICE_TYPE) + && gfc_match ("device_type ( ") == MATCH_YES) + { + if (gfc_match ("host") == MATCH_YES) + c->device_type = OMP_DEVICE_TYPE_HOST; + else if (gfc_match ("nohost") == MATCH_YES) + c->device_type = OMP_DEVICE_TYPE_NOHOST; + else if (gfc_match ("any") == MATCH_YES) + c->device_type = OMP_DEVICE_TYPE_ANY; + else + { + gfc_error ("Expected HOST, NOHOST or ANY at %C"); + break; + } + if (gfc_match (" )") != MATCH_YES) + break; + continue; + } if ((mask & OMP_CLAUSE_DEVICE_RESIDENT) && gfc_match_omp_variable_list ("device_resident (", @@ -2638,7 +2657,7 @@ cleanup: #define OMP_ORDERED_CLAUSES \ (omp_mask (OMP_CLAUSE_THREADS) | OMP_CLAUSE_SIMD) #define OMP_DECLARE_TARGET_CLAUSES \ - (omp_mask (OMP_CLAUSE_TO) | OMP_CLAUSE_LINK) + (omp_mask (OMP_CLAUSE_TO) | OMP_CLAUSE_LINK | OMP_CLAUSE_DEVICE_TYPE) static match @@ -3275,6 +3294,15 @@ gfc_match_omp_declare_target (void) gfc_add_omp_declare_target_link (&n->sym->attr, n->sym->name, &n->sym->declared_at); } + if (c->device_type != OMP_DEVICE_TYPE_UNSET) + { + if (n->sym->attr.omp_device_type != OMP_DEVICE_TYPE_UNSET + && n->sym->attr.omp_device_type != c->device_type) + gfc_error_now ("List item %qs at %L set in previous OMP DECLARE " + "TARGET directive to a different DEVICE_TYPE", + n->sym->name, &n->where); + n->sym->attr.omp_device_type = c->device_type; + } n->sym->mark = 1; } else if (n->u.common->omp_declare_target @@ -3297,6 +3325,13 @@ gfc_match_omp_declare_target (void) { n->u.common->omp_declare_target = 1; n->u.common->omp_declare_target_link = (list == OMP_LIST_LINK); + if (n->u.common->omp_device_type != OMP_DEVICE_TYPE_UNSET + && n->u.common->omp_device_type != c->device_type) + gfc_error_now ("COMMON at %L set in previous OMP DECLARE " + "TARGET directive to a different DEVICE_TYPE", + &n->where); + n->u.common->omp_device_type = c->device_type; + for (s = n->u.common->head; s; s = s->common_next) { s->mark = 1; @@ -3307,8 +3342,17 @@ gfc_match_omp_declare_target (void) gfc_add_omp_declare_target_link (&s->attr, s->name, &s->declared_at); } + if (s->attr.omp_device_type != OMP_DEVICE_TYPE_UNSET + && s->attr.omp_device_type != c->device_type) + gfc_error_now ("List item %qs at %L set in previous OMP DECLARE" + " TARGET directive to a different DEVICE_TYPE", + s->name, &n->where); + s->attr.omp_device_type = c->device_type; } } + if (c->device_type && !c->lists[OMP_LIST_TO] && !c->lists[OMP_LIST_LINK]) + gfc_warning_now (0, "OMP DECLARE TARGET directive at %L with only " + "DEVICE_TYPE clause is ignored", &old_loc); gfc_buffer_error (true); diff --git a/gcc/fortran/trans-common.c b/gcc/fortran/trans-common.c index c6383fc2352..52a9b2f4f49 100644 --- a/gcc/fortran/trans-common.c +++ b/gcc/fortran/trans-common.c @@ -426,6 +426,8 @@ build_common_decl (gfc_common_head *com, tree union_type, bool is_init) /* If there is no backend_decl for the common block, build it. */ if (decl == NULL_TREE) { + tree omp_clauses = NULL_TREE; + if (com->is_bind_c == 1 && com->binding_label) decl = build_decl (input_location, VAR_DECL, identifier, union_type); else @@ -460,14 +462,33 @@ build_common_decl (gfc_common_head *com, tree union_type, bool is_init) if (com->threadprivate) set_decl_tls_model (decl, decl_default_tls_model (decl)); + if (com->omp_device_type != OMP_DEVICE_TYPE_UNSET) + { + tree c = build_omp_clause (UNKNOWN_LOCATION, OMP_CLAUSE_DEVICE_TYPE); + switch (com->omp_device_type) + { + case OMP_DEVICE_TYPE_HOST: + OMP_CLAUSE_DEVICE_TYPE_KIND (c) = OMP_CLAUSE_DEVICE_TYPE_HOST; + break; + case OMP_DEVICE_TYPE_NOHOST: + OMP_CLAUSE_DEVICE_TYPE_KIND (c) = OMP_CLAUSE_DEVICE_TYPE_NOHOST; + break; + case OMP_DEVICE_TYPE_ANY: + OMP_CLAUSE_DEVICE_TYPE_KIND (c) = OMP_CLAUSE_DEVICE_TYPE_ANY; + break; + default: + gcc_unreachable (); + } + omp_clauses = c; + } if (com->omp_declare_target_link) DECL_ATTRIBUTES (decl) = tree_cons (get_identifier ("omp declare target link"), - NULL_TREE, DECL_ATTRIBUTES (decl)); + omp_clauses, DECL_ATTRIBUTES (decl)); else if (com->omp_declare_target) DECL_ATTRIBUTES (decl) = tree_cons (get_identifier ("omp declare target"), - NULL_TREE, DECL_ATTRIBUTES (decl)); + omp_clauses, DECL_ATTRIBUTES (decl)); /* Place the back end declaration for this common block in GLOBAL_BINDING_LEVEL. */ diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index 45a739ac860..92242771dde 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -1465,11 +1465,31 @@ add_attributes_to_decl (symbol_attribute sym_attr, tree list) tree dims = oacc_build_routine_dims (clauses); list = oacc_replace_fn_attrib_attr (list, dims); } + if (sym_attr.omp_device_type != OMP_DEVICE_TYPE_UNSET) + { + tree c = build_omp_clause (UNKNOWN_LOCATION, OMP_CLAUSE_DEVICE_TYPE); + switch (sym_attr.omp_device_type) + { + case OMP_DEVICE_TYPE_HOST: + OMP_CLAUSE_DEVICE_TYPE_KIND (c) = OMP_CLAUSE_DEVICE_TYPE_HOST; + break; + case OMP_DEVICE_TYPE_NOHOST: + OMP_CLAUSE_DEVICE_TYPE_KIND (c) = OMP_CLAUSE_DEVICE_TYPE_NOHOST; + break; + case OMP_DEVICE_TYPE_ANY: + OMP_CLAUSE_DEVICE_TYPE_KIND (c) = OMP_CLAUSE_DEVICE_TYPE_ANY; + break; + default: + gcc_unreachable (); + } + OMP_CLAUSE_CHAIN (c) = clauses; + clauses = c; + } if (sym_attr.omp_declare_target_link || sym_attr.oacc_declare_link) list = tree_cons (get_identifier ("omp declare target link"), - NULL_TREE, list); + clauses, list); else if (sym_attr.omp_declare_target || sym_attr.oacc_declare_create || sym_attr.oacc_declare_copyin diff --git a/gcc/testsuite/gfortran.dg/gomp/declare-target-4.f90 b/gcc/testsuite/gfortran.dg/gomp/declare-target-4.f90 new file mode 100644 index 00000000000..6e3f91eefca --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/declare-target-4.f90 @@ -0,0 +1,81 @@ +! { dg-do compile } +! { 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" } +end subroutine + +subroutine f2 + !$omp declare target to (f2) device_type (any) +end subroutine + +subroutine f3 + !$omp declare target device_type (any) to (f3) +end subroutine + +subroutine f4 + !$omp declare target device_type (host) to (f4) +end subroutine + +subroutine f5 + !$omp declare target device_type (nohost) to (f5) +end subroutine + +module mymod + ! device_type is ignored for variables in OpenMP 5.0 + ! but TR8 and later apply those rules to variables as well + implicit none + integer :: a, b(4), c, d + integer :: e, f, g + integer :: m, n, o, p, q, r, s, t, u, v, w, x + common /block1/ m, n + common /block2/ o, p + common /block3/ q, r + common /block4/ s, t + common /block5/ u, v + common /block6/ w, x + + !$omp declare target to(a) device_type(nohost) + !$omp declare target to(b) device_type(host) + !$omp declare target to(c) device_type(any) + ! Fails in ME with "Error: wrong number of arguments specified for 'omp declare target link' attribute" + ! !$omp declare target link(e) device_type(nohost) + ! !$omp declare target link(f) device_type(host) + ! !$omp declare target link(g) device_type(any) + + !$omp declare target to(/block1/) device_type(nohost) + !$omp declare target to(/block2/) device_type(host) + !$omp declare target to(/block3/) device_type(any) + !$omp declare target link(/block4/) device_type(nohost) + !$omp declare target link(/block5/) device_type(host) + !$omp declare target link(/block6/) device_type(any) +contains + subroutine s1 + !$omp declare target to (s1) device_type (any) + end + subroutine s2 + !$omp declare target to (s2) device_type (nohost) + end + subroutine s3 + !$omp declare target to (s3) device_type (host) + end +end module + +module m2 + use mymod + implicit none + public + private :: s1, s2, s3, a, b, c, d, e, f, g + public :: m, n, o, p, q, r, s, t, u, v, w, x +end module m2 + +! { dg-final { scan-tree-dump-times "omp declare target" 7 "original" } } +! { dg-final { scan-tree-dump-times "__attribute__\\(\\(omp declare target \\(device_type\\(" 7 "original" } } +! { dg-final { scan-tree-dump-times "\[\n\r]\[\n\r]f1" 1 "original" } } +! { dg-final { scan-tree-dump-times "__attribute__\\(\\(omp declare target \\(device_type\\(any\\)\\)\\)\\)\[\n\r]f2" 1 "original" } } +! { dg-final { scan-tree-dump-times "__attribute__\\(\\(omp declare target \\(device_type\\(any\\)\\)\\)\\)\[\n\r]f3" 1 "original" } } +! { dg-final { scan-tree-dump-times "__attribute__\\(\\(omp declare target \\(device_type\\(host\\)\\)\\)\\)\[\n\r]f4" 1 "original" } } +! { dg-final { scan-tree-dump-times "__attribute__\\(\\(omp declare target \\(device_type\\(nohost\\)\\)\\)\\)\[\n\r]f5" 1 "original" } } +! { dg-final { scan-tree-dump-times "__attribute__\\(\\(omp declare target \\(device_type\\(any\\)\\)\\)\\)\[\n\r]s1" 1 "original" } } +! { dg-final { scan-tree-dump-times "__attribute__\\(\\(omp declare target \\(device_type\\(nohost\\)\\)\\)\\)\[\n\r]s2" 1 "original" } } +! { dg-final { scan-tree-dump-times "__attribute__\\(\\(omp declare target \\(device_type\\(host\\)\\)\\)\\)\[\n\r]s3" 1 "original" } } diff --git a/gcc/testsuite/gfortran.dg/gomp/declare-target-5.f90 b/gcc/testsuite/gfortran.dg/gomp/declare-target-5.f90 new file mode 100644 index 00000000000..76687d476d5 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/declare-target-5.f90 @@ -0,0 +1,63 @@ +subroutine foo() + !$omp declare target to(foo) device_type(bar) ! { dg-error "Expected HOST, NOHOST or ANY" } +end + +subroutine bar() + !$omp declare target to(bar) device_type(nohost) + !$omp declare target to(bar) device_type(host) ! { dg-error "previous OMP DECLARE TARGET directive to a different DEVICE_TYPE" } +end + +module mymod_one + implicit none + integer :: a, b, c, d, e ,f + integer :: m, n, o, p, q, r + common /block1/ m, n + common /block2/ o, p + common /block3/ q, r + !$omp declare target to(a) device_type(nohost) + !$omp declare target to(b) device_type(any) + !$omp declare target to(c) device_type(host) + !$omp declare target link(d) device_type(nohost) + !$omp declare target link(e) device_type(any) + !$omp declare target link(f) device_type(host) + + !$omp declare target to(c) device_type(host) + !$omp declare target link(d) device_type(nohost) +end module + +module mtest + use mymod_one ! { dg-error "Cannot change attributes of USE-associated symbol" } + implicit none + + !$omp declare target to(a) device_type(any) ! { dg-error "previous OMP DECLARE TARGET directive to a different DEVICE_TYPE" } + !$omp declare target to(b) device_type(host) ! { dg-error "previous OMP DECLARE TARGET directive to a different DEVICE_TYPE" } + !$omp declare target to(c) device_type(nohost) ! { dg-error "previous OMP DECLARE TARGET directive to a different DEVICE_TYPE" } + !$omp declare target link(d) device_type(host) ! { dg-error "previous OMP DECLARE TARGET directive to a different DEVICE_TYPE" } + !$omp declare target link(e) device_type(nohost) ! { dg-error "previous OMP DECLARE TARGET directive to a different DEVICE_TYPE" } + !$omp declare target link(f) device_type(any) ! { dg-error "previous OMP DECLARE TARGET directive to a different DEVICE_TYPE" } +end module + +module mymod + implicit none + integer :: a, b, c, d, e ,f + integer :: m, n, o, p, q, r + common /block1/ m, n + common /block2/ o, p + common /block3/ q, r + !$omp declare target to(a) device_type(nohost) + !$omp declare target to(b) device_type(any) + !$omp declare target to(c) device_type(host) + !$omp declare target link(d) device_type(nohost) + !$omp declare target link(e) device_type(any) + !$omp declare target link(f) device_type(host) + + !$omp declare target to(c) device_type(host) + !$omp declare target link(d) device_type(nohost) + + !$omp declare target to(a) device_type(any) ! { dg-error "previous OMP DECLARE TARGET directive to a different DEVICE_TYPE" } + !$omp declare target to(b) device_type(host) ! { dg-error "previous OMP DECLARE TARGET directive to a different DEVICE_TYPE" } + !$omp declare target to(c) device_type(nohost) ! { dg-error "previous OMP DECLARE TARGET directive to a different DEVICE_TYPE" } + !$omp declare target link(d) device_type(host) ! { dg-error "previous OMP DECLARE TARGET directive to a different DEVICE_TYPE" } + !$omp declare target link(e) device_type(nohost) ! { dg-error "previous OMP DECLARE TARGET directive to a different DEVICE_TYPE" } + !$omp declare target link(f) device_type(any) ! { dg-error "previous OMP DECLARE TARGET directive to a different DEVICE_TYPE" } +end --------------26E412DCD8957E65057D5193--