I started looking into this based on some unified-/managed-memory
discussions. At the end, I ended up doing the following where only
the 'local' clause is directly related to USM - albeit 'groupprivate'
implies 'declare target' with 'local' clause, which is the link.
Note: The following is only the Fortran parser work, i.e. new features
will print a sorry.
- some janitorial changes to 'declare target' (missing diagnostic,
cleanup). In particular, check that with 'link' there is no
'device_type(nohost)'.
- add the 'local' clause to 'declare target' (+ sorry)
- add the 'groupprivate' directive (+ sorry)
- add the 'dyn_groupprivate' clause to 'target' (+ sorry)
Comments before I commit it?
Tobias
PS: Eventually, GCC needs to handle 'device_type(host)'
(for variables and functions and enter/link/local),
besides improving/supporting the 'device_type(nohost)'
behavior. And, of course, actually implementing 'local'
and (dyn_)groupprivate also has eventually to be done ...
OpenMP/Fortran: 'declare target' fix + parse 'local' clause; parse groupprivate
Declare target's 'link' clause disallows 'nohost'; check for it.
Additionally, some other cleanups have been done.
The 'local' clause to 'declare target' is now supported in the FE,
but a 'sorry, unimplemented' is printed at TREE generation time.
This commit also adds the 'groupprivate' directive, which implies
'declare target' with the 'local' clause. And for completeness also
the 'dyn_groupprivate' clause to 'target'. However, all those new
features will eventually print 'sorry, unimplemented' for now.
gcc/fortran/ChangeLog:
* dump-parse-tree.cc (show_attr): Handle OpenMP's 'local' clause
and the 'groupprivate' directive.
(show_omp_clauses): Handle dyn_groupprivate.
* frontend-passes.cc (gfc_code_walker): Walk dyn_groupprivate.
* gfortran.h (enum gfc_statement): Add ST_OMP_GROUPPRIVATE.
(enum gfc_omp_fallback, gfc_add_omp_groupprivate,
gfc_add_omp_declare_target_local): New.
* match.h (gfc_match_omp_groupprivate): New.
* module.cc (enum ab_attribute, mio_symbol_attribute, load_commons,
write_common_0): Handle 'groupprivate' + declare target's 'local'.
* openmp.cc (gfc_omp_directives): Add 'groupprivate'.
(gfc_free_omp_clauses): Free dyn_groupprivate.
(enum omp_mask2): Add OMP_CLAUSE_LOCAL and OMP_CLAUSE_DYN_GROUPPRIVATE.
(gfc_match_omp_clauses): Match them.
(OMP_TARGET_CLAUSES): Add OMP_CLAUSE_DYN_GROUPPRIVATE.
(OMP_DECLARE_TARGET_CLAUSES): Add OMP_CLAUSE_LOCAL.
(gfc_match_omp_declare_target): Handle groupprivate + fixes.
(gfc_match_omp_threadprivate): Code move to and calling now ...
(gfc_match_omp_thread_group_private): ... this new function.
Also handle groupprivate.
(gfc_match_omp_groupprivate): New.
(resolve_omp_clauses): Resolve dyn_groupprivate.
* parse.cc (decode_omp_directive): Match groupprivate.
(case_omp_decl, parse_spec, gfc_ascii_statement): Handle it.
* resolve.cc (resolve_symbol): Handle groupprivate.
* symbol.cc (gfc_check_conflict, gfc_copy_attr): Handle 'local'
and 'groupprivate'.
(gfc_add_omp_groupprivate, gfc_add_omp_declare_target_local): New.
* trans-common.cc (build_common_decl,
accumulate_equivalence_attributes): Print 'sorry' for
groupprivate and declare target's local.
* trans-decl.cc (add_attributes_to_decl): Likewise..
* trans-openmp.cc (gfc_trans_omp_clauses): Print 'sorry' for
dyn_groupprivate.
(fallback): Process declare target with link/local as
done for 'enter'.
gcc/testsuite/ChangeLog:
* gfortran.dg/gomp/crayptr2.f90: Move dg-error line.
* gfortran.dg/gomp/declare-target-2.f90: Extend.
* gfortran.dg/gomp/declare-target-4.f90: Update comment,
enable one test.
* gfortran.dg/gomp/declare-target-5.f90: Update dg- wording,
add new test.
* gfortran.dg/gomp/declare-target-indirect-2.f90: Expect
'device_type(any)' in scan-tree-dump.
* gfortran.dg/gomp/declare-target-6.f90: New test.
* gfortran.dg/gomp/dyn_groupprivate-1.f90: New test.
* gfortran.dg/gomp/dyn_groupprivate-2.f90: New test.
* gfortran.dg/gomp/groupprivate-1.f90: New test.
* gfortran.dg/gomp/groupprivate-2.f90: New test.
* gfortran.dg/gomp/groupprivate-3.f90: New test.
* gfortran.dg/gomp/groupprivate-4.f90: New test.
* gfortran.dg/gomp/groupprivate-5.f90: New test.
* gfortran.dg/gomp/groupprivate-6.f90: New test.
gcc/fortran/dump-parse-tree.cc | 18 ++
gcc/fortran/frontend-passes.cc | 1 +
gcc/fortran/gfortran.h | 19 ++
gcc/fortran/match.h | 1 +
gcc/fortran/module.cc | 20 +-
gcc/fortran/openmp.cc | 359 ++++++++++++++++-----
gcc/fortran/parse.cc | 10 +-
gcc/fortran/resolve.cc | 19 +-
gcc/fortran/symbol.cc | 64 +++-
gcc/fortran/trans-common.cc | 31 +-
gcc/fortran/trans-decl.cc | 26 +-
gcc/fortran/trans-openmp.cc | 23 +-
gcc/testsuite/gfortran.dg/gomp/crayptr2.f90 | 4 +-
.../gfortran.dg/gomp/declare-target-2.f90 | 4 +
.../gfortran.dg/gomp/declare-target-4.f90 | 9 +-
.../gfortran.dg/gomp/declare-target-5.f90 | 37 +--
.../gfortran.dg/gomp/declare-target-6.f90 | 15 +
.../gfortran.dg/gomp/declare-target-indirect-2.f90 | 4 +-
.../gfortran.dg/gomp/dyn_groupprivate-1.f90 | 20 ++
.../gfortran.dg/gomp/dyn_groupprivate-2.f90 | 23 ++
gcc/testsuite/gfortran.dg/gomp/groupprivate-1.f90 | 23 ++
gcc/testsuite/gfortran.dg/gomp/groupprivate-2.f90 | 37 +++
gcc/testsuite/gfortran.dg/gomp/groupprivate-3.f90 | 16 +
gcc/testsuite/gfortran.dg/gomp/groupprivate-4.f90 | 25 ++
gcc/testsuite/gfortran.dg/gomp/groupprivate-5.f90 | 58 ++++
gcc/testsuite/gfortran.dg/gomp/groupprivate-6.f90 | 34 ++
26 files changed, 778 insertions(+), 122 deletions(-)
diff --git a/gcc/fortran/dump-parse-tree.cc b/gcc/fortran/dump-parse-tree.cc
index eda0659d6e2..2a4ebb0fa0f 100644
--- a/gcc/fortran/dump-parse-tree.cc
+++ b/gcc/fortran/dump-parse-tree.cc
@@ -843,6 +843,8 @@ show_attr (symbol_attribute *attr, const char * module)
fputs (" VALUE", dumpfile);
if (attr->volatile_)
fputs (" VOLATILE", dumpfile);
+ if (attr->omp_groupprivate)
+ fputs (" GROUPPRIVATE", dumpfile);
if (attr->threadprivate)
fputs (" THREADPRIVATE", dumpfile);
if (attr->temporary)
@@ -938,6 +940,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_local)
+ fputs (" OMP-DECLARE-TARGET-LOCAL", dumpfile);
if (attr->omp_declare_target_indirect)
fputs (" OMP-DECLARE-TARGET-INDIRECT", dumpfile);
if (attr->omp_device_type == OMP_DEVICE_TYPE_HOST)
@@ -2211,6 +2215,20 @@ show_omp_clauses (gfc_omp_clauses *omp_clauses)
fputs (" DEPEND(source)", dumpfile);
if (omp_clauses->doacross_source)
fputs (" DOACROSS(source:)", dumpfile);
+ if (omp_clauses->dyn_groupprivate)
+ {
+ fputs (" DYN_GROUPPRIVATE(", dumpfile);
+ if (omp_clauses->fallback != OMP_FALLBACK_NONE)
+ fputs ("FALLBACK(", dumpfile);
+ if (omp_clauses->fallback == OMP_FALLBACK_ABORT)
+ fputs ("ABORT):", dumpfile);
+ else if (omp_clauses->fallback == OMP_FALLBACK_DEFAULT_MEM)
+ fputs ("DEFAULT_MEM):", dumpfile);
+ else if (omp_clauses->fallback == OMP_FALLBACK_NULL)
+ fputs ("NULL):", dumpfile);
+ show_expr (omp_clauses->dyn_groupprivate);
+ fputc (')', dumpfile);
+ }
if (omp_clauses->capture)
fputs (" CAPTURE", dumpfile);
if (omp_clauses->depobj_update != OMP_DEPEND_UNSET)
diff --git a/gcc/fortran/frontend-passes.cc b/gcc/fortran/frontend-passes.cc
index 595c5095eaf..b699231e971 100644
--- a/gcc/fortran/frontend-passes.cc
+++ b/gcc/fortran/frontend-passes.cc
@@ -5645,6 +5645,7 @@ gfc_code_walker (gfc_code **c, walk_code_fn_t codefn, walk_expr_fn_t exprfn,
WALK_SUBEXPR (co->ext.omp_clauses->num_tasks);
WALK_SUBEXPR (co->ext.omp_clauses->priority);
WALK_SUBEXPR (co->ext.omp_clauses->detach);
+ WALK_SUBEXPR (co->ext.omp_clauses->dyn_groupprivate);
WALK_SUBEXPR (co->ext.omp_clauses->novariants);
WALK_SUBEXPR (co->ext.omp_clauses->nocontext);
for (idx = 0; idx < ARRAY_SIZE (list_types); idx++)
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 2997c0326ca..72aecfb8379 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -311,6 +311,7 @@ enum gfc_statement
ST_OMP_TASKLOOP, ST_OMP_END_TASKLOOP, ST_OMP_SCAN, ST_OMP_DEPOBJ,
ST_OMP_TASKLOOP_SIMD, ST_OMP_END_TASKLOOP_SIMD, ST_OMP_ORDERED_DEPEND,
ST_OMP_REQUIRES, ST_PROCEDURE, ST_GENERIC, ST_CRITICAL, ST_END_CRITICAL,
+ ST_OMP_GROUPPRIVATE,
ST_GET_FCN_CHARACTERISTICS, ST_LOCK, ST_UNLOCK, ST_EVENT_POST,
ST_EVENT_WAIT, ST_FAIL_IMAGE, ST_FORM_TEAM, ST_CHANGE_TEAM,
ST_END_TEAM, ST_SYNC_TEAM, ST_OMP_PARALLEL_MASTER,
@@ -1042,8 +1043,10 @@ typedef struct
/* Mentioned in OMP DECLARE TARGET. */
unsigned omp_declare_target:1;
unsigned omp_declare_target_link:1;
+ unsigned omp_declare_target_local:1;
unsigned omp_declare_target_indirect:1;
ENUM_BITFIELD (gfc_omp_device_type) omp_device_type:2;
+ unsigned omp_groupprivate:1;
unsigned omp_allocate:1;
/* Mentioned in OACC DECLARE. */
@@ -1488,6 +1491,7 @@ enum
OMP_LIST_TASK_REDUCTION,
OMP_LIST_DEVICE_RESIDENT,
OMP_LIST_LINK,
+ OMP_LIST_LOCAL,
OMP_LIST_USE_DEVICE,
OMP_LIST_CACHE,
OMP_LIST_IS_DEVICE_PTR,
@@ -1614,6 +1618,14 @@ enum gfc_omp_bind_type
OMP_BIND_THREAD
};
+enum gfc_omp_fallback
+{
+ OMP_FALLBACK_NONE,
+ OMP_FALLBACK_ABORT,
+ OMP_FALLBACK_DEFAULT_MEM,
+ OMP_FALLBACK_NULL
+};
+
typedef struct gfc_omp_assumptions
{
int n_absent, n_contains;
@@ -1649,6 +1661,7 @@ typedef struct gfc_omp_clauses
struct gfc_expr *detach;
struct gfc_expr *depobj;
struct gfc_expr *dist_chunk_size;
+ struct gfc_expr *dyn_groupprivate;
struct gfc_expr *message;
struct gfc_expr *novariants;
struct gfc_expr *nocontext;
@@ -1681,6 +1694,7 @@ typedef struct gfc_omp_clauses
ENUM_BITFIELD (gfc_omp_at_type) at:2;
ENUM_BITFIELD (gfc_omp_severity_type) severity:2;
ENUM_BITFIELD (gfc_omp_sched_kind) dist_sched_kind:3;
+ ENUM_BITFIELD (gfc_omp_fallback) fallback:2;
/* OpenACC. */
struct gfc_expr *async_expr;
@@ -2118,6 +2132,8 @@ typedef struct gfc_common_head
char use_assoc, saved, threadprivate;
unsigned char omp_declare_target : 1;
unsigned char omp_declare_target_link : 1;
+ unsigned char omp_declare_target_local : 1;
+ unsigned char omp_groupprivate : 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];
@@ -3717,6 +3733,9 @@ bool gfc_add_threadprivate (symbol_attribute *, const char *, locus *);
bool gfc_add_omp_declare_target (symbol_attribute *, const char *, locus *);
bool gfc_add_omp_declare_target_link (symbol_attribute *, const char *,
locus *);
+bool gfc_add_omp_declare_target_local (symbol_attribute *, const char *,
+ locus *);
+bool gfc_add_omp_groupprivate (symbol_attribute *, const char *, locus *);
bool gfc_add_target (symbol_attribute *, locus *);
bool gfc_add_dummy (symbol_attribute *, const char *, locus *);
bool gfc_add_generic (symbol_attribute *, const char *, locus *);
diff --git a/gcc/fortran/match.h b/gcc/fortran/match.h
index 410361c4bd1..314be6baa92 100644
--- a/gcc/fortran/match.h
+++ b/gcc/fortran/match.h
@@ -174,6 +174,7 @@ match gfc_match_omp_do_simd (void);
match gfc_match_omp_loop (void);
match gfc_match_omp_error (void);
match gfc_match_omp_flush (void);
+match gfc_match_omp_groupprivate (void);
match gfc_match_omp_interop (void);
match gfc_match_omp_masked (void);
match gfc_match_omp_masked_taskloop (void);
diff --git a/gcc/fortran/module.cc b/gcc/fortran/module.cc
index c489decec8d..262f72b8e7c 100644
--- a/gcc/fortran/module.cc
+++ b/gcc/fortran/module.cc
@@ -2092,7 +2092,8 @@ enum ab_attribute
AB_ARRAY_OUTER_DEPENDENCY, AB_MODULE_PROCEDURE, AB_OACC_DECLARE_CREATE,
AB_OACC_DECLARE_COPYIN, AB_OACC_DECLARE_DEVICEPTR,
AB_OACC_DECLARE_DEVICE_RESIDENT, AB_OACC_DECLARE_LINK,
- AB_OMP_DECLARE_TARGET_LINK, AB_PDT_KIND, AB_PDT_LEN, AB_PDT_TYPE,
+ AB_OMP_DECLARE_TARGET_LINK, AB_OMP_DECLARE_TARGET_LOCAL,
+ AB_PDT_KIND, AB_PDT_LEN, AB_PDT_TYPE,
AB_PDT_COMP, AB_PDT_TEMPLATE, AB_PDT_ARRAY, AB_PDT_STRING,
AB_OACC_ROUTINE_LOP_GANG, AB_OACC_ROUTINE_LOP_WORKER,
AB_OACC_ROUTINE_LOP_VECTOR, AB_OACC_ROUTINE_LOP_SEQ,
@@ -2102,7 +2103,7 @@ enum ab_attribute
AB_OMP_REQ_MEM_ORDER_SEQ_CST, AB_OMP_REQ_MEM_ORDER_ACQ_REL,
AB_OMP_REQ_MEM_ORDER_ACQUIRE, AB_OMP_REQ_MEM_ORDER_RELEASE,
AB_OMP_REQ_MEM_ORDER_RELAXED, AB_OMP_DEVICE_TYPE_NOHOST,
- AB_OMP_DEVICE_TYPE_HOST, AB_OMP_DEVICE_TYPE_ANY
+ AB_OMP_DEVICE_TYPE_HOST, AB_OMP_DEVICE_TYPE_ANY, AB_OMP_GROUPPRIVATE
};
static const mstring attr_bits[] =
@@ -2166,6 +2167,8 @@ static const mstring attr_bits[] =
minit ("OACC_DECLARE_DEVICE_RESIDENT", AB_OACC_DECLARE_DEVICE_RESIDENT),
minit ("OACC_DECLARE_LINK", AB_OACC_DECLARE_LINK),
minit ("OMP_DECLARE_TARGET_LINK", AB_OMP_DECLARE_TARGET_LINK),
+ minit ("OMP_DECLARE_TARGET_LOCAL", AB_OMP_DECLARE_TARGET_LOCAL),
+ minit ("OMP_GROUPPRIVATE", AB_OMP_GROUPPRIVATE),
minit ("PDT_KIND", AB_PDT_KIND),
minit ("PDT_LEN", AB_PDT_LEN),
minit ("PDT_TYPE", AB_PDT_TYPE),
@@ -2399,6 +2402,10 @@ mio_symbol_attribute (symbol_attribute *attr)
MIO_NAME (ab_attribute) (AB_OACC_DECLARE_LINK, attr_bits);
if (attr->omp_declare_target_link)
MIO_NAME (ab_attribute) (AB_OMP_DECLARE_TARGET_LINK, attr_bits);
+ if (attr->omp_declare_target_local)
+ MIO_NAME (ab_attribute) (AB_OMP_DECLARE_TARGET_LOCAL, attr_bits);
+ if (attr->omp_groupprivate)
+ MIO_NAME (ab_attribute) (AB_OMP_GROUPPRIVATE, attr_bits);
if (attr->pdt_kind)
MIO_NAME (ab_attribute) (AB_PDT_KIND, attr_bits);
if (attr->pdt_len)
@@ -2654,6 +2661,12 @@ mio_symbol_attribute (symbol_attribute *attr)
case AB_OMP_DECLARE_TARGET_LINK:
attr->omp_declare_target_link = 1;
break;
+ case AB_OMP_DECLARE_TARGET_LOCAL:
+ attr->omp_declare_target_local = 1;
+ break;
+ case AB_OMP_GROUPPRIVATE:
+ attr->omp_groupprivate = 1;
+ break;
case AB_ARRAY_OUTER_DEPENDENCY:
attr->array_outer_dependency =1;
break;
@@ -5268,6 +5281,8 @@ load_commons (void)
if (flags & 2)
p->threadprivate = 1;
p->omp_device_type = (gfc_omp_device_type) ((flags >> 2) & 3);
+ if ((flags >> 4) & 1)
+ p->omp_groupprivate = 1;
p->use_assoc = 1;
/* Get whether this was a bind(c) common or not. */
@@ -6191,6 +6206,7 @@ write_common_0 (gfc_symtree *st, bool this_module)
if (p->threadprivate)
flags |= 2;
flags |= p->omp_device_type << 2;
+ flags |= p->omp_groupprivate << 4;
mio_integer (&flags);
/* Write out whether the common block is bind(c) or not. */
diff --git a/gcc/fortran/openmp.cc b/gcc/fortran/openmp.cc
index 81d624b7b54..f047028187f 100644
--- a/gcc/fortran/openmp.cc
+++ b/gcc/fortran/openmp.cc
@@ -84,6 +84,7 @@ static const struct gfc_omp_directive gfc_omp_directives[] = {
/* {"flatten", GFC_OMP_DIR_EXECUTABLE, ST_OMP_FLATTEN}, */
{"flush", GFC_OMP_DIR_EXECUTABLE, ST_OMP_FLUSH},
/* {"fuse", GFC_OMP_DIR_EXECUTABLE, ST_OMP_FLUSE}, */
+ {"groupprivate", GFC_OMP_DIR_DECLARATIVE, ST_OMP_GROUPPRIVATE},
/* {"interchange", GFC_OMP_DIR_EXECUTABLE, ST_OMP_INTERCHANGE}, */
{"interop", GFC_OMP_DIR_EXECUTABLE, ST_OMP_INTEROP},
{"loop", GFC_OMP_DIR_EXECUTABLE, ST_OMP_LOOP},
@@ -195,6 +196,7 @@ gfc_free_omp_clauses (gfc_omp_clauses *c)
gfc_free_expr (c->num_teams_lower);
gfc_free_expr (c->num_teams_upper);
gfc_free_expr (c->device);
+ gfc_free_expr (c->dyn_groupprivate);
gfc_free_expr (c->thread_limit);
gfc_free_expr (c->dist_chunk_size);
gfc_free_expr (c->grainsize);
@@ -1172,6 +1174,8 @@ enum omp_mask2
OMP_CLAUSE_NOVARIANTS, /* OpenMP 5.1 */
OMP_CLAUSE_NOCONTEXT, /* OpenMP 5.1 */
OMP_CLAUSE_INTEROP, /* OpenMP 5.1 */
+ OMP_CLAUSE_LOCAL, /* OpenMP 6.0 */
+ OMP_CLAUSE_DYN_GROUPPRIVATE, /* OpenMP 6.1 */
/* This must come last. */
OMP_MASK2_LAST
};
@@ -3096,6 +3100,22 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
else
continue;
}
+ if ((mask & OMP_CLAUSE_DYN_GROUPPRIVATE)
+ && gfc_match_dupl_check (!c->dyn_groupprivate,
+ "dyn_groupprivate", true) == MATCH_YES)
+ {
+ if (gfc_match ("fallback ( abort ) : ") == MATCH_YES)
+ c->fallback = OMP_FALLBACK_ABORT;
+ else if (gfc_match ("fallback ( default_mem ) : ") == MATCH_YES)
+ c->fallback = OMP_FALLBACK_DEFAULT_MEM;
+ else if (gfc_match ("fallback ( null ) : ") == MATCH_YES)
+ c->fallback = OMP_FALLBACK_NULL;
+ if (gfc_match_expr (&c->dyn_groupprivate) != MATCH_YES)
+ return MATCH_ERROR;
+ if (gfc_match (" )") != MATCH_YES)
+ goto error;
+ continue;
+ }
break;
case 'e':
if ((mask & OMP_CLAUSE_ENTER))
@@ -3567,6 +3587,10 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
&c->lists[OMP_LIST_LINK])
== MATCH_YES))
continue;
+ if ((mask & OMP_CLAUSE_LOCAL)
+ && (gfc_match_omp_to_link ("local (", &c->lists[OMP_LIST_LOCAL])
+ == MATCH_YES))
+ continue;
break;
case 'm':
if ((mask & OMP_CLAUSE_MAP)
@@ -5064,7 +5088,8 @@ cleanup:
| OMP_CLAUSE_FIRSTPRIVATE | OMP_CLAUSE_DEFAULTMAP \
| OMP_CLAUSE_IS_DEVICE_PTR | OMP_CLAUSE_IN_REDUCTION \
| OMP_CLAUSE_THREAD_LIMIT | OMP_CLAUSE_ALLOCATE \
- | OMP_CLAUSE_HAS_DEVICE_ADDR | OMP_CLAUSE_USES_ALLOCATORS)
+ | OMP_CLAUSE_HAS_DEVICE_ADDR | OMP_CLAUSE_USES_ALLOCATORS \
+ | OMP_CLAUSE_DYN_GROUPPRIVATE)
#define OMP_TARGET_DATA_CLAUSES \
(omp_mask (OMP_CLAUSE_DEVICE) | OMP_CLAUSE_MAP | OMP_CLAUSE_IF \
| OMP_CLAUSE_USE_DEVICE_PTR | OMP_CLAUSE_USE_DEVICE_ADDR)
@@ -5092,7 +5117,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_INDIRECT)
+ | OMP_CLAUSE_TO | OMP_CLAUSE_INDIRECT | OMP_CLAUSE_LOCAL)
#define OMP_ATOMIC_CLAUSES \
(omp_mask (OMP_CLAUSE_ATOMIC) | OMP_CLAUSE_CAPTURE | OMP_CLAUSE_HINT \
| OMP_CLAUSE_MEMORDER | OMP_CLAUSE_COMPARE | OMP_CLAUSE_FAIL \
@@ -6113,7 +6138,7 @@ gfc_match_omp_declare_target (void)
gfc_buffer_error (false);
static const int to_enter_link_lists[]
- = { OMP_LIST_TO, OMP_LIST_ENTER, OMP_LIST_LINK };
+ = { OMP_LIST_TO, OMP_LIST_ENTER, OMP_LIST_LINK, OMP_LIST_LOCAL };
for (size_t listn = 0; listn < ARRAY_SIZE (to_enter_link_lists)
&& (list = to_enter_link_lists[listn], true); ++listn)
for (n = c->lists[list]; n; n = n->next)
@@ -6122,6 +6147,8 @@ gfc_match_omp_declare_target (void)
else if (n->u.common->head)
n->u.common->head->mark = 0;
+ if (c->device_type == OMP_DEVICE_TYPE_UNSET)
+ c->device_type = OMP_DEVICE_TYPE_ANY;
for (size_t listn = 0; listn < ARRAY_SIZE (to_enter_link_lists)
&& (list = to_enter_link_lists[listn], true); ++listn)
for (n = c->lists[list]; n; n = n->next)
@@ -6130,105 +6157,161 @@ gfc_match_omp_declare_target (void)
if (n->sym->attr.in_common)
gfc_error_now ("OMP DECLARE TARGET variable at %L is an "
"element of a COMMON block", &n->where);
+ else if (n->sym->attr.omp_groupprivate && list != OMP_LIST_LOCAL)
+ gfc_error_now ("List item %qs at %L not appear in the %qs clause "
+ "as it was previously specified in a GROUPPRIVATE "
+ "directive", n->sym->name, &n->where,
+ list == OMP_LIST_LINK
+ ? "link" : list == OMP_LIST_TO ? "to" : "enter");
else if (n->sym->mark)
gfc_error_now ("Variable at %L mentioned multiple times in "
"clauses of the same OMP DECLARE TARGET directive",
&n->where);
- else if (n->sym->attr.omp_declare_target
- && n->sym->attr.omp_declare_target_link
- && list != OMP_LIST_LINK)
+ else if ((n->sym->attr.omp_declare_target_link
+ || n->sym->attr.omp_declare_target_local)
+ && list != OMP_LIST_LINK
+ && list != OMP_LIST_LOCAL)
gfc_error_now ("OMP DECLARE TARGET variable at %L previously "
- "mentioned in LINK clause and later in %s clause",
- &n->where, list == OMP_LIST_TO ? "TO" : "ENTER");
+ "mentioned in %s clause and later in %s clause",
+ &n->where,
+ n->sym->attr.omp_declare_target_link ? "LINK"
+ : "LOCAL",
+ list == OMP_LIST_TO ? "TO" : "ENTER");
else if (n->sym->attr.omp_declare_target
- && !n->sym->attr.omp_declare_target_link
- && list == OMP_LIST_LINK)
+ && (list == OMP_LIST_LINK || list == OMP_LIST_LOCAL))
gfc_error_now ("OMP DECLARE TARGET variable at %L previously "
"mentioned in TO or ENTER clause and later in "
- "LINK clause", &n->where);
- else if (gfc_add_omp_declare_target (&n->sym->attr, n->sym->name,
- &n->sym->declared_at))
+ "%s clause", &n->where,
+ list == OMP_LIST_LINK ? "LINK" : "LOCAL");
+ else
{
+ if (list == OMP_LIST_TO || list == OMP_LIST_ENTER)
+ gfc_add_omp_declare_target (&n->sym->attr, n->sym->name,
+ &n->sym->declared_at);
if (list == OMP_LIST_LINK)
gfc_add_omp_declare_target_link (&n->sym->attr, n->sym->name,
&n->sym->declared_at);
+ if (list == OMP_LIST_LOCAL)
+ gfc_add_omp_declare_target_local (&n->sym->attr, n->sym->name,
+ &n->sym->declared_at);
+ }
+ if (n->sym->attr.omp_device_type != OMP_DEVICE_TYPE_UNSET
+ && n->sym->attr.omp_device_type != c->device_type)
+ {
+ const char *dt = "any";
+ if (n->sym->attr.omp_device_type == OMP_DEVICE_TYPE_NOHOST)
+ dt = "nohost";
+ else if (n->sym->attr.omp_device_type == OMP_DEVICE_TYPE_HOST)
+ dt = "host";
+ if (n->sym->attr.omp_groupprivate)
+ gfc_error_now ("List item %qs at %L set in previous OMP "
+ "GROUPPRIVATE directive to the different "
+ "DEVICE_TYPE %qs", n->sym->name, &n->where, dt);
+ else
+ gfc_error_now ("List item %qs at %L set in previous OMP "
+ "DECLARE TARGET directive to the different "
+ "DEVICE_TYPE %qs", n->sym->name, &n->where, dt);
}
- 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;
- }
- if (c->indirect)
+ n->sym->attr.omp_device_type = c->device_type;
+ if (c->indirect && c->device_type != OMP_DEVICE_TYPE_ANY)
{
- 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;
+ gfc_error_now ("DEVICE_TYPE must be ANY when used with INDIRECT "
+ "at %L", &n->where);
+ c->indirect = 0;
}
-
+ n->sym->attr.omp_declare_target_indirect = c->indirect;
+ if (list == OMP_LIST_LINK && c->device_type == OMP_DEVICE_TYPE_NOHOST)
+ gfc_error_now ("List item %qs at %L set with NOHOST specified may "
+ "not appear in a LINK clause", n->sym->name,
+ &n->where);
n->sym->mark = 1;
}
- else if (n->u.common->omp_declare_target
- && n->u.common->omp_declare_target_link
- && list != OMP_LIST_LINK)
- gfc_error_now ("OMP DECLARE TARGET COMMON at %L previously "
- "mentioned in LINK clause and later in %s clause",
- &n->where, list == OMP_LIST_TO ? "TO" : "ENTER");
- else if (n->u.common->omp_declare_target
- && !n->u.common->omp_declare_target_link
- && list == OMP_LIST_LINK)
- gfc_error_now ("OMP DECLARE TARGET COMMON at %L previously "
- "mentioned in TO or ENTER clause and later in "
- "LINK clause", &n->where);
- else if (n->u.common->head && n->u.common->head->mark)
- gfc_error_now ("COMMON at %L mentioned multiple times in "
- "clauses of the same OMP DECLARE TARGET directive",
- &n->where);
- else
- {
- n->u.common->omp_declare_target = 1;
- n->u.common->omp_declare_target_link = (list == OMP_LIST_LINK);
+ else /* common block */
+ {
+ if (n->u.common->omp_groupprivate && list != OMP_LIST_LOCAL)
+ gfc_error_now ("Common block %</%s/%> at %L not appear in the %qs "
+ "clause as it was previously specified in a "
+ "GROUPPRIVATE directive",
+ n->u.common->name, &n->where,
+ list == OMP_LIST_LINK
+ ? "link" : list == OMP_LIST_TO ? "to" : "enter");
+ else if (n->u.common->head && n->u.common->head->mark)
+ gfc_error_now ("Common block %</%s/%> at %L mentioned multiple "
+ "times in clauses of the same OMP DECLARE TARGET "
+ "directive", n->u.common->name, &n->where);
+ else if ((n->u.common->omp_declare_target_link
+ || n->u.common->omp_declare_target_local)
+ && list != OMP_LIST_LINK
+ && list != OMP_LIST_LOCAL)
+ gfc_error_now ("Common block %</%s/%> at %L previously mentioned "
+ "in %s clause and later in %s clause",
+ n->u.common->name, &n->where,
+ n->u.common->omp_declare_target_link ? "LINK"
+ : "LOCAL",
+ list == OMP_LIST_TO ? "TO" : "ENTER");
+ else if (n->u.common->omp_declare_target
+ && (list == OMP_LIST_LINK || list == OMP_LIST_LOCAL))
+ gfc_error_now ("Common block %</%s/%> at %L previously mentioned "
+ "in TO or ENTER clause and later in %s clause",
+ n->u.common->name, &n->where,
+ list == OMP_LIST_LINK ? "LINK" : "LOCAL");
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);
+ {
+ const char *dt = "any";
+ if (n->u.common->omp_device_type == OMP_DEVICE_TYPE_NOHOST)
+ dt = "nohost";
+ else if (n->u.common->omp_device_type == OMP_DEVICE_TYPE_HOST)
+ dt = "host";
+ if (n->u.common->omp_groupprivate)
+ gfc_error_now ("Common block %</%s/%> at %L set in previous OMP "
+ "GROUPPRIVATE directive to the different "
+ "DEVICE_TYPE %qs", n->u.common->name, &n->where,
+ dt);
+ else
+ gfc_error_now ("Common block %</%s/%> at %L set in previous OMP "
+ "DECLARE TARGET directive to the different "
+ "DEVICE_TYPE %qs", n->u.common->name, &n->where,
+ dt);
+ }
n->u.common->omp_device_type = c->device_type;
+ if (c->indirect && c->device_type != OMP_DEVICE_TYPE_ANY)
+ {
+ gfc_error_now ("DEVICE_TYPE must be ANY when used with INDIRECT "
+ "at %L", &n->where);
+ c->indirect = 0;
+ }
+ if (list == OMP_LIST_LINK && c->device_type == OMP_DEVICE_TYPE_NOHOST)
+ gfc_error_now ("Common block %</%s/%> at %L set with NOHOST "
+ "specified may not appear in a LINK clause",
+ n->u.common->name, &n->where);
+
+ if (list == OMP_LIST_TO || list == OMP_LIST_ENTER)
+ n->u.common->omp_declare_target = 1;
+ if (list == OMP_LIST_LINK)
+ n->u.common->omp_declare_target_link = 1;
+ if (list == OMP_LIST_LOCAL)
+ n->u.common->omp_declare_target_local = 1;
+
for (s = n->u.common->head; s; s = s->common_next)
{
s->mark = 1;
- if (gfc_add_omp_declare_target (&s->attr, s->name,
- &s->declared_at))
- {
- if (list == OMP_LIST_LINK)
- 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);
+ if (list == OMP_LIST_TO || list == OMP_LIST_ENTER)
+ gfc_add_omp_declare_target (&s->attr, s->name, &n->where);
+ if (list == OMP_LIST_LINK)
+ gfc_add_omp_declare_target_link (&s->attr, s->name, &n->where);
+ if (list == OMP_LIST_LOCAL)
+ gfc_add_omp_declare_target_local (&s->attr, 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 || c->indirect)
&& !c->lists[OMP_LIST_ENTER]
&& !c->lists[OMP_LIST_TO]
- && !c->lists[OMP_LIST_LINK])
+ && !c->lists[OMP_LIST_LINK]
+ && !c->lists[OMP_LIST_LOCAL])
gfc_warning_now (OPT_Wopenmp,
"OMP DECLARE TARGET directive at %L with only "
"DEVICE_TYPE or INDIRECT clauses is ignored",
@@ -7108,32 +7191,44 @@ gfc_match_omp_metadirective (void)
return match_omp_metadirective (false);
}
-match
-gfc_match_omp_threadprivate (void)
+/* Match 'omp threadprivate' or 'omp groupprivate'. */
+static match
+gfc_match_omp_thread_group_private (bool is_groupprivate)
{
locus old_loc;
char n[GFC_MAX_SYMBOL_LEN+1];
gfc_symbol *sym;
match m;
gfc_symtree *st;
+ struct sym_loc_t { gfc_symbol *sym; gfc_common_head *com; locus loc; };
+ auto_vec<sym_loc_t> syms;
old_loc = gfc_current_locus;
- m = gfc_match (" (");
+ m = gfc_match (" ( ");
if (m != MATCH_YES)
return m;
for (;;)
{
+ locus sym_loc = gfc_current_locus;
m = gfc_match_symbol (&sym, 0);
switch (m)
{
case MATCH_YES:
if (sym->attr.in_common)
- gfc_error_now ("Threadprivate variable at %C is an element of "
- "a COMMON block");
- else if (!gfc_add_threadprivate (&sym->attr, sym->name, &sym->declared_at))
+ gfc_error_now ("%qs variable at %L is an element of a COMMON block",
+ is_groupprivate ? "groupprivate" : "threadprivate",
+ &sym_loc);
+ else if (!is_groupprivate
+ && !gfc_add_threadprivate (&sym->attr, sym->name, &sym_loc))
goto cleanup;
+ else if (is_groupprivate)
+ {
+ if (!gfc_add_omp_groupprivate (&sym->attr, sym->name, &sym_loc))
+ goto cleanup;
+ syms.safe_push ({sym, nullptr, sym_loc});
+ }
goto next_item;
case MATCH_NO:
break;
@@ -7150,12 +7245,20 @@ gfc_match_omp_threadprivate (void)
st = gfc_find_symtree (gfc_current_ns->common_root, n);
if (st == NULL)
{
- gfc_error ("COMMON block /%s/ not found at %C", n);
+ gfc_error ("COMMON block /%s/ not found at %L", n, &sym_loc);
goto cleanup;
}
- st->n.common->threadprivate = 1;
+ syms.safe_push ({nullptr, st->n.common, sym_loc});
+ if (is_groupprivate)
+ st->n.common->omp_groupprivate = 1;
+ else
+ st->n.common->threadprivate = 1;
for (sym = st->n.common->head; sym; sym = sym->common_next)
- if (!gfc_add_threadprivate (&sym->attr, sym->name, &sym->declared_at))
+ if (!is_groupprivate
+ && !gfc_add_threadprivate (&sym->attr, sym->name, &sym_loc))
+ goto cleanup;
+ else if (is_groupprivate
+ && !gfc_add_omp_groupprivate (&sym->attr, sym->name, &sym_loc))
goto cleanup;
next_item:
@@ -7165,16 +7268,89 @@ gfc_match_omp_threadprivate (void)
goto syntax;
}
+ if (is_groupprivate)
+ {
+ gfc_omp_clauses *c;
+ m = gfc_match_omp_clauses (&c, omp_mask (OMP_CLAUSE_DEVICE_TYPE));
+ if (m == MATCH_ERROR)
+ return MATCH_ERROR;
+
+ if (c->device_type == OMP_DEVICE_TYPE_UNSET)
+ c->device_type = OMP_DEVICE_TYPE_ANY;
+
+ for (size_t i = 0; i < syms.length (); i++)
+ if (syms[i].sym)
+ {
+ sym_loc_t &n = syms[i];
+ if (n.sym->attr.in_common)
+ gfc_error_now ("Variable %qs at %L is an element of a COMMON "
+ "block", n.sym->name, &n.loc);
+ else if (n.sym->attr.omp_declare_target
+ || n.sym->attr.omp_declare_target_link)
+ gfc_error_now ("List item %qs at %L implies OMP DECLARE TARGET "
+ "with the LOCAL clause, but it has been specified"
+ " with a different clause before",
+ n.sym->name, &n.loc);
+ if (n.sym->attr.omp_device_type != OMP_DEVICE_TYPE_UNSET
+ && n.sym->attr.omp_device_type != c->device_type)
+ {
+ const char *dt = "any";
+ if (n.sym->attr.omp_device_type == OMP_DEVICE_TYPE_HOST)
+ dt = "host";
+ else if (n.sym->attr.omp_device_type == OMP_DEVICE_TYPE_NOHOST)
+ dt = "nohost";
+ gfc_error_now ("List item %qs at %L set in previous OMP DECLARE "
+ "TARGET directive to the different DEVICE_TYPE %qs",
+ n.sym->name, &n.loc, dt);
+ }
+ gfc_add_omp_declare_target_local (&n.sym->attr, n.sym->name,
+ &n.loc);
+ n.sym->attr.omp_device_type = c->device_type;
+ }
+ else /* Common block. */
+ {
+ sym_loc_t &n = syms[i];
+ if (n.com->omp_declare_target
+ || n.com->omp_declare_target_link)
+ gfc_error_now ("List item %</%s/%> at %L implies OMP DECLARE "
+ "TARGET with the LOCAL clause, but it has been "
+ "specified with a different clause before",
+ n.com->name, &n.loc);
+ if (n.com->omp_device_type != OMP_DEVICE_TYPE_UNSET
+ && n.com->omp_device_type != c->device_type)
+ {
+ const char *dt = "any";
+ if (n.com->omp_device_type == OMP_DEVICE_TYPE_HOST)
+ dt = "host";
+ else if (n.com->omp_device_type == OMP_DEVICE_TYPE_NOHOST)
+ dt = "nohost";
+ gfc_error_now ("List item %qs at %L set in previous OMP DECLARE"
+ " TARGET directive to the different DEVICE_TYPE "
+ "%qs", n.com->name, &n.loc, dt);
+ }
+ n.com->omp_declare_target_local = 1;
+ n.com->omp_device_type = c->device_type;
+ for (gfc_symbol *s = n.com->head; s; s = s->common_next)
+ {
+ gfc_add_omp_declare_target_local (&s->attr, s->name, &n.loc);
+ s->attr.omp_device_type = c->device_type;
+ }
+ }
+ free (c);
+ }
+
if (gfc_match_omp_eos () != MATCH_YES)
{
- gfc_error ("Unexpected junk after OMP THREADPRIVATE at %C");
+ gfc_error ("Unexpected junk after OMP %s at %C",
+ is_groupprivate ? "GROUPPRIVATE" : "THREADPRIVATE");
goto cleanup;
}
return MATCH_YES;
syntax:
- gfc_error ("Syntax error in !$OMP THREADPRIVATE list at %C");
+ gfc_error ("Syntax error in !$OMP %s list at %C",
+ is_groupprivate ? "GROUPPRIVATE" : "THREADPRIVATE");
cleanup:
gfc_current_locus = old_loc;
@@ -7182,6 +7358,20 @@ cleanup:
}
+match
+gfc_match_omp_groupprivate (void)
+{
+ return gfc_match_omp_thread_group_private (true);
+}
+
+
+match
+gfc_match_omp_threadprivate (void)
+{
+ return gfc_match_omp_thread_group_private (false);
+}
+
+
match
gfc_match_omp_parallel (void)
{
@@ -8554,7 +8744,7 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
"TO", "FROM", "INCLUSIVE", "EXCLUSIVE",
"REDUCTION", "REDUCTION" /*inscan*/, "REDUCTION" /*task*/,
"IN_REDUCTION", "TASK_REDUCTION",
- "DEVICE_RESIDENT", "LINK", "USE_DEVICE",
+ "DEVICE_RESIDENT", "LINK", "LOCAL", "USE_DEVICE",
"CACHE", "IS_DEVICE_PTR", "USE_DEVICE_PTR", "USE_DEVICE_ADDR",
"NONTEMPORAL", "ALLOCATE", "HAS_DEVICE_ADDR", "ENTER",
"USES_ALLOCATORS", "INIT", "USE", "DESTROY", "INTEROP", "ADJUST_ARGS" };
@@ -8761,6 +8951,9 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
}
if (omp_clauses->num_threads)
resolve_positive_int_expr (omp_clauses->num_threads, "NUM_THREADS");
+ if (omp_clauses->dyn_groupprivate)
+ resolve_positive_int_expr (omp_clauses->dyn_groupprivate,
+ "DYN_GROUPPRIVATE");
if (omp_clauses->chunk_size)
{
gfc_expr *expr = omp_clauses->chunk_size;
diff --git a/gcc/fortran/parse.cc b/gcc/fortran/parse.cc
index e4d65200f3a..3fd45b9518e 100644
--- a/gcc/fortran/parse.cc
+++ b/gcc/fortran/parse.cc
@@ -1195,6 +1195,9 @@ decode_omp_directive (void)
case 'f':
matcho ("flush", gfc_match_omp_flush, ST_OMP_FLUSH);
break;
+ case 'g':
+ matchdo ("groupprivate", gfc_match_omp_groupprivate, ST_OMP_GROUPPRIVATE);
+ break;
case 'i':
matcho ("interop", gfc_match_omp_interop, ST_OMP_INTEROP);
break;
@@ -1990,7 +1993,8 @@ next_statement (void)
#define case_omp_decl case ST_OMP_THREADPRIVATE: case ST_OMP_DECLARE_SIMD: \
case ST_OMP_DECLARE_TARGET: case ST_OMP_DECLARE_REDUCTION: \
case ST_OMP_DECLARE_VARIANT: case ST_OMP_ALLOCATE: case ST_OMP_ASSUMES: \
- case ST_OMP_REQUIRES: case ST_OACC_ROUTINE: case ST_OACC_DECLARE
+ case ST_OMP_REQUIRES: case ST_OMP_GROUPPRIVATE: \
+ case ST_OACC_ROUTINE: case ST_OACC_DECLARE
/* OpenMP statements that are followed by a structured block. */
@@ -2909,6 +2913,9 @@ gfc_ascii_statement (gfc_statement st, bool strip_sentinel)
case ST_OMP_FLUSH:
p = "!$OMP FLUSH";
break;
+ case ST_OMP_GROUPPRIVATE:
+ p = "!$OMP GROUPPRIVATE";
+ break;
case ST_OMP_INTEROP:
p = "!$OMP INTEROP";
break;
@@ -4437,6 +4444,7 @@ loop:
case ST_EQUIVALENCE:
case ST_IMPLICIT:
case ST_IMPLICIT_NONE:
+ case ST_OMP_GROUPPRIVATE:
case ST_OMP_THREADPRIVATE:
case ST_PARAMETER:
case ST_STRUCTURE_DECL:
diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index e4e7751dbf0..9f3ce1d2ad6 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -18714,17 +18714,30 @@ skip_interfaces:
}
/* Check threadprivate restrictions. */
- if (sym->attr.threadprivate
+ if ((sym->attr.threadprivate || sym->attr.omp_groupprivate)
&& !(sym->attr.save || sym->attr.data || sym->attr.in_common)
&& !(sym->ns->save_all && !sym->attr.automatic)
&& sym->module == NULL
&& (sym->ns->proc_name == NULL
|| (sym->ns->proc_name->attr.flavor != FL_MODULE
&& !sym->ns->proc_name->attr.is_main_program)))
- gfc_error ("Threadprivate at %L isn't SAVEd", &sym->declared_at);
+ {
+ if (sym->attr.threadprivate)
+ gfc_error ("Threadprivate at %L isn't SAVEd", &sym->declared_at);
+ else
+ gfc_error ("OpenMP groupprivate variable %qs at %L must have the SAVE "
+ "attribute", sym->name, &sym->declared_at);
+ }
+
+ if (sym->attr.omp_groupprivate && sym->value)
+ gfc_error ("!$OMP GROUPPRIVATE variable %qs at %L must not have an "
+ "initializer", sym->name, &sym->declared_at);
/* Check omp declare target restrictions. */
- if (sym->attr.omp_declare_target
+ if ((sym->attr.omp_declare_target
+ || sym->attr.omp_declare_target_link
+ || sym->attr.omp_declare_target_local)
+ && !sym->attr.omp_groupprivate /* already warned. */
&& sym->attr.flavor == FL_VARIABLE
&& !sym->attr.save
&& !(sym->ns->save_all && !sym->attr.automatic)
diff --git a/gcc/fortran/symbol.cc b/gcc/fortran/symbol.cc
index becaaf39450..62925c028e6 100644
--- a/gcc/fortran/symbol.cc
+++ b/gcc/fortran/symbol.cc
@@ -458,8 +458,10 @@ gfc_check_conflict (symbol_attribute *attr, const char *name, locus *where)
*contiguous = "CONTIGUOUS", *generic = "GENERIC", *automatic = "AUTOMATIC",
*pdt_len = "LEN", *pdt_kind = "KIND";
static const char *threadprivate = "THREADPRIVATE";
+ static const char *omp_groupprivate = "OpenMP GROUPPRIVATE";
static const char *omp_declare_target = "OMP DECLARE TARGET";
static const char *omp_declare_target_link = "OMP DECLARE TARGET LINK";
+ static const char *omp_declare_target_local = "OMP DECLARE TARGET LOCAL";
static const char *oacc_declare_copyin = "OACC DECLARE COPYIN";
static const char *oacc_declare_create = "OACC DECLARE CREATE";
static const char *oacc_declare_deviceptr = "OACC DECLARE DEVICEPTR";
@@ -553,8 +555,10 @@ gfc_check_conflict (symbol_attribute *attr, const char *name, locus *where)
conf (dummy, entry);
conf (dummy, intrinsic);
conf (dummy, threadprivate);
+ conf (dummy, omp_groupprivate);
conf (dummy, omp_declare_target);
conf (dummy, omp_declare_target_link);
+ conf (dummy, omp_declare_target_local);
conf (pointer, target);
conf (pointer, intrinsic);
conf (pointer, elemental);
@@ -604,8 +608,10 @@ gfc_check_conflict (symbol_attribute *attr, const char *name, locus *where)
conf (in_equivalence, entry);
conf (in_equivalence, allocatable);
conf (in_equivalence, threadprivate);
+ conf (in_equivalence, omp_groupprivate);
conf (in_equivalence, omp_declare_target);
conf (in_equivalence, omp_declare_target_link);
+ conf (in_equivalence, omp_declare_target_local);
conf (in_equivalence, oacc_declare_create);
conf (in_equivalence, oacc_declare_copyin);
conf (in_equivalence, oacc_declare_deviceptr);
@@ -616,6 +622,7 @@ gfc_check_conflict (symbol_attribute *attr, const char *name, locus *where)
conf (entry, result);
conf (generic, result);
conf (generic, omp_declare_target);
+ conf (generic, omp_declare_target_local);
conf (generic, omp_declare_target_link);
conf (function, subroutine);
@@ -661,8 +668,10 @@ gfc_check_conflict (symbol_attribute *attr, const char *name, locus *where)
conf (cray_pointee, in_common);
conf (cray_pointee, in_equivalence);
conf (cray_pointee, threadprivate);
+ conf (cray_pointee, omp_groupprivate);
conf (cray_pointee, omp_declare_target);
conf (cray_pointee, omp_declare_target_link);
+ conf (cray_pointee, omp_declare_target_local);
conf (cray_pointee, oacc_declare_create);
conf (cray_pointee, oacc_declare_copyin);
conf (cray_pointee, oacc_declare_deviceptr);
@@ -720,9 +729,11 @@ gfc_check_conflict (symbol_attribute *attr, const char *name, locus *where)
conf (proc_pointer, abstract)
conf (proc_pointer, omp_declare_target)
+ conf (proc_pointer, omp_declare_target_local)
conf (proc_pointer, omp_declare_target_link)
conf (entry, omp_declare_target)
+ conf (entry, omp_declare_target_local)
conf (entry, omp_declare_target_link)
conf (entry, oacc_declare_create)
conf (entry, oacc_declare_copyin)
@@ -782,8 +793,10 @@ gfc_check_conflict (symbol_attribute *attr, const char *name, locus *where)
conf2 (function);
conf2 (subroutine);
conf2 (threadprivate);
+ conf2 (omp_groupprivate);
conf2 (omp_declare_target);
conf2 (omp_declare_target_link);
+ conf2 (omp_declare_target_local);
conf2 (oacc_declare_create);
conf2 (oacc_declare_copyin);
conf2 (oacc_declare_deviceptr);
@@ -828,7 +841,10 @@ gfc_check_conflict (symbol_attribute *attr, const char *name, locus *where)
conf2 (dimension);
conf2 (function);
if (!attr->proc_pointer)
- conf2 (threadprivate);
+ {
+ conf2 (threadprivate);
+ conf2 (omp_groupprivate);
+ }
}
/* Procedure pointers in COMMON blocks are allowed in F03,
@@ -836,6 +852,7 @@ gfc_check_conflict (symbol_attribute *attr, const char *name, locus *where)
if (!attr->proc_pointer || (gfc_option.allow_std & GFC_STD_F2008))
conf2 (in_common);
+ conf2 (omp_declare_target_local);
conf2 (omp_declare_target_link);
switch (attr->proc)
@@ -852,6 +869,7 @@ gfc_check_conflict (symbol_attribute *attr, const char *name, locus *where)
case PROC_DUMMY:
conf2 (result);
conf2 (threadprivate);
+ conf2 (omp_groupprivate);
break;
default:
@@ -872,8 +890,10 @@ gfc_check_conflict (symbol_attribute *attr, const char *name, locus *where)
conf2 (function);
conf2 (subroutine);
conf2 (threadprivate);
+ conf2 (omp_groupprivate);
conf2 (result);
conf2 (omp_declare_target);
+ conf2 (omp_declare_target_local);
conf2 (omp_declare_target_link);
conf2 (oacc_declare_create);
conf2 (oacc_declare_copyin);
@@ -905,6 +925,7 @@ gfc_check_conflict (symbol_attribute *attr, const char *name, locus *where)
conf2 (volatile_);
conf2 (asynchronous);
conf2 (threadprivate);
+ conf2 (omp_groupprivate);
conf2 (value);
conf2 (codimension);
conf2 (result);
@@ -1406,6 +1427,25 @@ gfc_add_asynchronous (symbol_attribute *attr, const char *name, locus *where)
}
+bool
+gfc_add_omp_groupprivate (symbol_attribute *attr, const char *name,
+ locus *where)
+{
+
+ if (check_used (attr, name, where))
+ return false;
+
+ if (attr->omp_groupprivate)
+ {
+ duplicate_attr ("OpenMP GROUPPRIVATE", where);
+ return false;
+ }
+
+ attr->omp_groupprivate = true;
+ return gfc_check_conflict (attr, name, where);
+}
+
+
bool
gfc_add_threadprivate (symbol_attribute *attr, const char *name, locus *where)
{
@@ -1456,6 +1496,22 @@ gfc_add_omp_declare_target_link (symbol_attribute *attr, const char *name,
}
+bool
+gfc_add_omp_declare_target_local (symbol_attribute *attr, const char *name,
+ locus *where)
+{
+
+ if (check_used (attr, name, where))
+ return false;
+
+ if (attr->omp_declare_target_local)
+ return true;
+
+ attr->omp_declare_target_local = 1;
+ return gfc_check_conflict (attr, name, where);
+}
+
+
bool
gfc_add_oacc_declare_create (symbol_attribute *attr, const char *name,
locus *where)
@@ -2110,6 +2166,9 @@ gfc_copy_attr (symbol_attribute *dest, symbol_attribute *src, locus *where)
goto fail;
if (src->asynchronous && !gfc_add_asynchronous (dest, NULL, where))
goto fail;
+ if (src->omp_groupprivate
+ && !gfc_add_omp_groupprivate (dest, NULL, where))
+ goto fail;
if (src->threadprivate
&& !gfc_add_threadprivate (dest, NULL, where))
goto fail;
@@ -2119,6 +2178,9 @@ gfc_copy_attr (symbol_attribute *dest, symbol_attribute *src, locus *where)
if (src->omp_declare_target_link
&& !gfc_add_omp_declare_target_link (dest, NULL, where))
goto fail;
+ if (src->omp_declare_target_local
+ && !gfc_add_omp_declare_target_local (dest, NULL, where))
+ goto fail;
if (src->oacc_declare_create
&& !gfc_add_oacc_declare_create (dest, NULL, where))
goto fail;
diff --git a/gcc/fortran/trans-common.cc b/gcc/fortran/trans-common.cc
index 135d3047a15..6439a1530c6 100644
--- a/gcc/fortran/trans-common.cc
+++ b/gcc/fortran/trans-common.cc
@@ -488,6 +488,27 @@ build_common_decl (gfc_common_head *com, tree union_type, bool is_init)
}
omp_clauses = c;
}
+ /* Also check trans-decl.cc when updating/removing the following;
+ also update f95.c's gfc_gnu_attributes.
+ For the warning, see also OpenMP spec issue 4663. */
+ if (com->omp_groupprivate && com->threadprivate)
+ {
+ /* Unset this flag; implicit 'declare target local(...)' remains. */
+ com->omp_groupprivate = 0;
+ gfc_warning (OPT_Wopenmp,
+ "Ignoring the %<groupprivate%> attribute for "
+ "%<threadprivate%> common block %</%s/%> declared at %L",
+ com->name, &com->where);
+ }
+ if (com->omp_groupprivate)
+ gfc_error ("Sorry, OMP GROUPPRIVATE not implemented, used by common "
+ "block %</%s/%> declared at %L", com->name, &com->where);
+ else if (com->omp_declare_target_local)
+ /* Use 'else if' as groupprivate implies 'local'. */
+ gfc_error ("Sorry, OMP DECLARE TARGET with LOCAL clause not implemented"
+ ", used by common block %</%s/%> declared at %L",
+ com->name, &com->where);
+
if (com->omp_declare_target_link)
DECL_ATTRIBUTES (decl)
= tree_cons (get_identifier ("omp declare target link"),
@@ -497,10 +518,12 @@ build_common_decl (gfc_common_head *com, tree union_type, bool is_init)
= tree_cons (get_identifier ("omp declare target"),
omp_clauses, DECL_ATTRIBUTES (decl));
- if (com->omp_declare_target_link || com->omp_declare_target)
+ if (com->omp_declare_target_link || com->omp_declare_target
+ /* FIXME: || com->omp_declare_target_local */)
{
- /* Add to offload_vars; get_create does so for omp_declare_target,
- omp_declare_target_link requires manual work. */
+ /* Add to offload_vars; get_create does so for omp_declare_target
+ and omp_declare_target_local, omp_declare_target_link requires
+ manual work. */
gcc_assert (symtab_node::get (decl) == 0);
symtab_node *node = symtab_node::get_create (decl);
if (node != NULL && com->omp_declare_target_link)
@@ -1045,8 +1068,10 @@ accumulate_equivalence_attributes (symbol_attribute *dummy_symbol, gfc_equiv *e)
dummy_symbol->generic |= attr.generic;
dummy_symbol->automatic |= attr.automatic;
dummy_symbol->threadprivate |= attr.threadprivate;
+ dummy_symbol->omp_groupprivate |= attr.omp_groupprivate;
dummy_symbol->omp_declare_target |= attr.omp_declare_target;
dummy_symbol->omp_declare_target_link |= attr.omp_declare_target_link;
+ dummy_symbol->omp_declare_target_local |= attr.omp_declare_target_local;
dummy_symbol->oacc_declare_copyin |= attr.oacc_declare_copyin;
dummy_symbol->oacc_declare_create |= attr.oacc_declare_create;
dummy_symbol->oacc_declare_deviceptr |= attr.oacc_declare_deviceptr;
diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
index 419de2c63cf..2164b37e4cb 100644
--- a/gcc/fortran/trans-decl.cc
+++ b/gcc/fortran/trans-decl.cc
@@ -1560,7 +1560,11 @@ add_attributes_to_decl (tree *decl_p, const gfc_symbol *sym)
clauses = c;
}
- if (sym_attr.omp_device_type != OMP_DEVICE_TYPE_UNSET)
+ /* FIXME: 'declare_target_link' permits both any and host, but
+ will fail if one sets OMP_CLAUSE_DEVICE_TYPE_KIND. */
+ if (sym_attr.omp_device_type != OMP_DEVICE_TYPE_UNSET
+ && !sym_attr.omp_declare_target_link
+ && !sym_attr.omp_declare_target_indirect /* implies 'any' */)
{
tree c = build_omp_clause (UNKNOWN_LOCATION, OMP_CLAUSE_DEVICE_TYPE);
switch (sym_attr.omp_device_type)
@@ -1581,6 +1585,26 @@ add_attributes_to_decl (tree *decl_p, const gfc_symbol *sym)
clauses = c;
}
+ /* Also check trans-common.cc when updating/removing the following;
+ also update f95.c's gfc_gnu_attributes.
+ For the warning, see also OpenMP spec issue 4663. */
+ if (sym_attr.omp_groupprivate && sym_attr.threadprivate)
+ {
+ /* Unset this flag; implicit 'declare target local(...)' remains. */
+ sym_attr.omp_groupprivate = 0;
+ gfc_warning (OPT_Wopenmp,
+ "Ignoring the %<groupprivate%> attribute for "
+ "%<threadprivate%> variable %qs declared at %L",
+ sym->name, &sym->declared_at);
+ }
+ if (sym_attr.omp_groupprivate)
+ gfc_error ("Sorry, OMP GROUPPRIVATE not implemented, "
+ "used by %qs declared at %L", sym->name, &sym->declared_at);
+ else if (sym_attr.omp_declare_target_local)
+ /* Use 'else if' as groupprivate implies 'local'. */
+ gfc_error ("Sorry, OMP DECLARE TARGET with LOCAL clause not implemented, "
+ "used by %qs declared at %L", sym->name, &sym->declared_at);
+
bool has_declare = true;
if (sym_attr.omp_declare_target_link
|| sym_attr.oacc_declare_link)
diff --git a/gcc/fortran/trans-openmp.cc b/gcc/fortran/trans-openmp.cc
index 69a70d7138c..c0a8ed927d9 100644
--- a/gcc/fortran/trans-openmp.cc
+++ b/gcc/fortran/trans-openmp.cc
@@ -4180,7 +4180,9 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
tree type = TREE_TYPE (decl);
if (n->sym->ts.type == BT_CHARACTER
&& n->sym->ts.deferred
- && n->sym->attr.omp_declare_target
+ && (n->sym->attr.omp_declare_target
+ || n->sym->attr.omp_declare_target_link
+ || n->sym->attr.omp_declare_target_local)
&& (always_modifier || n->sym->attr.pointer)
&& op != EXEC_OMP_TARGET_EXIT_DATA
&& n->u.map.op != OMP_MAP_DELETE
@@ -5263,6 +5265,25 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
omp_clauses = gfc_trans_add_clause (c, omp_clauses);
}
+ if (clauses->dyn_groupprivate)
+ {
+ sorry_at (gfc_get_location (&where), "%<dyn_groupprivate%> clause");
+#if 0 /* FIXME: Handle it, including 'fallback(abort/default_mem/null)' */
+ tree dyn_groupprivate;
+
+ gfc_init_se (&se, NULL);
+ gfc_conv_expr (&se, clauses->dyn_groupprivate);
+ gfc_add_block_to_block (block, &se.pre);
+ dyn_groupprivate = gfc_evaluate_now (se.expr, block);
+ gfc_add_block_to_block (block, &se.post);
+
+ c = build_omp_clause (gfc_get_location (&where),
+ OMP_CLAUSE_DYN_GROUPPRIVATE);
+ OMP_CLAUSE_NUM_THREADS_EXPR (c) = num_threads;
+ omp_clauses = gfc_trans_add_clause (c, omp_clauses);
+#endif
+ }
+
chunk_size = NULL_TREE;
if (clauses->chunk_size)
{
diff --git a/gcc/testsuite/gfortran.dg/gomp/crayptr2.f90 b/gcc/testsuite/gfortran.dg/gomp/crayptr2.f90
index 476d7b9e771..06ac60424e9 100644
--- a/gcc/testsuite/gfortran.dg/gomp/crayptr2.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/crayptr2.f90
@@ -3,7 +3,7 @@
! { dg-require-effective-target tls }
module crayptr2
- integer :: e ! { dg-error "CRAY POINTEE attribute conflicts with THREADPRIVATE" }
+ integer :: e
pointer (ip5, e)
! The standard is not very clear about this.
@@ -12,6 +12,6 @@ module crayptr2
! be if they are module variables. But threadprivate pointees don't
! make any sense anyway.
-!$omp threadprivate (e)
+!$omp threadprivate (e) ! { dg-error "CRAY POINTEE attribute conflicts with THREADPRIVATE" }
end module crayptr2
diff --git a/gcc/testsuite/gfortran.dg/gomp/declare-target-2.f90 b/gcc/testsuite/gfortran.dg/gomp/declare-target-2.f90
index 93075fb147e..b4f1e52f725 100644
--- a/gcc/testsuite/gfortran.dg/gomp/declare-target-2.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/declare-target-2.f90
@@ -24,7 +24,11 @@ module declare_target_2
end interface
end
subroutine bar
+ !$omp declare target enter (q) ! { dg-error "isn.t SAVEd" }
+ !$omp declare target link (r) ! { dg-error "isn.t SAVEd" }
+ !$omp declare target local (s) ! { dg-error "isn.t SAVEd" }
!$omp declare target link (baz) ! { dg-error "isn.t SAVEd" }
+ integer :: q, r, s
call baz ! { dg-error "attribute conflicts" }
end subroutine
subroutine foo ! { dg-error "attribute conflicts" }
diff --git a/gcc/testsuite/gfortran.dg/gomp/declare-target-4.f90 b/gcc/testsuite/gfortran.dg/gomp/declare-target-4.f90
index 55534d8fe99..296c0dbd869 100644
--- a/gcc/testsuite/gfortran.dg/gomp/declare-target-4.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/declare-target-4.f90
@@ -42,15 +42,14 @@ module mymod
!$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 link(e) device_type(nohost) ! -> invalid: only 'any' is permitted
+ ! !$omp declare target link(f) device_type(host) ! -> invalid: only 'any' is permitted
+ !$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(/block4/) device_type(nohost) ! -> invalid, link requires host or any
!$omp declare target link(/block5/) device_type(host)
!$omp declare target link(/block6/) device_type(any)
contains
diff --git a/gcc/testsuite/gfortran.dg/gomp/declare-target-5.f90 b/gcc/testsuite/gfortran.dg/gomp/declare-target-5.f90
index 76687d476d5..0dacb895229 100644
--- a/gcc/testsuite/gfortran.dg/gomp/declare-target-5.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/declare-target-5.f90
@@ -4,9 +4,15 @@ 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" }
+ !$omp declare target to(bar) device_type(host) ! { dg-error "set in previous OMP DECLARE TARGET directive to the different DEVICE_TYPE 'nohost'" }
end
+module invalid
+ implicit none
+ integer :: d
+ !$omp declare target link(d) device_type(nohost) ! { dg-error "set with NOHOST specified may not appear in a LINK clause" }
+end module
+
module mymod_one
implicit none
integer :: a, b, c, d, e ,f
@@ -17,24 +23,21 @@ module mymod_one
!$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" }
+ !$omp declare target to(a) device_type(any) ! { dg-error "set in previous OMP DECLARE TARGET directive to the different DEVICE_TYPE 'nohost'" }
+ !$omp declare target to(b) device_type(host) ! { dg-error "set in previous OMP DECLARE TARGET directive to the different DEVICE_TYPE 'any'" }
+ !$omp declare target to(c) device_type(nohost) ! { dg-error "set in previous OMP DECLARE TARGET directive to the different DEVICE_TYPE 'host'" }
+ !$omp declare target link(e) device_type(host) ! { dg-error "set in previous OMP DECLARE TARGET directive to the different DEVICE_TYPE 'any'" }
+ !$omp declare target link(f) device_type(any) ! { dg-error "set in previous OMP DECLARE TARGET directive to the different DEVICE_TYPE 'host'" }
end module
module mymod
@@ -47,17 +50,15 @@ module mymod
!$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(d) device_type(nohost) ! { dg-error "set with NOHOST specified may not appear in a LINK clause" }
!$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" }
+
+ !$omp declare target to(a) device_type(any) ! { dg-error "set in previous OMP DECLARE TARGET directive to the different DEVICE_TYPE 'nohost'" }
+ !$omp declare target to(b) device_type(host) ! { dg-error "set in previous OMP DECLARE TARGET directive to the different DEVICE_TYPE 'any'" }
+ !$omp declare target to(c) device_type(nohost) ! { dg-error "set in previous OMP DECLARE TARGET directive to the different DEVICE_TYPE 'host'" }
+ !$omp declare target link(e) device_type(host) ! { dg-error "set in previous OMP DECLARE TARGET directive to the different DEVICE_TYPE 'any'" }
+ !$omp declare target link(f) device_type(any) ! { dg-error "set in previous OMP DECLARE TARGET directive to the different DEVICE_TYPE 'host'" }
end
diff --git a/gcc/testsuite/gfortran.dg/gomp/declare-target-6.f90 b/gcc/testsuite/gfortran.dg/gomp/declare-target-6.f90
new file mode 100644
index 00000000000..21970e6fbb4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/declare-target-6.f90
@@ -0,0 +1,15 @@
+subroutine sub ! { dg-error "SUBROUTINE attribute conflicts with OMP DECLARE TARGET LINK attribute in 'sub'" }
+ !$omp declare target link(sub)
+end subroutine sub
+
+subroutine sub2 ! { dg-error "SUBROUTINE attribute conflicts with OMP DECLARE TARGET LOCAL attribute in 'sub2'" }
+ !$omp declare target local(sub2)
+end subroutine sub2
+
+integer function func() ! { dg-error "PROCEDURE attribute conflicts with OMP DECLARE TARGET LINK attribute in 'func'" }
+ !$omp declare target link(func)
+end
+
+integer function func2() ! { dg-error "PROCEDURE attribute conflicts with OMP DECLARE TARGET LOCAL attribute in 'func2'" }
+ !$omp declare target local(func2)
+end
diff --git a/gcc/testsuite/gfortran.dg/gomp/declare-target-indirect-2.f90 b/gcc/testsuite/gfortran.dg/gomp/declare-target-indirect-2.f90
index f6b3ae17856..4345c69b74b 100644
--- a/gcc/testsuite/gfortran.dg/gomp/declare-target-indirect-2.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/declare-target-indirect-2.f90
@@ -11,7 +11,7 @@ contains
subroutine sub2
!$omp declare target indirect (.false.) to (sub2)
end subroutine
- ! { dg-final { scan-tree-dump "__attribute__\\\(\\\(omp declare target\\\)\\\)\\\n.*\\\nvoid sub2" "gimple" } }
+ ! { dg-final { scan-tree-dump "__attribute__\\\(\\\(omp declare target \\(device_type\\(any\\)\\)\\\)\\\)\\\n.*\\\nvoid sub2" "gimple" } }
subroutine sub3
!$omp declare target indirect (.true.) to (sub3)
@@ -21,5 +21,5 @@ contains
subroutine sub4
!$omp declare target indirect (.false.) enter (sub4)
end subroutine
- ! { dg-final { scan-tree-dump "__attribute__\\\(\\\(omp declare target\\\)\\\)\\\n.*\\\nvoid sub4" "gimple" } }
+ ! { dg-final { scan-tree-dump "__attribute__\\\(\\\(omp declare target \\(device_type\\(any\\)\\)\\\)\\\)\\\n.*\\\nvoid sub4" "gimple" } }
end module
diff --git a/gcc/testsuite/gfortran.dg/gomp/dyn_groupprivate-1.f90 b/gcc/testsuite/gfortran.dg/gomp/dyn_groupprivate-1.f90
new file mode 100644
index 00000000000..2e09febe18c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/dyn_groupprivate-1.f90
@@ -0,0 +1,20 @@
+implicit none
+
+integer :: N
+N = 1024
+
+!$omp target dyn_groupprivate(1024) ! { dg-message "sorry, unimplemented: 'dyn_groupprivate' clause" }
+!$omp end target
+
+!$omp target dyn_groupprivate (1024 * N) ! { dg-message "sorry, unimplemented: 'dyn_groupprivate' clause" }
+!$omp end target
+
+!$omp target dyn_groupprivate ( fallback ( abort ) : N) ! { dg-message "sorry, unimplemented: 'dyn_groupprivate' clause" }
+!$omp end target
+
+!$omp target dyn_groupprivate ( fallback ( null ) : N) ! { dg-message "sorry, unimplemented: 'dyn_groupprivate' clause" }
+!$omp end target
+
+!$omp target dyn_groupprivate ( fallback ( default_mem ) : N) ! { dg-message "sorry, unimplemented: 'dyn_groupprivate' clause" }
+!$omp end target
+end
diff --git a/gcc/testsuite/gfortran.dg/gomp/dyn_groupprivate-2.f90 b/gcc/testsuite/gfortran.dg/gomp/dyn_groupprivate-2.f90
new file mode 100644
index 00000000000..0a5a644b9f4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/dyn_groupprivate-2.f90
@@ -0,0 +1,23 @@
+implicit none
+
+integer, parameter :: M = 1024
+integer :: N, A(1)
+
+N = 1024
+
+!$omp target dyn_groupprivate(-123) ! { dg-warning "INTEGER expression of DYN_GROUPPRIVATE clause at .1. must be positive \\\[-Wopenmp\\\]" }
+block; end block
+
+!$omp target dyn_groupprivate (0 * M) ! { dg-warning "INTEGER expression of DYN_GROUPPRIVATE clause at .1. must be positive \\\[-Wopenmp\\\]" }
+block; end block
+
+!$omp target dyn_groupprivate ( fallback ( other ) : N) ! { dg-error "Failed to match clause" }
+block; end block
+
+!$omp target dyn_groupprivate ( A ) ! { dg-error "DYN_GROUPPRIVATE clause at .1. requires a scalar INTEGER expression" }
+block; end block
+
+!$omp target dyn_groupprivate ( 1024. ) ! { dg-error "DYN_GROUPPRIVATE clause at .1. requires a scalar INTEGER expression" }
+block; end block
+
+end
diff --git a/gcc/testsuite/gfortran.dg/gomp/groupprivate-1.f90 b/gcc/testsuite/gfortran.dg/gomp/groupprivate-1.f90
new file mode 100644
index 00000000000..f776c0875dd
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/groupprivate-1.f90
@@ -0,0 +1,23 @@
+module m
+ implicit none
+ integer :: ii
+ integer :: x, y(20), z, v, u, k ! { dg-warning "Ignoring the 'groupprivate' attribute for 'threadprivate' variable 'k' declared at .1. \\\[-Wopenmp\\\]" }
+! { dg-error "Sorry, OMP GROUPPRIVATE not implemented, used by 'x' declared at .1." "" { target *-*-* } .-1 }
+! { dg-error "Sorry, OMP GROUPPRIVATE not implemented, used by 'y' declared at .1." "" { target *-*-* } .-2 }
+! { dg-error "Sorry, OMP GROUPPRIVATE not implemented, used by 'z' declared at .1." "" { target *-*-* } .-3 }
+! { dg-error "Sorry, OMP GROUPPRIVATE not implemented, used by 'v' declared at .1." "" { target *-*-* } .-4 }
+! { dg-error "Sorry, OMP GROUPPRIVATE not implemented, used by 'u' declared at .1." "" { target *-*-* } .-5 }
+!
+! Note:Error different as 'groupprivate' flag is overwritten by 'threadprivate', cf. warning above.
+! { dg-error "Sorry, OMP DECLARE TARGET with LOCAL clause not implemented, used by 'k' declared at .1." "" { target *-*-* } .-8 }
+ !$omp groupprivate(x, z) device_Type( any )
+ !$omp declare target local(x) device_type ( any )
+ !$omp declare target enter( ii) ,local(y), device_type ( host )
+ !$omp groupprivate(y) device_type( host)
+ !$omp groupprivate(v) device_type (nohost )
+ !$omp groupprivate(u)
+
+ ! See also (currently unresolved) OpenMP Specification Issue 4663.
+ !$omp groupprivate(k)
+ !$omp threadprivate(k)
+end module
diff --git a/gcc/testsuite/gfortran.dg/gomp/groupprivate-2.f90 b/gcc/testsuite/gfortran.dg/gomp/groupprivate-2.f90
new file mode 100644
index 00000000000..922d229bf89
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/groupprivate-2.f90
@@ -0,0 +1,37 @@
+module m
+ implicit none
+ integer :: ii
+ integer :: x, y(20), z, v, q, r,o, b2,c
+
+ !$omp groupprivate(x, z, o) device_Type( any )
+ !$omp declare target enter(x) device_type ( any ) ! { dg-error "List item 'x' at .1. not appear in the 'enter' clause as it was previously specified in a GROUPPRIVATE directive" }
+ !$omp declare target to(z) device_type ( any ) ! { dg-error "List item 'z' at .1. not appear in the 'to' clause as it was previously specified in a GROUPPRIVATE directive" }
+ !$omp declare target link(o) device_type ( any ) ! { dg-error "List item 'o' at .1. not appear in the 'link' clause as it was previously specified in a GROUPPRIVATE directive" }
+ !$omp declare target enter( ii) ,local(y,c), link(r), to(q) device_type ( host )
+ !$omp groupprivate(r,q) device_type(host)
+! { dg-error "List item 'q' at .1. implies OMP DECLARE TARGET with the LOCAL clause, but it has been specified with a different clause before" "" { target *-*-* } .-1 }
+! { dg-error "List item 'r' at .1. implies OMP DECLARE TARGET with the LOCAL clause, but it has been specified with a different clause before" "" { target *-*-* } .-2 }
+ !$omp groupprivate(c) ! { dg-error "List item 'c' at .1. set in previous OMP DECLARE TARGET directive to the different DEVICE_TYPE 'host'" }
+ !$omp groupprivate(y) device_type( any) ! { dg-error "List item 'y' at .1. set in previous OMP DECLARE TARGET directive to the different DEVICE_TYPE 'host'" }
+ !$omp groupprivate(v) device_type (nohost )
+ !$omp groupprivate(v) ! { dg-error "Duplicate OpenMP GROUPPRIVATE attribute specified" }
+
+ !$omp declare target link(b2) device_type(nohost) ! { dg-error "List item 'b2' at .1. set with NOHOST specified may not appear in a LINK clause" }
+end module
+
+subroutine sub()
+ implicit none
+ integer, save :: x0,x1,x2,x3,x4
+ !$omp groupprivate(x0)
+ !$omp groupprivate(x1)
+ !$omp groupprivate(x2) device_type ( any)
+ !$omp groupprivate(x3) device_type (host )
+ !$omp groupprivate(x4) device_type( nohost)
+
+ !$omp declare target(x0) ! { dg-error "List item 'x0' at .1. not appear in the 'enter' clause as it was previously specified in a GROUPPRIVATE directive" }
+ !$omp declare target device_type(any) to(x1) ! { dg-error "List item 'x1' at .1. not appear in the 'to' clause as it was previously specified in a GROUPPRIVATE directive" }
+ !$omp declare target device_type(any) enter(x2) ! { dg-error "List item 'x2' at .1. not appear in the 'enter' clause as it was previously specified in a GROUPPRIVATE directive" }
+ !$omp declare target device_type(host) link(x3) ! { dg-error "List item 'x3' at .1. not appear in the 'link' clause as it was previously specified in a GROUPPRIVATE directive" }
+ !$omp declare target device_type(host) local(x4) ! { dg-error "List item 'x4' at .1. set in previous OMP GROUPPRIVATE directive to the different DEVICE_TYPE 'nohost'" }
+
+end
diff --git a/gcc/testsuite/gfortran.dg/gomp/groupprivate-3.f90 b/gcc/testsuite/gfortran.dg/gomp/groupprivate-3.f90
new file mode 100644
index 00000000000..d7ccbe292d5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/groupprivate-3.f90
@@ -0,0 +1,16 @@
+module m
+implicit none
+integer :: y = 5 ! { dg-error "!.OMP GROUPPRIVATE variable 'y' at .1. must not have an initializer" }
+!$omp groupprivate(y)
+end
+
+subroutine sub
+ integer :: k ! { dg-error "OpenMP groupprivate variable 'k' at .1. must have the SAVE attribute" }
+ !$omp groupprivate(k)
+end
+
+subroutine sub2
+ !$omp groupprivate(q)
+ integer, save :: q
+ !$omp groupprivate(q) ! { dg-error "Duplicate OpenMP GROUPPRIVATE attribute specified at .1." }
+end
diff --git a/gcc/testsuite/gfortran.dg/gomp/groupprivate-4.f90 b/gcc/testsuite/gfortran.dg/gomp/groupprivate-4.f90
new file mode 100644
index 00000000000..2a3a054483e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/groupprivate-4.f90
@@ -0,0 +1,25 @@
+module m
+ implicit none
+ integer :: ii
+ integer :: x, y(20), z, v, u, k
+
+ common /b_ii/ ii
+ common /b_x/ x ! { dg-error "Sorry, OMP GROUPPRIVATE not implemented, used by common block '/b_x/' declared at .1." }
+ common /b_y/ y ! { dg-error "Sorry, OMP GROUPPRIVATE not implemented, used by common block '/b_y/' declared at .1." }
+ common /b_z/ z ! { dg-error "Sorry, OMP GROUPPRIVATE not implemented, used by common block '/b_z/' declared at .1." }
+ common /b_v/ v ! { dg-error "Sorry, OMP GROUPPRIVATE not implemented, used by common block '/b_v/' declared at .1." }
+ common /b_u/ u ! { dg-error "Sorry, OMP GROUPPRIVATE not implemented, used by common block '/b_u/' declared at .1." }
+ common /b_k/ k ! { dg-warning "Ignoring the 'groupprivate' attribute for 'threadprivate' common block '/b_k/' declared at .1. \\\[-Wopenmp\\\]" }
+! { dg-error "Sorry, OMP DECLARE TARGET with LOCAL clause not implemented, used by common block '/b_k/' declared at .1." "" { target *-*-* } .-1 }
+
+ !$omp groupprivate(/b_x/, /b_z/) device_Type( any )
+ !$omp declare target local(/b_x/) device_type ( any )
+ !$omp declare target enter( /b_ii/) ,local(/b_y/), device_type ( host )
+ !$omp groupprivate(/b_y/) device_type( host)
+ !$omp groupprivate(/b_v/) device_type (nohost )
+ !$omp groupprivate(/b_u/)
+
+ ! See also (currently unresolved) OpenMP Specification Issue 4663.
+ !$omp groupprivate(/b_k/)
+ !$omp threadprivate(/b_k/)
+end module
diff --git a/gcc/testsuite/gfortran.dg/gomp/groupprivate-5.f90 b/gcc/testsuite/gfortran.dg/gomp/groupprivate-5.f90
new file mode 100644
index 00000000000..c9f89feb4aa
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/groupprivate-5.f90
@@ -0,0 +1,58 @@
+module m
+ implicit none
+ integer :: ii
+ integer :: x, y(20), z, v, q, r,o, b2,c
+
+ common /b_ii/ ii
+ common /b_x/ x
+ common /b_y/ y
+ common /b_z/ z
+ common /b_v/ v
+ common /b_q/ q
+ common /b_r/ r
+ common /b_o/ o
+ common /b_b2/ b2
+ common /b_c/ c
+
+ !$omp groupprivate(/b_x/, /b_z/, /b_o/) device_Type( any )
+ !$omp declare target enter(/b_x/) device_type ( any ) ! { dg-error "Common block '/b_x/' at .1. not appear in the 'enter' clause as it was previously specified in a GROUPPRIVATE directive" }
+ !$omp declare target to(/b_z/) device_type ( any ) ! { dg-error "Common block '/b_z/' at .1. not appear in the 'to' clause as it was previously specified in a GROUPPRIVATE directive" }
+ !$omp declare target link(/b_o/) device_type ( any ) ! { dg-error "Common block '/b_o/' at .1. not appear in the 'link' clause as it was previously specified in a GROUPPRIVATE directive" }
+ !$omp declare target enter( / b_ii / ) ,local(/b_y/ , /b_c/), link(/b_r/), to(/b_q/) device_type ( host )
+ !$omp groupprivate( /b_r/ ,/b_q/) device_type(host)
+! { dg-error "List item '/b_r/' at .1. implies OMP DECLARE TARGET with the LOCAL clause, but it has been specified with a different clause before" "" { target *-*-* } .-1 }
+! { dg-error "List item '/b_q/' at .1. implies OMP DECLARE TARGET with the LOCAL clause, but it has been specified with a different clause before" "" { target *-*-* } .-2 }
+ !$omp groupprivate(/b_c/) ! { dg-error "List item 'b_c' at .1. set in previous OMP DECLARE TARGET directive to the different DEVICE_TYPE 'host'" }
+ !$omp groupprivate(/b_y/) device_type( any) ! { dg-error "List item 'b_y' at .1. set in previous OMP DECLARE TARGET directive to the different DEVICE_TYPE 'host'" }
+ !$omp groupprivate(/b_v/) device_type (nohost )
+ !$omp groupprivate(/b_v/) ! { dg-error "Duplicate OpenMP GROUPPRIVATE attribute specified at .1." }
+
+ !$omp declare target link(/b_b2/) device_type(nohost) ! { dg-error "Common block '/b_b2/' at .1. set with NOHOST specified may not appear in a LINK clause" }
+end module
+
+subroutine sub()
+ implicit none
+ integer, save :: xx
+ integer :: x0,x1,x2,x3,x4
+
+ common /b_xx/ xx ! { dg-error "COMMON attribute conflicts with SAVE attribute in 'xx' at .1." }
+ common /b_x0/ x0
+ common /b_x1/ x1
+ common /b_x2/ x2
+ common /b_x3/ x3
+ common /b_x4/ x4
+
+ !$omp groupprivate(/b_xx/) ! { dg-error "COMMON attribute conflicts with SAVE attribute in 'xx' at .1." }
+ !$omp groupprivate(/b_x0/)
+ !$omp groupprivate(/b_x1/)
+ !$omp groupprivate(/b_x2/) device_type ( any)
+ !$omp groupprivate(/b_x3/) device_type (host )
+ !$omp groupprivate(/b_x4/) device_type( nohost)
+
+ !$omp declare target(/b_x0/) ! { dg-error "Common block '/b_x0/' at .1. not appear in the 'enter' clause as it was previously specified in a GROUPPRIVATE directive" }
+ !$omp declare target device_type(any) to(/b_x1/) ! { dg-error "Common block '/b_x1/' at .1. not appear in the 'to' clause as it was previously specified in a GROUPPRIVATE directive" }
+ !$omp declare target device_type(any) enter(/b_x2/) ! { dg-error "Common block '/b_x2/' at .1. not appear in the 'enter' clause as it was previously specified in a GROUPPRIVATE directive" }
+ !$omp declare target device_type(host) link(/b_x3/) ! { dg-error "Common block '/b_x3/' at .1. not appear in the 'link' clause as it was previously specified in a GROUPPRIVATE directive" }
+ !$omp declare target device_type(host) local(/b_x4/) ! { dg-error "Common block '/b_x4/' at .1. set in previous OMP GROUPPRIVATE directive to the different DEVICE_TYPE 'nohost'" }
+
+end
diff --git a/gcc/testsuite/gfortran.dg/gomp/groupprivate-6.f90 b/gcc/testsuite/gfortran.dg/gomp/groupprivate-6.f90
new file mode 100644
index 00000000000..6ae5b3dc59b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/groupprivate-6.f90
@@ -0,0 +1,34 @@
+module m
+implicit none
+integer :: y = 5 ! { dg-error "!.OMP GROUPPRIVATE variable 'y' at .1. must not have an initializer" }
+common /b_y/ y
+!$omp groupprivate(/b_y/)
+end
+
+subroutine sub
+ integer, save :: k
+ common /b_k/ k ! { dg-error "COMMON attribute conflicts with SAVE attribute in 'k' at .1." }
+ !$omp groupprivate(/b_k/) ! { dg-error "COMMON attribute conflicts with SAVE attribute in 'k' at .1." }
+end
+
+subroutine sub2
+ common /b_q/ q
+ !$omp groupprivate(/b_q/)
+ integer :: q
+ !$omp groupprivate(/b_q/) ! { dg-error "Duplicate OpenMP GROUPPRIVATE attribute specified at .1." }
+end
+
+subroutine dupl
+ integer :: a,b,c,d
+ integer :: u,v,w,x
+ common /b_a/ a
+ common /b_b/ b
+ common /b_c/ c
+ common /b_d/ d
+
+ !$omp groupprivate(/b_a/,u,/b_a/) ! { dg-error "Duplicate OpenMP GROUPPRIVATE attribute specified" }
+ !$omp groupprivate(v,/b_b/,v) ! { dg-error "Duplicate OpenMP GROUPPRIVATE attribute specified" }
+
+ !$omp threadprivate(/b_a/,u,/b_a/) ! { dg-error "Duplicate THREADPRIVATE attribute specified" }
+ !$omp threadprivate(v,/b_b/,v) ! { dg-error "Duplicate THREADPRIVATE attribute specified" }
+end
