From patchwork Tue Sep 5 19:28:27 2023 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Julian Brown X-Patchwork-Id: 1830103 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@legolas.ozlabs.org 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 4RgFxF2tQKz1ygx for ; Wed, 6 Sep 2023 05:31:29 +1000 (AEST) Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 7157C385483A for ; Tue, 5 Sep 2023 19:31:27 +0000 (GMT) X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from esa2.mentor.iphmx.com (esa2.mentor.iphmx.com [68.232.141.98]) by sourceware.org (Postfix) with ESMTPS id AD2633882AE8; Tue, 5 Sep 2023 19:30:18 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org AD2633882AE8 Authentication-Results: sourceware.org; dmarc=none (p=none dis=none) header.from=codesourcery.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=mentor.com X-IronPort-AV: E=Sophos;i="6.02,229,1688457600"; d="scan'208";a="18105093" Received: from orw-gwy-02-in.mentorg.com ([192.94.38.167]) by esa2.mentor.iphmx.com with ESMTP; 05 Sep 2023 11:30:18 -0800 IronPort-SDR: XAhDSxPmhS2aCqcjD58A/kxgeL69uWIT5BFjaCaUPM8vWKh8FKxvhoNZNQkAXR0S5RSaet5VTD jFkExhg9HrxEfV5t70usRrJGp82lCdnACI6vG6Z9p9rJKs0PG5MnMkJWnIKswJ0tL3Yt/FxEIh oMZ8t19pqYO81yCctkH4F0A7i1ZRp4wM6Mukd1B/meR9diMFkCd+pcUXW1+5UDkjNfIm1JBKXW 5p0yv5aGb2hbuYkjJohYlS/nbpLLUxcrm7+NegHCynMN7/YI+GCVlSelVLGkI8l9B8t6UkAa9Z fQQ= From: Julian Brown To: CC: , , Subject: [PATCH 7/8] OpenMP, Fortran: Split out OMP clause checking Date: Tue, 5 Sep 2023 12:28:27 -0700 Message-ID: X-Mailer: git-send-email 2.41.0 In-Reply-To: References: MIME-Version: 1.0 X-Originating-IP: [137.202.0.90] X-ClientProxiedBy: svr-ies-mbx-14.mgc.mentorg.com (139.181.222.14) To svr-ies-mbx-11.mgc.mentorg.com (139.181.222.11) X-Spam-Status: No, score=-11.3 required=5.0 tests=BAYES_00, GIT_PATCH_0, HEADER_FROM_DIFFERENT_DOMAINS, KAM_DMARC_STATUS, SCC_5_SHORT_WORD_LINES, SPF_HELO_PASS, SPF_PASS, TXREP 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 Sender: "Gcc-patches" This patch breaks out two helper functions from openmp.cc:resolve_omp_clauses, so those parts can be reused in order to improve diagnostics (duplicate clause checking, etc.) after "declare mapper" instantiation in the patch later in this series. This is pretty mechanical -- most previous lines are still executed in the same order, though there is a little harmless reshuffling in a couple of places to make things fit. There shouldn't be any behavioural changes introduced by this patch. 2023-09-05 Julian Brown gcc/fortran/ * openmp.cc (omp_verify_clauses_symbol_dups, omp_verify_map_motion_clauses): New helper functions, broken out of... (resolve_omp_clauses): Here. Call above. --- gcc/fortran/openmp.cc | 1229 +++++++++++++++++++++-------------------- 1 file changed, 629 insertions(+), 600 deletions(-) diff --git a/gcc/fortran/openmp.cc b/gcc/fortran/openmp.cc index 576b6784b441..1e0da61e9693 100644 --- a/gcc/fortran/openmp.cc +++ b/gcc/fortran/openmp.cc @@ -7314,6 +7314,631 @@ gfc_resolve_omp_assumptions (gfc_omp_assumptions *assume) &el->expr->where); } +/* Check OMP_CLAUSES for duplicate symbols and various other constraints. + Helper function for resolve_omp_clauses. */ + +static void +omp_verify_clauses_symbol_dups (gfc_code *code, gfc_omp_clauses *omp_clauses, + gfc_namespace *ns, bool openacc) +{ + gfc_omp_namelist *n; + int list; + + /* Check that no symbol appears on multiple clauses, except that a symbol + can appear on both firstprivate and lastprivate. */ + for (list = 0; list < OMP_LIST_NUM; list++) + for (n = omp_clauses->lists[list]; n; n = n->next) + { + if (!n->sym) /* omp_all_memory. */ + continue; + n->sym->mark = 0; + n->sym->comp_mark = 0; + n->sym->data_mark = 0; + n->sym->dev_mark = 0; + n->sym->gen_mark = 0; + n->sym->reduc_mark = 0; + if (n->sym->attr.flavor == FL_VARIABLE + || n->sym->attr.proc_pointer + || (!code + && !ns->omp_udm_ns + && (!n->sym->attr.dummy || n->sym->ns != ns))) + { + if (!code + && !ns->omp_udm_ns + && (!n->sym->attr.dummy || n->sym->ns != ns)) + gfc_error ("Variable %qs is not a dummy argument at %L", + n->sym->name, &n->where); + continue; + } + if (n->sym->attr.flavor == FL_PROCEDURE + && n->sym->result == n->sym + && n->sym->attr.function) + { + if (gfc_current_ns->proc_name == n->sym + || (gfc_current_ns->parent + && gfc_current_ns->parent->proc_name == n->sym)) + continue; + if (gfc_current_ns->proc_name->attr.entry_master) + { + gfc_entry_list *el = gfc_current_ns->entries; + for (; el; el = el->next) + if (el->sym == n->sym) + break; + if (el) + continue; + } + if (gfc_current_ns->parent + && gfc_current_ns->parent->proc_name->attr.entry_master) + { + gfc_entry_list *el = gfc_current_ns->parent->entries; + for (; el; el = el->next) + if (el->sym == n->sym) + break; + if (el) + continue; + } + } + if (list == OMP_LIST_MAP + && n->sym->attr.flavor == FL_PARAMETER) + { + if (openacc) + gfc_error ("Object %qs is not a variable at %L; parameters" + " cannot be and need not be copied", n->sym->name, + &n->where); + else + gfc_error ("Object %qs is not a variable at %L; parameters" + " cannot be and need not be mapped", n->sym->name, + &n->where); + } + else if (list != OMP_LIST_USES_ALLOCATORS) + gfc_error ("Object %qs is not a variable at %L", n->sym->name, + &n->where); + } + if (omp_clauses->lists[OMP_LIST_REDUCTION_INSCAN] + && code->op != EXEC_OMP_DO + && code->op != EXEC_OMP_SIMD + && code->op != EXEC_OMP_DO_SIMD + && code->op != EXEC_OMP_PARALLEL_DO + && code->op != EXEC_OMP_PARALLEL_DO_SIMD) + gfc_error ("% REDUCTION clause on construct other than DO, SIMD, " + "DO SIMD, PARALLEL DO, PARALLEL DO SIMD at %L", + &omp_clauses->lists[OMP_LIST_REDUCTION_INSCAN]->where); + + for (list = 0; list < OMP_LIST_NUM; list++) + if (list != OMP_LIST_FIRSTPRIVATE + && list != OMP_LIST_LASTPRIVATE + && list != OMP_LIST_ALIGNED + && list != OMP_LIST_DEPEND + && list != OMP_LIST_FROM + && list != OMP_LIST_TO + && (list != OMP_LIST_REDUCTION || !openacc) + && list != OMP_LIST_ALLOCATE) + for (n = omp_clauses->lists[list]; n; n = n->next) + { + bool component_ref_p = false; + + /* Allow multiple components of the same (e.g. derived-type) + variable here. Duplicate components are detected elsewhere. */ + if (n->expr && n->expr->expr_type == EXPR_VARIABLE) + for (gfc_ref *ref = n->expr->ref; ref; ref = ref->next) + if (ref->type == REF_COMPONENT) + component_ref_p = true; + if ((list == OMP_LIST_IS_DEVICE_PTR + || list == OMP_LIST_HAS_DEVICE_ADDR) + && !component_ref_p) + { + if (n->sym->gen_mark + || n->sym->dev_mark + || n->sym->reduc_mark + || n->sym->mark) + gfc_error ("Symbol %qs present on multiple clauses at %L", + n->sym->name, &n->where); + else + n->sym->dev_mark = 1; + } + else if ((list == OMP_LIST_USE_DEVICE_PTR + || list == OMP_LIST_USE_DEVICE_ADDR + || list == OMP_LIST_PRIVATE + || list == OMP_LIST_SHARED) + && !component_ref_p) + { + if (n->sym->gen_mark || n->sym->dev_mark || n->sym->reduc_mark) + gfc_error ("Symbol %qs present on multiple clauses at %L", + n->sym->name, &n->where); + else + { + n->sym->gen_mark = 1; + /* Set both generic and device bits if we have + use_device_*(x) or shared(x). This allows us to diagnose + "map(x) private(x)" below. */ + if (list != OMP_LIST_PRIVATE) + n->sym->dev_mark = 1; + } + } + else if ((list == OMP_LIST_REDUCTION + || list == OMP_LIST_REDUCTION_TASK + || list == OMP_LIST_REDUCTION_INSCAN + || list == OMP_LIST_IN_REDUCTION + || list == OMP_LIST_TASK_REDUCTION) + && !component_ref_p) + { + /* Attempts to mix reduction types are diagnosed below. */ + if (n->sym->gen_mark || n->sym->dev_mark) + gfc_error ("Symbol %qs present on multiple clauses at %L", + n->sym->name, &n->where); + n->sym->reduc_mark = 1; + } + else if ((!component_ref_p && n->sym->comp_mark) + || (component_ref_p && n->sym->mark)) + { + if (openacc) + gfc_error ("Symbol %qs has mixed component and non-component " + "accesses at %L", n->sym->name, &n->where); + } + else if (n->sym->mark) + gfc_error ("Symbol %qs present on multiple clauses at %L", + n->sym->name, &n->where); + else + { + if (component_ref_p) + n->sym->comp_mark = 1; + else + n->sym->mark = 1; + } + } + + /* Detect specifically the case where we have "map(x) private(x)" and raise + an error. If we have "...simd" combined directives though, the "private" + applies to the simd part, so this is permitted. */ + for (n = omp_clauses->lists[OMP_LIST_PRIVATE]; n; n = n->next) + if (n->sym->mark + && n->sym->gen_mark + && !n->sym->dev_mark + && !n->sym->reduc_mark + && code->op != EXEC_OMP_TARGET_SIMD + && code->op != EXEC_OMP_TARGET_PARALLEL_DO_SIMD + && code->op != EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD + && code->op != EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD) + gfc_error ("Symbol %qs present on multiple clauses at %L", n->sym->name, + &n->where); + + gcc_assert (OMP_LIST_LASTPRIVATE == OMP_LIST_FIRSTPRIVATE + 1); + for (list = OMP_LIST_FIRSTPRIVATE; list <= OMP_LIST_LASTPRIVATE; list++) + { + gfc_omp_namelist **pn = &omp_clauses->lists[list]; + while ((n = *pn) != NULL) + { + bool remove = false; + + if (n->sym->data_mark || n->sym->gen_mark || n->sym->dev_mark) + { + gfc_error ("Symbol %qs present on multiple clauses at %L", + n->sym->name, &n->where); + n->sym->data_mark = n->sym->gen_mark = n->sym->dev_mark = 0; + } + else if (n->sym->mark + && code->op != EXEC_OMP_TARGET_TEAMS + && code->op != EXEC_OMP_TARGET_TEAMS_DISTRIBUTE + && code->op != EXEC_OMP_TARGET_TEAMS_LOOP + && code->op != EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD + && code->op != EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO + && code->op != EXEC_OMP_TARGET_PARALLEL + && code->op != EXEC_OMP_TARGET_PARALLEL_DO + && code->op != EXEC_OMP_TARGET_PARALLEL_LOOP + && code->op != EXEC_OMP_TARGET_PARALLEL_DO_SIMD + && (code->op + != EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD)) + { + gfc_error ("Symbol %qs present on both data and map clauses " + "at %L", n->sym->name, &n->where); + /* We've already shown an error. Avoid confusing gimplify. */ + remove = true; + } + + if (remove) + *pn = n->next; + else + pn = &n->next; + } + } + + for (n = omp_clauses->lists[OMP_LIST_FIRSTPRIVATE]; n; n = n->next) + { + if (n->sym->data_mark || n->sym->gen_mark || n->sym->dev_mark) + gfc_error ("Symbol %qs present on multiple clauses at %L", + n->sym->name, &n->where); + else + n->sym->data_mark = 1; + } + for (n = omp_clauses->lists[OMP_LIST_LASTPRIVATE]; n; n = n->next) + n->sym->data_mark = 0; + + for (n = omp_clauses->lists[OMP_LIST_LASTPRIVATE]; n; n = n->next) + { + if (n->sym->data_mark || n->sym->gen_mark || n->sym->dev_mark) + gfc_error ("Symbol %qs present on multiple clauses at %L", + n->sym->name, &n->where); + else + n->sym->data_mark = 1; + } + + for (n = omp_clauses->lists[OMP_LIST_ALIGNED]; n; n = n->next) + n->sym->mark = 0; + + for (n = omp_clauses->lists[OMP_LIST_ALIGNED]; n; n = n->next) + { + if (n->sym->mark) + gfc_error ("Symbol %qs present on multiple clauses at %L", + n->sym->name, &n->where); + else + n->sym->mark = 1; + } + + if (omp_clauses->lists[OMP_LIST_ALLOCATE]) + { + for (n = omp_clauses->lists[OMP_LIST_ALLOCATE]; n; n = n->next) + { + if (n->u2.allocator + && (!gfc_resolve_expr (n->u2.allocator) + || n->u2.allocator->ts.type != BT_INTEGER + || n->u2.allocator->rank != 0 + || n->u2.allocator->ts.kind != gfc_c_intptr_kind)) + { + gfc_error ("Expected integer expression of the " + "% kind at %L", + &n->u2.allocator->where); + break; + } + if (!n->u.align) + continue; + HOST_WIDE_INT alignment = 0; + if (!gfc_resolve_expr (n->u.align) + || n->u.align->ts.type != BT_INTEGER + || n->u.align->rank != 0 + || n->u.align->expr_type != EXPR_CONSTANT + || gfc_extract_hwi (n->u.align, &alignment) + || alignment <= 0 + || !pow2p_hwi (alignment)) + { + gfc_error ("ALIGN requires a scalar positive constant integer " + "alignment expression at %L that is a power of two", + &n->u.align->where); + break; + } + } + + /* Check for 2 things here. + 1. There is no duplication of variable in allocate clause. + 2. Variable in allocate clause are also present in some + privatization clase (non-composite case). */ + for (n = omp_clauses->lists[OMP_LIST_ALLOCATE]; n; n = n->next) + if (n->sym) + n->sym->mark = 0; + + gfc_omp_namelist *prev = NULL; + for (n = omp_clauses->lists[OMP_LIST_ALLOCATE]; n; ) + { + if (n->sym == NULL) + { + n = n->next; + continue; + } + if (n->sym->mark == 1) + { + gfc_warning (0, "%qs appears more than once in % " + "at %L" , n->sym->name, &n->where); + /* We have already seen this variable so it is a duplicate. + Remove it. */ + if (prev != NULL && prev->next == n) + { + prev->next = n->next; + n->next = NULL; + gfc_free_omp_namelist (n, OMP_LIST_ALLOCATE); + n = prev->next; + } + continue; + } + n->sym->mark = 1; + prev = n; + n = n->next; + } + + /* Non-composite constructs. */ + if (code && code->op < EXEC_OMP_DO_SIMD) + { + for (list = 0; list < OMP_LIST_NUM; list++) + switch (list) + { + case OMP_LIST_PRIVATE: + case OMP_LIST_FIRSTPRIVATE: + case OMP_LIST_LASTPRIVATE: + case OMP_LIST_REDUCTION: + case OMP_LIST_REDUCTION_INSCAN: + case OMP_LIST_REDUCTION_TASK: + case OMP_LIST_IN_REDUCTION: + case OMP_LIST_TASK_REDUCTION: + case OMP_LIST_LINEAR: + for (n = omp_clauses->lists[list]; n; n = n->next) + n->sym->mark = 0; + break; + default: + break; + } + + for (n = omp_clauses->lists[OMP_LIST_ALLOCATE]; n; n = n->next) + if (n->sym->mark == 1) + gfc_error ("%qs specified in % clause at %L but not " + "in an explicit privatization clause", n->sym->name, + &n->where); + } + if (code + && (code->op == EXEC_OMP_ALLOCATORS || code->op == EXEC_OMP_ALLOCATE) + && code->block + && code->block->next + && code->block->next->op == EXEC_ALLOCATE) + { + gfc_alloc *a; + for (n = omp_clauses->lists[OMP_LIST_ALLOCATE]; n; n = n->next) + { + if (n->sym == NULL) + continue; + for (a = code->block->next->ext.alloc.list; a; a = a->next) + if (a->expr->expr_type == EXPR_VARIABLE + && a->expr->symtree->n.sym == n->sym) + break; + if (a == NULL) + gfc_error ("%qs specified in % at %L but not " + "in the associated ALLOCATE statement", + n->sym->name, &n->where); + } + } + } + + for (n = omp_clauses->lists[OMP_LIST_TO]; n; n = n->next) + n->sym->mark = 0; + for (n = omp_clauses->lists[OMP_LIST_FROM]; n; n = n->next) + if (n->expr == NULL) + n->sym->mark = 1; + for (n = omp_clauses->lists[OMP_LIST_TO]; n; n = n->next) + { + if (n->expr == NULL && n->sym->mark) + gfc_error ("Symbol %qs present on both FROM and TO clauses at %L", + n->sym->name, &n->where); + else + n->sym->mark = 1; + } +} + +/* Check that the parameter of a MAP, TO and FROM clause N meets certain + constraints. Helper function for resolve_omp_clauses. */ + +static bool +omp_verify_map_motion_clauses (gfc_code *code, int list, const char *name, + gfc_omp_namelist *n, bool openacc) +{ + gfc_ref *lastref = NULL, *lastslice = NULL; + bool resolved = false; + if (n->expr) + { + lastref = n->expr->ref; + resolved = gfc_resolve_expr (n->expr); + + /* Look through component refs to find last array reference. */ + if (resolved) + { + for (gfc_ref *ref = n->expr->ref; ref; ref = ref->next) + if (ref->type == REF_COMPONENT + || ref->type == REF_SUBSTRING + || ref->type == REF_INQUIRY) + lastref = ref; + else if (ref->type == REF_ARRAY) + { + for (int i = 0; i < ref->u.ar.dimen; i++) + if (ref->u.ar.dimen_type[i] == DIMEN_RANGE) + lastslice = ref; + + lastref = ref; + } + + /* The "!$acc cache" directive allows rectangular subarrays to be + specified, with some restrictions on the form of bounds (not + implemented). + Only raise an error here if we're really sure the array isn't + contiguous. An expression such as arr(-n:n,-n:n) could be + contiguous even if it looks like it may not be. Also OpenMP's + 'target update' permits strides for the to/from clause. */ + if (code + && code->op != EXEC_OACC_UPDATE + && code->op != EXEC_OMP_TARGET_UPDATE + && list != OMP_LIST_CACHE + && list != OMP_LIST_DEPEND + && !gfc_is_simply_contiguous (n->expr, false, true) + && gfc_is_not_contiguous (n->expr) + && !(lastslice && (lastslice->next + || lastslice->type != REF_ARRAY))) + gfc_error ("Array is not contiguous at %L", &n->where); + } + } + if (openacc + && list == OMP_LIST_MAP + && (n->u.map_op == OMP_MAP_ATTACH || n->u.map_op == OMP_MAP_DETACH)) + { + symbol_attribute attr; + if (n->expr) + attr = gfc_expr_attr (n->expr); + else + attr = n->sym->attr; + if (!attr.pointer && !attr.allocatable) + gfc_error ("%qs clause argument must be ALLOCATABLE or a POINTER " + "at %L", + (n->u.map_op == OMP_MAP_ATTACH) ? "attach" : "detach", + &n->where); + } + if (lastref + || (n->expr && (!resolved || n->expr->expr_type != EXPR_VARIABLE))) + { + if (!lastslice && lastref && lastref->type == REF_SUBSTRING) + gfc_error ("Unexpected substring reference in %s clause at %L", name, + &n->where); + else if (!lastslice && lastref && lastref->type == REF_INQUIRY) + { + gcc_assert (lastref->u.i == INQUIRY_RE + || lastref->u.i == INQUIRY_IM); + gfc_error ("Unexpected complex-parts designator reference in %s " + "clause at %L", name, &n->where); + } + else if (!resolved + || n->expr->expr_type != EXPR_VARIABLE + || (lastslice + && (lastslice->next || lastslice->type != REF_ARRAY))) + gfc_error ("%qs in %s clause at %L is not a proper array section", + n->sym->name, name, &n->where); + else if (lastslice) + { + int i; + gfc_array_ref *ar = &lastslice->u.ar; + for (i = 0; i < ar->dimen; i++) + if (ar->stride[i] && code && code->op != EXEC_OACC_UPDATE) + { + gfc_error ("Stride should not be specified for array section " + "in %s clause at %L", name, &n->where); + return false; + } + else if (ar->dimen_type[i] != DIMEN_ELEMENT + && ar->dimen_type[i] != DIMEN_RANGE) + { + gfc_error ("%qs in %s clause at %L is not a proper array " + "section", n->sym->name, name, &n->where); + return false; + } + else if ((list == OMP_LIST_DEPEND || list == OMP_LIST_AFFINITY) + && ar->start[i] + && ar->start[i]->expr_type == EXPR_CONSTANT + && ar->end[i] + && ar->end[i]->expr_type == EXPR_CONSTANT + && mpz_cmp (ar->start[i]->value.integer, + ar->end[i]->value.integer) > 0) + { + gfc_error ("%qs in %s clause at %L is a zero size array " + "section", n->sym->name, + list == OMP_LIST_DEPEND ? "DEPEND" : "AFFINITY", + &n->where); + return false; + } + } + } + else if (openacc) + { + if (list == OMP_LIST_MAP && n->u.map_op == OMP_MAP_FORCE_DEVICEPTR) + resolve_oacc_deviceptr_clause (n->sym, n->where, name); + else + resolve_oacc_data_clauses (n->sym, n->where, name); + } + else if (list != OMP_LIST_DEPEND + && n->sym->as + && n->sym->as->type == AS_ASSUMED_SIZE) + gfc_error ("Assumed size array %qs in %s clause at %L", + n->sym->name, name, &n->where); + if (!openacc + && list == OMP_LIST_MAP + && n->sym->ts.type == BT_DERIVED + && n->sym->ts.u.derived->attr.alloc_comp) + gfc_error ("List item %qs with allocatable components is not permitted " + "in map clause at %L", n->sym->name, &n->where); + + if (!code || list != OMP_LIST_MAP || openacc) + return true; + + switch (code->op) + { + case EXEC_OMP_TARGET: + case EXEC_OMP_TARGET_DATA: + switch (n->u.map_op) + { + case OMP_MAP_TO: + case OMP_MAP_ALWAYS_TO: + case OMP_MAP_PRESENT_TO: + case OMP_MAP_ALWAYS_PRESENT_TO: + case OMP_MAP_FROM: + case OMP_MAP_ALWAYS_FROM: + case OMP_MAP_PRESENT_FROM: + case OMP_MAP_ALWAYS_PRESENT_FROM: + case OMP_MAP_TOFROM: + case OMP_MAP_ALWAYS_TOFROM: + case OMP_MAP_PRESENT_TOFROM: + case OMP_MAP_ALWAYS_PRESENT_TOFROM: + case OMP_MAP_ALLOC: + case OMP_MAP_PRESENT_ALLOC: + break; + default: + gfc_error ("TARGET%s with map-type other than TO, FROM, TOFROM, or " + "ALLOC on MAP clause at %L", + code->op == EXEC_OMP_TARGET ? "" : " DATA", &n->where); + break; + } + break; + case EXEC_OMP_TARGET_ENTER_DATA: + switch (n->u.map_op) + { + case OMP_MAP_TO: + case OMP_MAP_ALWAYS_TO: + case OMP_MAP_PRESENT_TO: + case OMP_MAP_ALWAYS_PRESENT_TO: + case OMP_MAP_ALLOC: + case OMP_MAP_PRESENT_ALLOC: + break; + case OMP_MAP_TOFROM: + n->u.map_op = OMP_MAP_TO; + break; + case OMP_MAP_ALWAYS_TOFROM: + n->u.map_op = OMP_MAP_ALWAYS_TO; + break; + case OMP_MAP_PRESENT_TOFROM: + n->u.map_op = OMP_MAP_PRESENT_TO; + break; + case OMP_MAP_ALWAYS_PRESENT_TOFROM: + n->u.map_op = OMP_MAP_ALWAYS_PRESENT_TO; + break; + default: + gfc_error ("TARGET ENTER DATA with map-type other than TO, TOFROM " + "or ALLOC on MAP clause at %L", &n->where); + break; + } + break; + case EXEC_OMP_TARGET_EXIT_DATA: + switch (n->u.map_op) + { + case OMP_MAP_FROM: + case OMP_MAP_ALWAYS_FROM: + case OMP_MAP_PRESENT_FROM: + case OMP_MAP_ALWAYS_PRESENT_FROM: + case OMP_MAP_RELEASE: + case OMP_MAP_DELETE: + break; + case OMP_MAP_TOFROM: + n->u.map_op = OMP_MAP_FROM; + break; + case OMP_MAP_ALWAYS_TOFROM: + n->u.map_op = OMP_MAP_ALWAYS_FROM; + break; + case OMP_MAP_PRESENT_TOFROM: + n->u.map_op = OMP_MAP_PRESENT_FROM; + break; + case OMP_MAP_ALWAYS_PRESENT_TOFROM: + n->u.map_op = OMP_MAP_ALWAYS_PRESENT_FROM; + break; + default: + gfc_error ("TARGET EXIT DATA with map-type other than FROM, TOFROM, " + "RELEASE, or DELETE on MAP clause at %L", &n->where); + break; + } + break; + default: + ; + } + + return true; +} /* OpenMP directive resolving routines. */ @@ -7540,355 +8165,7 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, gfc_error ("DEPOBJ in DEPOBJ construct at %L shall be a scalar integer " "of OMP_DEPEND_KIND kind", &omp_clauses->depobj->where); - /* Check that no symbol appears on multiple clauses, except that - a symbol can appear on both firstprivate and lastprivate. */ - for (list = 0; list < OMP_LIST_NUM; list++) - for (n = omp_clauses->lists[list]; n; n = n->next) - { - if (!n->sym) /* omp_all_memory. */ - continue; - n->sym->mark = 0; - n->sym->comp_mark = 0; - n->sym->data_mark = 0; - n->sym->dev_mark = 0; - n->sym->gen_mark = 0; - n->sym->reduc_mark = 0; - if (n->sym->attr.flavor == FL_VARIABLE - || n->sym->attr.proc_pointer - || (!code && (!n->sym->attr.dummy || n->sym->ns != ns))) - { - if (!code && (!n->sym->attr.dummy || n->sym->ns != ns)) - gfc_error ("Variable %qs is not a dummy argument at %L", - n->sym->name, &n->where); - continue; - } - if (n->sym->attr.flavor == FL_PROCEDURE - && n->sym->result == n->sym - && n->sym->attr.function) - { - if (gfc_current_ns->proc_name == n->sym - || (gfc_current_ns->parent - && gfc_current_ns->parent->proc_name == n->sym)) - continue; - if (gfc_current_ns->proc_name->attr.entry_master) - { - gfc_entry_list *el = gfc_current_ns->entries; - for (; el; el = el->next) - if (el->sym == n->sym) - break; - if (el) - continue; - } - if (gfc_current_ns->parent - && gfc_current_ns->parent->proc_name->attr.entry_master) - { - gfc_entry_list *el = gfc_current_ns->parent->entries; - for (; el; el = el->next) - if (el->sym == n->sym) - break; - if (el) - continue; - } - } - if (list == OMP_LIST_MAP - && n->sym->attr.flavor == FL_PARAMETER) - { - if (openacc) - gfc_error ("Object %qs is not a variable at %L; parameters" - " cannot be and need not be copied", n->sym->name, - &n->where); - else - gfc_error ("Object %qs is not a variable at %L; parameters" - " cannot be and need not be mapped", n->sym->name, - &n->where); - } - else if (list != OMP_LIST_USES_ALLOCATORS) - gfc_error ("Object %qs is not a variable at %L", n->sym->name, - &n->where); - } - if (omp_clauses->lists[OMP_LIST_REDUCTION_INSCAN] - && code->op != EXEC_OMP_DO - && code->op != EXEC_OMP_SIMD - && code->op != EXEC_OMP_DO_SIMD - && code->op != EXEC_OMP_PARALLEL_DO - && code->op != EXEC_OMP_PARALLEL_DO_SIMD) - gfc_error ("% REDUCTION clause on construct other than DO, SIMD, " - "DO SIMD, PARALLEL DO, PARALLEL DO SIMD at %L", - &omp_clauses->lists[OMP_LIST_REDUCTION_INSCAN]->where); - - for (list = 0; list < OMP_LIST_NUM; list++) - if (list != OMP_LIST_FIRSTPRIVATE - && list != OMP_LIST_LASTPRIVATE - && list != OMP_LIST_ALIGNED - && list != OMP_LIST_DEPEND - && list != OMP_LIST_FROM - && list != OMP_LIST_TO - && (list != OMP_LIST_REDUCTION || !openacc) - && list != OMP_LIST_ALLOCATE) - for (n = omp_clauses->lists[list]; n; n = n->next) - { - bool component_ref_p = false; - - /* Allow multiple components of the same (e.g. derived-type) - variable here. Duplicate components are detected elsewhere. */ - if (n->expr && n->expr->expr_type == EXPR_VARIABLE) - for (gfc_ref *ref = n->expr->ref; ref; ref = ref->next) - if (ref->type == REF_COMPONENT) - component_ref_p = true; - if ((list == OMP_LIST_IS_DEVICE_PTR - || list == OMP_LIST_HAS_DEVICE_ADDR) - && !component_ref_p) - { - if (n->sym->gen_mark - || n->sym->dev_mark - || n->sym->reduc_mark - || n->sym->mark) - gfc_error ("Symbol %qs present on multiple clauses at %L", - n->sym->name, &n->where); - else - n->sym->dev_mark = 1; - } - else if ((list == OMP_LIST_USE_DEVICE_PTR - || list == OMP_LIST_USE_DEVICE_ADDR - || list == OMP_LIST_PRIVATE - || list == OMP_LIST_SHARED) - && !component_ref_p) - { - if (n->sym->gen_mark || n->sym->dev_mark || n->sym->reduc_mark) - gfc_error ("Symbol %qs present on multiple clauses at %L", - n->sym->name, &n->where); - else - { - n->sym->gen_mark = 1; - /* Set both generic and device bits if we have - use_device_*(x) or shared(x). This allows us to diagnose - "map(x) private(x)" below. */ - if (list != OMP_LIST_PRIVATE) - n->sym->dev_mark = 1; - } - } - else if ((list == OMP_LIST_REDUCTION - || list == OMP_LIST_REDUCTION_TASK - || list == OMP_LIST_REDUCTION_INSCAN - || list == OMP_LIST_IN_REDUCTION - || list == OMP_LIST_TASK_REDUCTION) - && !component_ref_p) - { - /* Attempts to mix reduction types are diagnosed below. */ - if (n->sym->gen_mark || n->sym->dev_mark) - gfc_error ("Symbol %qs present on multiple clauses at %L", - n->sym->name, &n->where); - n->sym->reduc_mark = 1; - } - else if ((!component_ref_p && n->sym->comp_mark) - || (component_ref_p && n->sym->mark)) - { - if (openacc) - gfc_error ("Symbol %qs has mixed component and non-component " - "accesses at %L", n->sym->name, &n->where); - } - else if (n->sym->mark) - gfc_error ("Symbol %qs present on multiple clauses at %L", - n->sym->name, &n->where); - else - { - if (component_ref_p) - n->sym->comp_mark = 1; - else - n->sym->mark = 1; - } - } - - /* Detect specifically the case where we have "map(x) private(x)" and raise - an error. If we have "...simd" combined directives though, the "private" - applies to the simd part, so this is permitted though. */ - for (n = omp_clauses->lists[OMP_LIST_PRIVATE]; n; n = n->next) - if (n->sym->mark - && n->sym->gen_mark - && !n->sym->dev_mark - && !n->sym->reduc_mark - && code->op != EXEC_OMP_TARGET_SIMD - && code->op != EXEC_OMP_TARGET_PARALLEL_DO_SIMD - && code->op != EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD - && code->op != EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD) - gfc_error ("Symbol %qs present on multiple clauses at %L", - n->sym->name, &n->where); - - gcc_assert (OMP_LIST_LASTPRIVATE == OMP_LIST_FIRSTPRIVATE + 1); - for (list = OMP_LIST_FIRSTPRIVATE; list <= OMP_LIST_LASTPRIVATE; list++) - for (n = omp_clauses->lists[list]; n; n = n->next) - if (n->sym->data_mark || n->sym->gen_mark || n->sym->dev_mark) - { - gfc_error ("Symbol %qs present on multiple clauses at %L", - n->sym->name, &n->where); - n->sym->data_mark = n->sym->gen_mark = n->sym->dev_mark = 0; - } - else if (n->sym->mark - && code->op != EXEC_OMP_TARGET_TEAMS - && code->op != EXEC_OMP_TARGET_TEAMS_DISTRIBUTE - && code->op != EXEC_OMP_TARGET_TEAMS_LOOP - && code->op != EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD - && code->op != EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO - && code->op != EXEC_OMP_TARGET_PARALLEL - && code->op != EXEC_OMP_TARGET_PARALLEL_DO - && code->op != EXEC_OMP_TARGET_PARALLEL_LOOP - && code->op != EXEC_OMP_TARGET_PARALLEL_DO_SIMD - && code->op != EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD) - gfc_error ("Symbol %qs present on both data and map clauses " - "at %L", n->sym->name, &n->where); - - for (n = omp_clauses->lists[OMP_LIST_FIRSTPRIVATE]; n; n = n->next) - { - if (n->sym->data_mark || n->sym->gen_mark || n->sym->dev_mark) - gfc_error ("Symbol %qs present on multiple clauses at %L", - n->sym->name, &n->where); - else - n->sym->data_mark = 1; - } - for (n = omp_clauses->lists[OMP_LIST_LASTPRIVATE]; n; n = n->next) - n->sym->data_mark = 0; - - for (n = omp_clauses->lists[OMP_LIST_LASTPRIVATE]; n; n = n->next) - { - if (n->sym->data_mark || n->sym->gen_mark || n->sym->dev_mark) - gfc_error ("Symbol %qs present on multiple clauses at %L", - n->sym->name, &n->where); - else - n->sym->data_mark = 1; - } - - for (n = omp_clauses->lists[OMP_LIST_ALIGNED]; n; n = n->next) - n->sym->mark = 0; - - for (n = omp_clauses->lists[OMP_LIST_ALIGNED]; n; n = n->next) - { - if (n->sym->mark) - gfc_error ("Symbol %qs present on multiple clauses at %L", - n->sym->name, &n->where); - else - n->sym->mark = 1; - } - - if (omp_clauses->lists[OMP_LIST_ALLOCATE]) - { - for (n = omp_clauses->lists[OMP_LIST_ALLOCATE]; n; n = n->next) - { - if (n->u2.allocator - && (!gfc_resolve_expr (n->u2.allocator) - || n->u2.allocator->ts.type != BT_INTEGER - || n->u2.allocator->rank != 0 - || n->u2.allocator->ts.kind != gfc_c_intptr_kind)) - { - gfc_error ("Expected integer expression of the " - "% kind at %L", - &n->u2.allocator->where); - break; - } - if (!n->u.align) - continue; - HOST_WIDE_INT alignment = 0; - if (!gfc_resolve_expr (n->u.align) - || n->u.align->ts.type != BT_INTEGER - || n->u.align->rank != 0 - || n->u.align->expr_type != EXPR_CONSTANT - || gfc_extract_hwi (n->u.align, &alignment) - || alignment <= 0 - || !pow2p_hwi (alignment)) - { - gfc_error ("ALIGN requires a scalar positive constant integer " - "alignment expression at %L that is a power of two", - &n->u.align->where); - break; - } - } - - /* Check for 2 things here. - 1. There is no duplication of variable in allocate clause. - 2. Variable in allocate clause are also present in some - privatization clase (non-composite case). */ - for (n = omp_clauses->lists[OMP_LIST_ALLOCATE]; n; n = n->next) - if (n->sym) - n->sym->mark = 0; - - gfc_omp_namelist *prev = NULL; - for (n = omp_clauses->lists[OMP_LIST_ALLOCATE]; n; ) - { - if (n->sym == NULL) - { - n = n->next; - continue; - } - if (n->sym->mark == 1) - { - gfc_warning (0, "%qs appears more than once in % " - "at %L" , n->sym->name, &n->where); - /* We have already seen this variable so it is a duplicate. - Remove it. */ - if (prev != NULL && prev->next == n) - { - prev->next = n->next; - n->next = NULL; - gfc_free_omp_namelist (n, OMP_LIST_ALLOCATE); - n = prev->next; - } - continue; - } - n->sym->mark = 1; - prev = n; - n = n->next; - } - - /* Non-composite constructs. */ - if (code && code->op < EXEC_OMP_DO_SIMD) - { - for (list = 0; list < OMP_LIST_NUM; list++) - switch (list) - { - case OMP_LIST_PRIVATE: - case OMP_LIST_FIRSTPRIVATE: - case OMP_LIST_LASTPRIVATE: - case OMP_LIST_REDUCTION: - case OMP_LIST_REDUCTION_INSCAN: - case OMP_LIST_REDUCTION_TASK: - case OMP_LIST_IN_REDUCTION: - case OMP_LIST_TASK_REDUCTION: - case OMP_LIST_LINEAR: - for (n = omp_clauses->lists[list]; n; n = n->next) - n->sym->mark = 0; - break; - default: - break; - } - - for (n = omp_clauses->lists[OMP_LIST_ALLOCATE]; n; n = n->next) - if (n->sym->mark == 1) - gfc_error ("%qs specified in % clause at %L but not " - "in an explicit privatization clause", - n->sym->name, &n->where); - } - if (code - && (code->op == EXEC_OMP_ALLOCATORS || code->op == EXEC_OMP_ALLOCATE) - && code->block - && code->block->next - && code->block->next->op == EXEC_ALLOCATE) - { - gfc_alloc *a; - for (n = omp_clauses->lists[OMP_LIST_ALLOCATE]; n; n = n->next) - { - if (n->sym == NULL) - continue; - for (a = code->block->next->ext.alloc.list; a; a = a->next) - if (a->expr->expr_type == EXPR_VARIABLE - && a->expr->symtree->n.sym == n->sym) - break; - if (a == NULL) - gfc_error ("%qs specified in % at %L but not " - "in the associated ALLOCATE statement", - n->sym->name, &n->where); - } - } - - } + omp_verify_clauses_symbol_dups (code, omp_clauses, ns, openacc); /* OpenACC reductions. */ if (openacc) @@ -7911,20 +8188,6 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, } } - for (n = omp_clauses->lists[OMP_LIST_TO]; n; n = n->next) - n->sym->mark = 0; - for (n = omp_clauses->lists[OMP_LIST_FROM]; n; n = n->next) - if (n->expr == NULL) - n->sym->mark = 1; - for (n = omp_clauses->lists[OMP_LIST_TO]; n; n = n->next) - { - if (n->expr == NULL && n->sym->mark) - gfc_error ("Symbol %qs present on both FROM and TO clauses at %L", - n->sym->name, &n->where); - else - n->sym->mark = 1; - } - bool has_inscan = false, has_notinscan = false; for (list = 0; list < OMP_LIST_NUM; list++) if ((n = omp_clauses->lists[list]) != NULL) @@ -8093,243 +8356,9 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, "type shall be a scalar integer of " "OMP_DEPEND_KIND kind", &n->expr->where); } - gfc_ref *lastref = NULL, *lastslice = NULL; - bool resolved = false; - if (n->expr) - { - lastref = n->expr->ref; - resolved = gfc_resolve_expr (n->expr); - - /* Look through component refs to find last array - reference. */ - if (resolved) - { - for (gfc_ref *ref = n->expr->ref; ref; ref = ref->next) - if (ref->type == REF_COMPONENT - || ref->type == REF_SUBSTRING - || ref->type == REF_INQUIRY) - lastref = ref; - else if (ref->type == REF_ARRAY) - { - for (int i = 0; i < ref->u.ar.dimen; i++) - if (ref->u.ar.dimen_type[i] == DIMEN_RANGE) - lastslice = ref; - - lastref = ref; - } - - /* The "!$acc cache" directive allows rectangular - subarrays to be specified, with some restrictions - on the form of bounds (not implemented). - Only raise an error here if we're really sure the - array isn't contiguous. An expression such as - arr(-n:n,-n:n) could be contiguous even if it looks - like it may not be. */ - if (code->op != EXEC_OACC_UPDATE - && list != OMP_LIST_CACHE - && list != OMP_LIST_DEPEND - && !gfc_is_simply_contiguous (n->expr, false, true) - && gfc_is_not_contiguous (n->expr) - && !(lastslice - && (lastslice->next - || lastslice->type != REF_ARRAY))) - gfc_error ("Array is not contiguous at %L", - &n->where); - } - } - if (openacc - && list == OMP_LIST_MAP - && (n->u.map_op == OMP_MAP_ATTACH - || n->u.map_op == OMP_MAP_DETACH)) - { - symbol_attribute attr; - if (n->expr) - attr = gfc_expr_attr (n->expr); - else - attr = n->sym->attr; - if (!attr.pointer && !attr.allocatable) - gfc_error ("%qs clause argument must be ALLOCATABLE or " - "a POINTER at %L", - (n->u.map_op == OMP_MAP_ATTACH) ? "attach" - : "detach", &n->where); - } - if (lastref - || (n->expr - && (!resolved || n->expr->expr_type != EXPR_VARIABLE))) - { - if (!lastslice - && lastref - && lastref->type == REF_SUBSTRING) - gfc_error ("Unexpected substring reference in %s clause " - "at %L", name, &n->where); - else if (!lastslice - && lastref - && lastref->type == REF_INQUIRY) - { - gcc_assert (lastref->u.i == INQUIRY_RE - || lastref->u.i == INQUIRY_IM); - gfc_error ("Unexpected complex-parts designator " - "reference in %s clause at %L", - name, &n->where); - } - else if (!resolved - || n->expr->expr_type != EXPR_VARIABLE - || (lastslice - && (lastslice->next - || lastslice->type != REF_ARRAY))) - gfc_error ("%qs in %s clause at %L is not a proper " - "array section", n->sym->name, name, - &n->where); - else if (lastslice) - { - int i; - gfc_array_ref *ar = &lastslice->u.ar; - for (i = 0; i < ar->dimen; i++) - if (ar->stride[i] && code->op != EXEC_OACC_UPDATE) - { - gfc_error ("Stride should not be specified for " - "array section in %s clause at %L", - name, &n->where); - break; - } - else if (ar->dimen_type[i] != DIMEN_ELEMENT - && ar->dimen_type[i] != DIMEN_RANGE) - { - gfc_error ("%qs in %s clause at %L is not a " - "proper array section", - n->sym->name, name, &n->where); - break; - } - else if ((list == OMP_LIST_DEPEND - || list == OMP_LIST_AFFINITY) - && ar->start[i] - && ar->start[i]->expr_type == EXPR_CONSTANT - && ar->end[i] - && ar->end[i]->expr_type == EXPR_CONSTANT - && mpz_cmp (ar->start[i]->value.integer, - ar->end[i]->value.integer) > 0) - { - gfc_error ("%qs in %s clause at %L is a " - "zero size array section", - n->sym->name, - list == OMP_LIST_DEPEND - ? "DEPEND" : "AFFINITY", &n->where); - break; - } - } - } - else if (openacc) - { - if (list == OMP_LIST_MAP - && n->u.map_op == OMP_MAP_FORCE_DEVICEPTR) - resolve_oacc_deviceptr_clause (n->sym, n->where, name); - else - resolve_oacc_data_clauses (n->sym, n->where, name); - } - else if (list != OMP_LIST_DEPEND - && n->sym->as - && n->sym->as->type == AS_ASSUMED_SIZE) - gfc_error ("Assumed size array %qs in %s clause at %L", - n->sym->name, name, &n->where); - if (!openacc - && list == OMP_LIST_MAP - && n->sym->ts.type == BT_DERIVED - && n->sym->ts.u.derived->attr.alloc_comp) - gfc_error ("List item %qs with allocatable components is not " - "permitted in map clause at %L", n->sym->name, - &n->where); - if (list == OMP_LIST_MAP && !openacc) - switch (code->op) - { - case EXEC_OMP_TARGET: - case EXEC_OMP_TARGET_DATA: - switch (n->u.map_op) - { - case OMP_MAP_TO: - case OMP_MAP_ALWAYS_TO: - case OMP_MAP_PRESENT_TO: - case OMP_MAP_ALWAYS_PRESENT_TO: - case OMP_MAP_FROM: - case OMP_MAP_ALWAYS_FROM: - case OMP_MAP_PRESENT_FROM: - case OMP_MAP_ALWAYS_PRESENT_FROM: - case OMP_MAP_TOFROM: - case OMP_MAP_ALWAYS_TOFROM: - case OMP_MAP_PRESENT_TOFROM: - case OMP_MAP_ALWAYS_PRESENT_TOFROM: - case OMP_MAP_ALLOC: - case OMP_MAP_PRESENT_ALLOC: - break; - default: - gfc_error ("TARGET%s with map-type other than TO, " - "FROM, TOFROM, or ALLOC on MAP clause " - "at %L", - code->op == EXEC_OMP_TARGET - ? "" : " DATA", &n->where); - break; - } - break; - case EXEC_OMP_TARGET_ENTER_DATA: - switch (n->u.map_op) - { - case OMP_MAP_TO: - case OMP_MAP_ALWAYS_TO: - case OMP_MAP_PRESENT_TO: - case OMP_MAP_ALWAYS_PRESENT_TO: - case OMP_MAP_ALLOC: - case OMP_MAP_PRESENT_ALLOC: - break; - case OMP_MAP_TOFROM: - n->u.map_op = OMP_MAP_TO; - break; - case OMP_MAP_ALWAYS_TOFROM: - n->u.map_op = OMP_MAP_ALWAYS_TO; - break; - case OMP_MAP_PRESENT_TOFROM: - n->u.map_op = OMP_MAP_PRESENT_TO; - break; - case OMP_MAP_ALWAYS_PRESENT_TOFROM: - n->u.map_op = OMP_MAP_ALWAYS_PRESENT_TO; - break; - default: - gfc_error ("TARGET ENTER DATA with map-type other " - "than TO, TOFROM or ALLOC on MAP clause " - "at %L", &n->where); - break; - } - break; - case EXEC_OMP_TARGET_EXIT_DATA: - switch (n->u.map_op) - { - case OMP_MAP_FROM: - case OMP_MAP_ALWAYS_FROM: - case OMP_MAP_PRESENT_FROM: - case OMP_MAP_ALWAYS_PRESENT_FROM: - case OMP_MAP_RELEASE: - case OMP_MAP_DELETE: - break; - case OMP_MAP_TOFROM: - n->u.map_op = OMP_MAP_FROM; - break; - case OMP_MAP_ALWAYS_TOFROM: - n->u.map_op = OMP_MAP_ALWAYS_FROM; - break; - case OMP_MAP_PRESENT_TOFROM: - n->u.map_op = OMP_MAP_PRESENT_FROM; - break; - case OMP_MAP_ALWAYS_PRESENT_TOFROM: - n->u.map_op = OMP_MAP_ALWAYS_PRESENT_FROM; - break; - default: - gfc_error ("TARGET EXIT DATA with map-type other " - "than FROM, TOFROM, RELEASE, or DELETE on " - "MAP clause at %L", &n->where); - break; - } - break; - default: - break; - } + if (!omp_verify_map_motion_clauses (code, list, name, n, + openacc)) + break; } if (list != OMP_LIST_DEPEND)