From fa6d1e273449aff61833064027fed3787c13121f Mon Sep 17 00:00:00 2001
Message-Id: <fa6d1e273449aff61833064027fed3787c13121f.1670438768.git.julian@codesourcery.com>
In-Reply-To: <c66db363066913ae4939f2aa706427338b109d71.1670438768.git.julian@codesourcery.com>
References: <c66db363066913ae4939f2aa706427338b109d71.1670438768.git.julian@codesourcery.com>
From: Julian Brown <julian@codesourcery.com>
Date: Tue, 6 Dec 2022 23:10:58 +0000
Subject: [PATCH 2/2] OpenMP: Duplicate checking for map clauses in Fortran
(PR107214)
This patch adds duplicate checking for OpenMP "map" clauses, taking some
cues from the implementation for C in c-typeck.cc:c_finish_omp_clauses
(and similar for C++).
In addition to the existing use of the "mark" and "comp_mark" bitfields
in the gfc_symbol structure, the patch adds several new bits handling
duplicate checking within various categories of clause types. If "mark"
is being used for map clauses, we need to use different bits for other
clauses for cases where "map" and some other clause can refer to the
same symbol (e.g. "map(n) shared(n)").
This version of the patch avoids flagging variables that are listed on
both map and firstprivate clauses when they are on a combined directive,
as they get moved to separate nested directives later (see previous
patch in series).
Tested with offloading to NVPTX alongside previous patch (and
dependencies). OK?
2022-12-06 Julian Brown <julian@codesourcery.com>
gcc/fortran/
PR fortran/107214
* gfortran.h (gfc_symbol): Add data_mark, dev_mark, gen_mark and
reduc_mark bitfields.
* openmp.cc (resolve_omp_clauses): Use above bitfields to improve
duplicate clause detection.
gcc/testsuite/
PR fortran/107214
* gfortran.dg/gomp/pr107214.f90: New test.
---
gcc/fortran/gfortran.h | 32 ++++++---
gcc/fortran/openmp.cc | 73 +++++++++++++++++----
gcc/testsuite/gfortran.dg/gomp/pr107214.f90 | 7 ++
3 files changed, 90 insertions(+), 22 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/gomp/pr107214.f90
@@ -1871,16 +1871,6 @@ typedef struct gfc_symbol
gfc_namelist *namelist, *namelist_tail;
- /* Change management fields. Symbols that might be modified by the
- current statement have the mark member nonzero. Of these symbols,
- symbols with old_symbol equal to NULL are symbols created within
- the current statement. Otherwise, old_symbol points to a copy of
- the old symbol. gfc_new is used in symbol.cc to flag new symbols.
- comp_mark is used to indicate variables which have component accesses
- in OpenMP/OpenACC directive clauses. */
- struct gfc_symbol *old_symbol;
- unsigned mark:1, comp_mark:1, gfc_new:1;
-
/* The tlink field is used in the front end to carry the module
declaration of separate module procedures so that the characteristics
can be compared with the corresponding declaration in a submodule. In
@@ -1888,6 +1878,28 @@ typedef struct gfc_symbol
deferred initialization. */
struct gfc_symbol *tlink;
+ /* Change management fields. Symbols that might be modified by the
+ current statement have the mark member nonzero. Of these symbols,
+ symbols with old_symbol equal to NULL are symbols created within
+ the current statement. Otherwise, old_symbol points to a copy of
+ the old symbol. gfc_new is used in symbol.cc to flag new symbols.
+ comp_mark is used to indicate variables which have component accesses
+ in OpenMP/OpenACC directive clauses (cf. c-typeck.cc:c_finish_omp_clauses,
+ map_field_head).
+ data_mark is used to check duplicate mappings for OpenMP data-sharing
+ clauses (see firstprivate_head/lastprivate_head in the above function).
+ dev_mark is used to check duplicate mappings for OpenMP
+ is_device_ptr/has_device_addr clauses (see is_on_device_head in above
+ function).
+ gen_mark is used to check duplicate mappings for OpenMP
+ use_device_ptr/use_device_addr/private/shared clauses (see generic_head in
+ above functon).
+ reduc_mark is used to check duplicate mappings for OpenMP reduction
+ clauses. */
+ struct gfc_symbol *old_symbol;
+ unsigned mark:1, comp_mark:1, data_mark:1, dev_mark:1, gen_mark:1;
+ unsigned reduc_mark:1, gfc_new:1;
+
/* Nonzero if all equivalences associated with this symbol have been
processed. */
unsigned equiv_built:1;
@@ -7135,6 +7135,10 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
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)))
@@ -7203,7 +7207,6 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
&& list != OMP_LIST_LASTPRIVATE
&& list != OMP_LIST_ALIGNED
&& list != OMP_LIST_DEPEND
- && (list != OMP_LIST_MAP || openacc)
&& list != OMP_LIST_FROM
&& list != OMP_LIST_TO
&& (list != OMP_LIST_REDUCTION || !openacc)
@@ -7222,10 +7225,43 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
for (gfc_ref *ref = n->expr->ref; ref; ref = ref->next)
if (ref->type == REF_COMPONENT)
component_ref_p = true;
- if ((!component_ref_p && n->sym->comp_mark)
- || (component_ref_p && n->sym->mark))
- gfc_error ("Symbol %qs has mixed component and non-component "
- "accesses at %L", n->sym->name, &n->where);
+ 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)
+ 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;
+ }
+ else if (list == OMP_LIST_REDUCTION && !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->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);
@@ -7241,31 +7277,44 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
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->mark)
+ 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->mark = 0;
+ n->sym->data_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->mark)
+ 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->mark = 1;
+ n->sym->data_mark = 1;
}
for (n = omp_clauses->lists[OMP_LIST_LASTPRIVATE]; n; n = n->next)
- n->sym->mark = 0;
+ n->sym->data_mark = 0;
for (n = omp_clauses->lists[OMP_LIST_LASTPRIVATE]; n; n = n->next)
{
- if (n->sym->mark)
+ 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->mark = 1;
+ n->sym->data_mark = 1;
}
for (n = omp_clauses->lists[OMP_LIST_ALIGNED]; n; n = n->next)
new file mode 100644
@@ -0,0 +1,7 @@
+! { dg-do compile }
+
+program p
+ integer, allocatable :: a
+ !$omp target map(tofrom: a, a) ! { dg-error "Symbol 'a' present on multiple clauses" }
+ !$omp end target
+end
--
2.29.2