* [Patch][GCC12] Fortran/OpenMP: Add 'omp depobj' and 'depend(mutexinoutset:'
@ 2021-03-17 18:19 Tobias Burnus
2021-03-17 18:29 ` Jakub Jelinek
0 siblings, 1 reply; 3+ messages in thread
From: Tobias Burnus @ 2021-03-17 18:19 UTC (permalink / raw)
To: gcc-patches, fortran, Jakub Jelinek
[-- Attachment #1: Type: text/plain, Size: 433 bytes --]
This adds 'omp depobj' and updates the depend clause to handle
'depobj' and 'mutexinoutset'.
interator(...) is not yet implemented in the Fortran FE and, hence,
I also did not add it to depobj in this patchset.
OK for GCC 12 mainline?
Tobias
-----------------
Mentor Graphics (Deutschland) GmbH, Arnulfstrasse 201, 80634 München Registergericht München HRB 106955, Geschäftsführer: Thomas Heurung, Frank Thürauf
[-- Attachment #2: omp-depobj.diff --]
[-- Type: text/x-patch, Size: 27013 bytes --]
Fortran/OpenMP: Add 'omp depobj' and 'depend(mutexinoutset:'
gcc/fortran/ChangeLog:
* dump-parse-tree.c (show_omp_namelist): Handle depobj + mutexinoutset
in the depend clause.
(show_omp_clauses, show_omp_node, show_code_node): Handle depobj.
* gfortran.h (enum gfc_statement): Add ST_OMP_DEPOBJ.
(enum gfc_omp_depend_op): Add OMP_DEPEND_UNSET,
OMP_DEPEND_MUTEXINOUTSET and OMP_DEPEND_DEPOBJ.
(gfc_omp_clauses): Add destroy, depobj_update and depobj.
(enum gfc_exec_op): Add EXEC_OMP_DEPOBJ
* match.h (gfc_match_omp_depobj): Match 'omp depobj'.
* openmp.c (gfc_match_omp_clauses): Add depobj + mutexinoutset
to depend clause.
(gfc_match_omp_depobj, resolve_omp_clauses, gfc_resolve_omp_directive):
Handle 'omp depobj'.
* parse.c (decode_omp_directive, next_statement, gfc_ascii_statement):
Likewise.
* resolve.c (gfc_resolve_code): Likewise.
* st.c (gfc_free_statement): Likewise.
* trans-openmp.c (gfc_trans_omp_clauses): Handle depobj + mutexinoutset
in the depend clause.
(gfc_trans_omp_depobj, gfc_trans_omp_directive): Handle EXEC_OMP_DEPOBJ.
* trans.c (trans_code): Likewise.
libgomp/ChangeLog:
* testsuite/libgomp.fortran/depobj-1.f90: New test.
gcc/testsuite/ChangeLog:
* gfortran.dg/gomp/depobj-1.f90: New test.
* gfortran.dg/gomp/depobj-2.f90: New test.
gcc/fortran/dump-parse-tree.c | 33 ++++++++
gcc/fortran/gfortran.h | 12 ++-
gcc/fortran/match.h | 1 +
gcc/fortran/openmp.c | 110 ++++++++++++++++++++++++
gcc/fortran/parse.c | 6 +-
gcc/fortran/resolve.c | 1 +
gcc/fortran/st.c | 1 +
gcc/fortran/trans-openmp.c | 68 +++++++++++++++
gcc/fortran/trans.c | 1 +
gcc/testsuite/gfortran.dg/gomp/depobj-1.f90 | 26 ++++++
gcc/testsuite/gfortran.dg/gomp/depobj-2.f90 | 29 +++++++
libgomp/testsuite/libgomp.fortran/depobj-1.f90 | 113 +++++++++++++++++++++++++
12 files changed, 396 insertions(+), 5 deletions(-)
diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c
index 059d8421bb5..f7f1ebcfc5e 100644
--- a/gcc/fortran/dump-parse-tree.c
+++ b/gcc/fortran/dump-parse-tree.c
@@ -1332,6 +1332,10 @@ show_omp_namelist (int list_type, gfc_omp_namelist *n)
case OMP_DEPEND_IN: fputs ("in:", dumpfile); break;
case OMP_DEPEND_OUT: fputs ("out:", dumpfile); break;
case OMP_DEPEND_INOUT: fputs ("inout:", dumpfile); break;
+ case OMP_DEPEND_DEPOBJ: fputs ("depobj:", dumpfile); break;
+ case OMP_DEPEND_MUTEXINOUTSET:
+ fputs ("mutexinoutset:", dumpfile);
+ break;
case OMP_DEPEND_SINK_FIRST:
fputs ("sink:", dumpfile);
while (1)
@@ -1754,10 +1758,27 @@ show_omp_clauses (gfc_omp_clauses *omp_clauses)
show_expr (omp_clauses->if_exprs[i]);
fputc (')', dumpfile);
}
+ if (omp_clauses->destroy)
+ fputs (" DESTROY", dumpfile);
if (omp_clauses->depend_source)
fputs (" DEPEND(source)", dumpfile);
if (omp_clauses->capture)
fputs (" CAPTURE", dumpfile);
+ if (omp_clauses->depobj_update != OMP_DEPEND_UNSET)
+ {
+ const char *deptype;
+ fputs (" UPDATE(", dumpfile);
+ switch (omp_clauses->depobj_update)
+ {
+ case OMP_DEPEND_IN: deptype = "IN"; break;
+ case OMP_DEPEND_OUT: deptype = "OUT"; break;
+ case OMP_DEPEND_INOUT: deptype = "INOUT"; break;
+ case OMP_DEPEND_MUTEXINOUTSET: deptype = "MUTEXINOUTSET"; break;
+ default: gcc_unreachable ();
+ }
+ fputs (deptype, dumpfile);
+ fputc (')', dumpfile);
+ }
if (omp_clauses->atomic_op != GFC_OMP_ATOMIC_UNSET)
{
const char *atomic_op;
@@ -1831,6 +1852,7 @@ show_omp_node (int level, gfc_code *c)
case EXEC_OMP_FLUSH: name = "FLUSH"; break;
case EXEC_OMP_MASTER: name = "MASTER"; break;
case EXEC_OMP_ORDERED: name = "ORDERED"; break;
+ case EXEC_OMP_DEPOBJ: name = "DEPBOBJ"; break;
case EXEC_OMP_PARALLEL: name = "PARALLEL"; break;
case EXEC_OMP_PARALLEL_DO: name = "PARALLEL DO"; break;
case EXEC_OMP_PARALLEL_DO_SIMD: name = "PARALLEL DO SIMD"; break;
@@ -1941,6 +1963,15 @@ show_omp_node (int level, gfc_code *c)
if (omp_clauses)
fprintf (dumpfile, " (%s)", c->ext.omp_clauses->critical_name);
break;
+ case EXEC_OMP_DEPOBJ:
+ omp_clauses = c->ext.omp_clauses;
+ if (omp_clauses)
+ {
+ fputc ('(', dumpfile);
+ show_expr (c->ext.omp_clauses->depobj);
+ fputc (')', dumpfile);
+ }
+ break;
case EXEC_OMP_FLUSH:
if (c->ext.omp_namelist)
{
@@ -1969,6 +2000,7 @@ show_omp_node (int level, gfc_code *c)
|| c->op == EXEC_OACC_ENTER_DATA || c->op == EXEC_OACC_EXIT_DATA
|| c->op == EXEC_OMP_TARGET_UPDATE || c->op == EXEC_OMP_TARGET_ENTER_DATA
|| c->op == EXEC_OMP_TARGET_EXIT_DATA || c->op == EXEC_OMP_SCAN
+ || c->op == EXEC_OMP_DEPOBJ
|| (c->op == EXEC_OMP_ORDERED && c->block == NULL))
return;
if (c->op == EXEC_OMP_SECTIONS || c->op == EXEC_OMP_PARALLEL_SECTIONS)
@@ -3094,6 +3126,7 @@ show_code_node (int level, gfc_code *c)
case EXEC_OMP_CANCELLATION_POINT:
case EXEC_OMP_BARRIER:
case EXEC_OMP_CRITICAL:
+ case EXEC_OMP_DEPOBJ:
case EXEC_OMP_DISTRIBUTE:
case EXEC_OMP_DISTRIBUTE_PARALLEL_DO:
case EXEC_OMP_DISTRIBUTE_PARALLEL_DO_SIMD:
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 7935aca23db..d12be0cdbab 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -261,7 +261,7 @@ enum gfc_statement
ST_OMP_TARGET_PARALLEL_DO_SIMD, ST_OMP_END_TARGET_PARALLEL_DO_SIMD,
ST_OMP_TARGET_ENTER_DATA, ST_OMP_TARGET_EXIT_DATA,
ST_OMP_TARGET_SIMD, ST_OMP_END_TARGET_SIMD,
- ST_OMP_TASKLOOP, ST_OMP_END_TASKLOOP, ST_OMP_SCAN,
+ 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_GET_FCN_CHARACTERISTICS, ST_LOCK, ST_UNLOCK, ST_EVENT_POST,
@@ -1198,9 +1198,12 @@ enum gfc_omp_reduction_op
enum gfc_omp_depend_op
{
+ OMP_DEPEND_UNSET,
OMP_DEPEND_IN,
OMP_DEPEND_OUT,
OMP_DEPEND_INOUT,
+ OMP_DEPEND_MUTEXINOUTSET,
+ OMP_DEPEND_DEPOBJ,
OMP_DEPEND_SINK_FIRST,
OMP_DEPEND_SINK
};
@@ -1402,11 +1405,12 @@ typedef struct gfc_omp_clauses
bool nowait, ordered, untied, mergeable;
bool inbranch, notinbranch, defaultmap, nogroup;
bool sched_simd, sched_monotonic, sched_nonmonotonic;
- bool simd, threads, depend_source, order_concurrent, capture;
+ bool simd, threads, depend_source, destroy, order_concurrent, capture;
enum gfc_omp_atomic_op atomic_op;
enum gfc_omp_memorder memorder;
enum gfc_omp_cancel_kind cancel;
enum gfc_omp_proc_bind_kind proc_bind;
+ enum gfc_omp_depend_op depobj_update;
struct gfc_expr *safelen_expr;
struct gfc_expr *simdlen_expr;
struct gfc_expr *num_teams;
@@ -1417,6 +1421,7 @@ typedef struct gfc_omp_clauses
struct gfc_expr *num_tasks;
struct gfc_expr *priority;
struct gfc_expr *detach;
+ struct gfc_expr *depobj;
struct gfc_expr *if_exprs[OMP_IF_LAST];
enum gfc_omp_sched_kind dist_sched_kind;
struct gfc_expr *dist_chunk_size;
@@ -1437,7 +1442,6 @@ typedef struct gfc_omp_clauses
unsigned par_auto:1, gang_static:1;
unsigned if_present:1, finalize:1;
locus loc;
-
}
gfc_omp_clauses;
@@ -2700,7 +2704,7 @@ enum gfc_exec_op
EXEC_OMP_TARGET_ENTER_DATA, EXEC_OMP_TARGET_EXIT_DATA,
EXEC_OMP_TARGET_PARALLEL, EXEC_OMP_TARGET_PARALLEL_DO,
EXEC_OMP_TARGET_PARALLEL_DO_SIMD, EXEC_OMP_TARGET_SIMD,
- EXEC_OMP_TASKLOOP, EXEC_OMP_TASKLOOP_SIMD, EXEC_OMP_SCAN
+ EXEC_OMP_TASKLOOP, EXEC_OMP_TASKLOOP_SIMD, EXEC_OMP_SCAN, EXEC_OMP_DEPOBJ
};
typedef struct gfc_code
diff --git a/gcc/fortran/match.h b/gcc/fortran/match.h
index 20a530f23c2..b72ec67d665 100644
--- a/gcc/fortran/match.h
+++ b/gcc/fortran/match.h
@@ -160,6 +160,7 @@ match gfc_match_omp_critical (void);
match gfc_match_omp_declare_reduction (void);
match gfc_match_omp_declare_simd (void);
match gfc_match_omp_declare_target (void);
+match gfc_match_omp_depobj (void);
match gfc_match_omp_distribute (void);
match gfc_match_omp_distribute_parallel_do (void);
match gfc_match_omp_distribute_parallel_do_simd (void);
diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
index 1f1920cf0e1..3ebc28b7be1 100644
--- a/gcc/fortran/openmp.c
+++ b/gcc/fortran/openmp.c
@@ -1381,6 +1381,10 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
depend_op = OMP_DEPEND_IN;
else if (gfc_match ("out") == MATCH_YES)
depend_op = OMP_DEPEND_OUT;
+ else if (gfc_match ("mutexinoutset") == MATCH_YES)
+ depend_op = OMP_DEPEND_MUTEXINOUTSET;
+ else if (gfc_match ("depobj") == MATCH_YES)
+ depend_op = OMP_DEPEND_DEPOBJ;
else if (!c->depend_source
&& gfc_match ("source )") == MATCH_YES)
{
@@ -2898,6 +2902,85 @@ gfc_match_omp_end_critical (void)
return MATCH_YES;
}
+/* depobj(depobj) depend(dep-type:loc)|destroy|update(dep-type)
+ dep-type = in/out/inout/mutexinoutset/depobj/source/sink
+ depend: !source, !sink
+ update: !source, !sink, !depobj
+ locator = exactly one list item .*/
+match
+gfc_match_omp_depobj (void)
+{
+ gfc_omp_clauses *c = NULL;
+ gfc_expr *depobj;
+
+ if (gfc_match (" ( %v ) ", &depobj) != MATCH_YES)
+ {
+ gfc_error ("Expected %<( depobj )%> at %C");
+ return MATCH_ERROR;
+ }
+ if (gfc_match ("update ( ") == MATCH_YES)
+ {
+ c = gfc_get_omp_clauses ();
+ if (gfc_match ("inout )") == MATCH_YES)
+ c->depobj_update = OMP_DEPEND_INOUT;
+ else if (gfc_match ("in )") == MATCH_YES)
+ c->depobj_update = OMP_DEPEND_IN;
+ else if (gfc_match ("out )") == MATCH_YES)
+ c->depobj_update = OMP_DEPEND_OUT;
+ else if (gfc_match ("mutexinoutset )") == MATCH_YES)
+ c->depobj_update = OMP_DEPEND_MUTEXINOUTSET;
+ else
+ {
+ gfc_error ("Expected IN, OUT, INOUT, MUTEXINOUTSET followed by "
+ "%<)%> at %C");
+ goto error;
+ }
+ }
+ else if (gfc_match ("destroy") == MATCH_YES)
+ {
+ c = gfc_get_omp_clauses ();
+ c->destroy = true;
+ }
+ else if (gfc_match_omp_clauses (&c, omp_mask (OMP_CLAUSE_DEPEND), true, false)
+ != MATCH_YES)
+ goto error;
+
+ if (c->depobj_update == OMP_DEPEND_UNSET && !c->destroy)
+ {
+ if (!c->depend_source && !c->lists[OMP_LIST_DEPEND])
+ {
+ gfc_error ("Expected DEPEND, UPDATE, or DESTROY clause at %C");
+ goto error;
+ }
+ if (c->depend_source
+ || c->lists[OMP_LIST_DEPEND]->u.depend_op == OMP_DEPEND_SINK_FIRST
+ || c->lists[OMP_LIST_DEPEND]->u.depend_op == OMP_DEPEND_SINK)
+ {
+ gfc_error ("DEPEND clause at %L of OMP DEPOBJ construct shall not "
+ "have dependence-type SOURCE, SINK or DEPOBJ",
+ c->lists[OMP_LIST_DEPEND]
+ ? &c->lists[OMP_LIST_DEPEND]->where : &gfc_current_locus);
+ goto error;
+ }
+ if (c->lists[OMP_LIST_DEPEND]->next)
+ {
+ gfc_error ("DEPEND clause at %L of OMP DEPOBJ construct shall have "
+ "only a single locator",
+ &c->lists[OMP_LIST_DEPEND]->next->where);
+ goto error;
+ }
+ }
+
+ c->depobj = depobj;
+ new_st.op = EXEC_OMP_DEPOBJ;
+ new_st.ext.omp_clauses = c;
+ return MATCH_YES;
+
+error:
+ gfc_free_expr (depobj);
+ gfc_free_omp_clauses (c);
+ return MATCH_ERROR;
+}
match
gfc_match_omp_distribute (void)
@@ -4877,6 +4960,14 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
"clause at %L", &code->loc);
}
+ if (omp_clauses->depobj
+ && (!gfc_resolve_expr (omp_clauses->depobj)
+ || omp_clauses->depobj->ts.type != BT_INTEGER
+ || omp_clauses->depobj->ts.kind != 2*gfc_index_integer_kind
+ || omp_clauses->depobj->rank != 0))
+ 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++)
@@ -5173,6 +5264,24 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
gfc_error ("Only SOURCE or SINK dependence types "
"are allowed on ORDERED directive at %L",
&n->where);
+ else if (n->u.depend_op == OMP_DEPEND_DEPOBJ
+ && !n->expr
+ && (n->sym->ts.type != BT_INTEGER
+ || n->sym->ts.kind != 2*gfc_index_integer_kind
+ || n->sym->attr.dimension))
+ gfc_error ("Locator %qs at %L in DEPEND clause of depobj "
+ "type shall be a scalar integer of "
+ "OMP_DEPEND_KIND kind", n->sym->name,
+ &n->where);
+ else if (n->u.depend_op == OMP_DEPEND_DEPOBJ
+ && n->expr
+ && (!gfc_resolve_expr (n->expr)
+ || n->expr->ts.type != BT_INTEGER
+ || n->expr->ts.kind != 2*gfc_index_integer_kind
+ || n->expr->rank != 0))
+ gfc_error ("Locator at %L in DEPEND clause of depobj "
+ "type shall be a scalar integer of "
+ "OMP_DEPEND_KIND kind", &n->expr->where);
}
gfc_ref *lastref = NULL, *lastslice = NULL;
bool resolved = false;
@@ -7211,6 +7320,7 @@ gfc_resolve_omp_directive (gfc_code *code, gfc_namespace *ns)
case EXEC_OMP_TASK:
case EXEC_OMP_TEAMS:
case EXEC_OMP_WORKSHARE:
+ case EXEC_OMP_DEPOBJ:
if (code->ext.omp_clauses)
resolve_omp_clauses (code, code->ext.omp_clauses, NULL);
break;
diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
index 1549f8e1635..9bbe9e83c8e 100644
--- a/gcc/fortran/parse.c
+++ b/gcc/fortran/parse.c
@@ -895,6 +895,7 @@ decode_omp_directive (void)
case 'd':
matchds ("declare reduction", gfc_match_omp_declare_reduction,
ST_OMP_DECLARE_REDUCTION);
+ matcho ("depobj", gfc_match_omp_depobj, ST_OMP_DEPOBJ);
matchs ("distribute parallel do simd",
gfc_match_omp_distribute_parallel_do_simd,
ST_OMP_DISTRIBUTE_PARALLEL_DO_SIMD);
@@ -1588,7 +1589,7 @@ next_statement (void)
case ST_ASSIGNMENT: case ST_ARITHMETIC_IF: case ST_WHERE: case ST_FORALL: \
case ST_LABEL_ASSIGNMENT: case ST_FLUSH: case ST_OMP_FLUSH: \
case ST_OMP_BARRIER: case ST_OMP_TASKWAIT: case ST_OMP_TASKYIELD: \
- case ST_OMP_CANCEL: case ST_OMP_CANCELLATION_POINT: \
+ case ST_OMP_CANCEL: case ST_OMP_CANCELLATION_POINT: case ST_OMP_DEPOBJ: \
case ST_OMP_TARGET_UPDATE: case ST_OMP_TARGET_ENTER_DATA: \
case ST_OMP_TARGET_EXIT_DATA: case ST_OMP_ORDERED_DEPEND: \
case ST_ERROR_STOP: case ST_OMP_SCAN: case ST_SYNC_ALL: \
@@ -2285,6 +2286,9 @@ gfc_ascii_statement (gfc_statement st)
case ST_OMP_DECLARE_TARGET:
p = "!$OMP DECLARE TARGET";
break;
+ case ST_OMP_DEPOBJ:
+ p = "!$OMP DEPOBJ";
+ break;
case ST_OMP_DISTRIBUTE:
p = "!$OMP DISTRIBUTE";
break;
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 32015c21efc..4341daf26a1 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -12189,6 +12189,7 @@ start:
case EXEC_OMP_CANCELLATION_POINT:
case EXEC_OMP_CRITICAL:
case EXEC_OMP_FLUSH:
+ case EXEC_OMP_DEPOBJ:
case EXEC_OMP_DISTRIBUTE:
case EXEC_OMP_DISTRIBUTE_PARALLEL_DO:
case EXEC_OMP_DISTRIBUTE_PARALLEL_DO_SIMD:
diff --git a/gcc/fortran/st.c b/gcc/fortran/st.c
index 13b3880720a..9e761996eec 100644
--- a/gcc/fortran/st.c
+++ b/gcc/fortran/st.c
@@ -218,6 +218,7 @@ gfc_free_statement (gfc_code *p)
case EXEC_OMP_CANCEL:
case EXEC_OMP_CANCELLATION_POINT:
case EXEC_OMP_CRITICAL:
+ case EXEC_OMP_DEPOBJ:
case EXEC_OMP_DISTRIBUTE:
case EXEC_OMP_DISTRIBUTE_PARALLEL_DO:
case EXEC_OMP_DISTRIBUTE_PARALLEL_DO_SIMD:
diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c
index 349df1cc346..16b6476bde6 100644
--- a/gcc/fortran/trans-openmp.c
+++ b/gcc/fortran/trans-openmp.c
@@ -2545,6 +2545,8 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
tree decl = gfc_trans_omp_variable (n->sym, false);
if (gfc_omp_privatize_by_reference (decl))
decl = build_fold_indirect_ref (decl);
+ if (POINTER_TYPE_P (TREE_TYPE (decl)))
+ decl = build_fold_indirect_ref (decl);
if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (decl)))
{
decl = gfc_conv_descriptor_data_get (decl);
@@ -2587,6 +2589,13 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
case OMP_DEPEND_INOUT:
OMP_CLAUSE_DEPEND_KIND (node) = OMP_CLAUSE_DEPEND_INOUT;
break;
+ case OMP_DEPEND_MUTEXINOUTSET:
+ OMP_CLAUSE_DEPEND_KIND (node)
+ = OMP_CLAUSE_DEPEND_MUTEXINOUTSET;
+ break;
+ case OMP_DEPEND_DEPOBJ:
+ OMP_CLAUSE_DEPEND_KIND (node) = OMP_CLAUSE_DEPEND_DEPOBJ;
+ break;
default:
gcc_unreachable ();
}
@@ -4912,6 +4921,63 @@ gfc_trans_oacc_combined_directive (gfc_code *code)
return gfc_finish_block (&block);
}
+static tree
+gfc_trans_omp_depobj (gfc_code *code)
+{
+ stmtblock_t block;
+ gfc_se se;
+ gfc_init_se (&se, NULL);
+ gfc_init_block (&block);
+ gfc_conv_expr (&se, code->ext.omp_clauses->depobj);
+ gcc_assert (se.pre.head == NULL && se.post.head == NULL);
+ tree depobj = se.expr;
+ location_t loc = EXPR_LOCATION (depobj);
+ if (!POINTER_TYPE_P (TREE_TYPE (depobj)))
+ depobj = gfc_build_addr_expr (NULL, depobj);
+ depobj = fold_convert (build_pointer_type_for_mode (ptr_type_node,
+ TYPE_MODE (ptr_type_node),
+ true), depobj);
+ gfc_omp_namelist *n = code->ext.omp_clauses->lists[OMP_LIST_DEPEND];
+ if (n)
+ {
+ tree var;
+ if (n->expr)
+ var = gfc_convert_expr_to_tree (&block, n->expr);
+ else
+ var = gfc_get_symbol_decl (n->sym);
+ if (!POINTER_TYPE_P (TREE_TYPE (var)))
+ var = gfc_build_addr_expr (NULL, var);
+ depobj = save_expr (depobj);
+ tree r = build_fold_indirect_ref_loc (loc, depobj);
+ gfc_add_expr_to_block (&block,
+ build2 (MODIFY_EXPR, void_type_node, r, var));
+ }
+
+ /* Only one may be set. */
+ gcc_assert (((int)(n != NULL) + (int)(code->ext.omp_clauses->destroy)
+ + (int)(code->ext.omp_clauses->depobj_update != OMP_DEPEND_UNSET))
+ == 1);
+ int k = -1; /* omp_clauses->destroy */
+ if (!code->ext.omp_clauses->destroy)
+ switch (code->ext.omp_clauses->depobj_update != OMP_DEPEND_UNSET
+ ? code->ext.omp_clauses->depobj_update : n->u.depend_op)
+ {
+ case OMP_DEPEND_IN: k = GOMP_DEPEND_IN; break;
+ case OMP_DEPEND_OUT: k = GOMP_DEPEND_IN; break;
+ case OMP_DEPEND_INOUT: k = GOMP_DEPEND_IN; break;
+ case OMP_DEPEND_MUTEXINOUTSET: k = GOMP_DEPEND_MUTEXINOUTSET; break;
+ case OMP_DEPEND_DEPOBJ: k = GOMP_DEPEND_MUTEXINOUTSET; break;
+ default: gcc_unreachable ();
+ }
+ tree t = build_int_cst (ptr_type_node, k);
+ depobj = build2_loc (loc, POINTER_PLUS_EXPR, TREE_TYPE (depobj), depobj,
+ TYPE_SIZE_UNIT (ptr_type_node));
+ depobj = build_fold_indirect_ref_loc (loc, depobj);
+ gfc_add_expr_to_block (&block, build2 (MODIFY_EXPR, void_type_node, depobj, t));
+
+ return gfc_finish_block (&block);
+}
+
static tree
gfc_trans_omp_flush (gfc_code *code)
{
@@ -6181,6 +6247,8 @@ gfc_trans_omp_directive (gfc_code *code)
return gfc_trans_omp_cancellation_point (code);
case EXEC_OMP_CRITICAL:
return gfc_trans_omp_critical (code);
+ case EXEC_OMP_DEPOBJ:
+ return gfc_trans_omp_depobj (code);
case EXEC_OMP_DISTRIBUTE:
case EXEC_OMP_DO:
case EXEC_OMP_SIMD:
diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c
index ab53fc5f441..1e4e074f25a 100644
--- a/gcc/fortran/trans.c
+++ b/gcc/fortran/trans.c
@@ -2151,6 +2151,7 @@ trans_code (gfc_code * code, tree cond)
case EXEC_OMP_CANCEL:
case EXEC_OMP_CANCELLATION_POINT:
case EXEC_OMP_CRITICAL:
+ case EXEC_OMP_DEPOBJ:
case EXEC_OMP_DISTRIBUTE:
case EXEC_OMP_DISTRIBUTE_PARALLEL_DO:
case EXEC_OMP_DISTRIBUTE_PARALLEL_DO_SIMD:
diff --git a/gcc/testsuite/gfortran.dg/gomp/depobj-1.f90 b/gcc/testsuite/gfortran.dg/gomp/depobj-1.f90
new file mode 100644
index 00000000000..f0a9307e567
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/depobj-1.f90
@@ -0,0 +1,26 @@
+! { dg-do compile { target { fortran_integer_16 || ilp32 } } }
+! omp_depend_kind = 2*intptr_t --> 16 (128 bit) on 64bit-pointer systems
+! --> 8 (128 bit) on 32bit-pointer systems
+subroutine f1
+ !use omp_lib ! N/A in gcc/testsuite
+ use iso_c_binding, only: c_intptr_t
+ implicit none
+ integer, parameter :: omp_depend_kind = 2*c_intptr_t
+ integer :: a
+ integer(kind=omp_depend_kind) :: depobj1, depobj2, depobj3, depobj4, depobj5
+ !$omp depobj(depobj1) depend (in : a)
+ !$omp depobj(depobj2) depend (out : a)
+ !$omp depobj(depobj3) depend( inout : a)
+ !$omp depobj(depobj4) depend(mutexinoutset: a)
+ !$omp depobj(depobj5) depend(depobj: depobj3)
+ !$omp depobj(depobj1) update(out)
+ !$omp depobj(depobj2) update(mutexinoutset)
+ !$omp depobj(depobj3) update(in)
+ !$omp depobj(depobj4) update(inout)
+ !$omp task depend (depobj: depobj1, depobj2, depobj3)
+ !$omp end task
+
+ !$omp task depend(mutexinoutset: a)
+ !$omp end task
+ !$omp depobj(depobj2) destroy
+end subroutine f1
diff --git a/gcc/testsuite/gfortran.dg/gomp/depobj-2.f90 b/gcc/testsuite/gfortran.dg/gomp/depobj-2.f90
new file mode 100644
index 00000000000..f1f7c9a0abd
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/depobj-2.f90
@@ -0,0 +1,29 @@
+! { dg-do compile { target { fortran_integer_16 || ilp32 } } }
+! omp_depend_kind = 2*intptr_t --> 16 (128 bit) on 64bit-pointer systems
+! --> 8 (128 bit) on 32bit-pointer systems
+subroutine f1
+ !use omp_lib ! N/A in gcc/testsuite
+ use iso_c_binding, only: c_intptr_t
+ implicit none
+ integer, parameter :: omp_depend_kind = 2*c_intptr_t
+ integer :: a, b
+ integer(kind=omp_depend_kind) :: depobj, depobj1(5)
+ real :: r
+ integer(1) :: d
+
+ !$omp depobj ! { dg-error "Expected '\\( depobj \\)\'" }
+ !$omp depobj(depobj) ! { dg-error "Expected DEPEND, UPDATE, or DESTROY clause" }
+ !$omp depobj destroy ! { dg-error "Expected '\\( depobj \\)\'" }
+ !$omp depobj ( depobj1 ( 1 ) ) depend( inout : a) ! OK
+ !$omp depobj(depobj1) depend( inout : a) ! { dg-error "DEPOBJ in DEPOBJ construct at .1. shall be a scalar integer of OMP_DEPEND_KIND kind" }
+ !$omp depobj(depobj1(:)) depend( inout : a) ! { dg-error "DEPOBJ in DEPOBJ construct at .1. shall be a scalar integer of OMP_DEPEND_KIND kind" }
+ !$omp depobj(r) depend( inout : a) ! { dg-error "DEPOBJ in DEPOBJ construct at .1. shall be a scalar integer of OMP_DEPEND_KIND kind" }
+ !$omp depobj(d) depend( inout : a) ! { dg-error "DEPOBJ in DEPOBJ construct at .1. shall be a scalar integer of OMP_DEPEND_KIND kind" }
+ !$omp depobj(depobj) depend( inout : a, b) ! { dg-error "DEPEND clause at .1. of OMP DEPOBJ construct shall have only a single locator" }
+ !$omp depobj(depobj) depend(mutexinoutset : a) ! OK
+ !$omp depobj(depobj) depend(source) ! { dg-error "DEPEND clause at .1. of OMP DEPOBJ construct shall not have dependence-type SOURCE, SINK or DEPOBJ" }
+ !$omp depobj(depobj) depend(sink : i + 1) ! { dg-error "DEPEND clause at .1. of OMP DEPOBJ construct shall not have dependence-type SOURCE, SINK or DEPOBJ" }
+ !$omp depobj(depobj) update(source) ! { dg-error "Expected IN, OUT, INOUT, MUTEXINOUTSET followed by '\\)'" }
+ !$omp depobj(depobj) update(sink) ! { dg-error "Expected IN, OUT, INOUT, MUTEXINOUTSET followed by '\\)'" }
+ !$omp depobj(depobj) update(depobj) ! { dg-error "Expected IN, OUT, INOUT, MUTEXINOUTSET followed by '\\)'" }
+end subroutine f1
diff --git a/libgomp/testsuite/libgomp.fortran/depobj-1.f90 b/libgomp/testsuite/libgomp.fortran/depobj-1.f90
new file mode 100644
index 00000000000..eb314f67bae
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/depobj-1.f90
@@ -0,0 +1,113 @@
+module m
+! use omp_lib
+ implicit none (type, external)
+integer, parameter :: omp_depend_kind = 16
+ integer :: xx
+ integer(omp_depend_kind) :: dd1, dd2
+contains
+ subroutine dep
+ integer :: x
+ integer(omp_depend_kind) :: d1, d2
+ x = 1
+
+ !$omp depobj (d1) depend(in: x)
+ !$omp depobj (d2) depend(in: x)
+ !$omp depobj (d2) update(out)
+ !$omp parallel
+ !$omp single
+ !$omp task shared (x) depend(depobj: d2)
+ x = 2
+ !$omp end task
+ !$omp task shared (x) depend(depobj: d1)
+ if (x /= 2) &
+ stop 1
+ !$omp end task
+ !$omp end single
+ !$omp end parallel
+ !$omp depobj (d2) destroy
+ !$omp depobj (d1) destroy
+ end
+
+ subroutine dep2
+ integer, pointer :: x
+ integer(omp_depend_kind) :: d1, d2
+ pointer :: d1
+ allocate(d1, x)
+ call dep2i(d1, d2, x)
+ deallocate(d1)
+ contains
+ subroutine dep2i(d1, d2, x)
+ integer(omp_depend_kind) :: d1
+ integer(omp_depend_kind), optional :: d2
+ integer, pointer, optional :: x
+ pointer :: d1
+ !$omp parallel
+ !$omp single
+ x = 1
+ !$omp depobj (d1) depend(out: x)
+ !$omp depobj (d2) depend (in:x)
+ !$omp depobj(d2)update(in)
+ !$omp task shared (x) depend(depobj:d1)
+ x = 2
+ !$omp end task
+ !$omp task shared (x) depend(depobj : d2)
+ if (x /= 2) &
+ stop 2
+ !$omp end task
+ !$omp taskwait
+ !$omp depobj(d1)destroy
+ !$omp depobj(d2) destroy
+ !$omp end single
+ !$omp end parallel
+ end
+ end
+
+ subroutine dep3
+ integer :: x
+ integer(omp_depend_kind) :: d(2)
+ !$omp parallel
+ x = 1
+ !$omp single
+ !$omp depobj(d(1)) depend(out:x)
+ !$omp depobj(d(2)) depend(in: x)
+ !$omp task shared (x) depend(depobj: d(1))
+ x = 2
+ !$omp end task
+ !$omp task shared (x) depend(depobj: d(2))
+ if (x /= 2) &
+ stop 3
+ !$omp end task
+ !$omp end single
+ !$omp end parallel
+ !$omp depobj(d(1)) destroy
+ !$omp depobj(d(2)) destroy
+ end
+
+ subroutine antidep
+ xx = 1
+ !$omp parallel
+ !$omp single
+ !$omp task shared(xx) depend(depobj:dd2)
+ if (xx /= 1) &
+ stop 4
+ !$omp end task
+ !$omp task shared(xx) depend(depobj:dd1)
+ xx = 2
+ !$omp end task
+ !$omp end single
+ !$omp end parallel
+ end
+end module m
+
+program main
+ use m
+ implicit none (type, external)
+ call dep ()
+ call dep2 ()
+ call dep3 ()
+ !$omp depobj (dd1) depend (inout: xx)
+ !$omp depobj (dd2) depend (in : xx)
+ call antidep ()
+ !$omp depobj (dd2) destroy
+ !$omp depobj (dd1) destroy
+end program main
^ permalink raw reply [flat|nested] 3+ messages in thread
* Re: [Patch][GCC12] Fortran/OpenMP: Add 'omp depobj' and 'depend(mutexinoutset:'
2021-03-17 18:19 [Patch][GCC12] Fortran/OpenMP: Add 'omp depobj' and 'depend(mutexinoutset:' Tobias Burnus
@ 2021-03-17 18:29 ` Jakub Jelinek
2021-04-20 21:15 ` Tobias Burnus
0 siblings, 1 reply; 3+ messages in thread
From: Jakub Jelinek @ 2021-03-17 18:29 UTC (permalink / raw)
To: Tobias Burnus; +Cc: gcc-patches, fortran
On Wed, Mar 17, 2021 at 07:19:29PM +0100, Tobias Burnus wrote:
> @@ -1831,6 +1852,7 @@ show_omp_node (int level, gfc_code *c)
> case EXEC_OMP_FLUSH: name = "FLUSH"; break;
> case EXEC_OMP_MASTER: name = "MASTER"; break;
> case EXEC_OMP_ORDERED: name = "ORDERED"; break;
> + case EXEC_OMP_DEPOBJ: name = "DEPBOBJ"; break;
s/DEPBOBJ/DEPOBJ/
> + || omp_clauses->depobj->ts.kind != 2*gfc_index_integer_kind
Formatting (several times), I think we should use 2 * gfc_index_integer_kind
> --- a/gcc/fortran/trans-openmp.c
> +++ b/gcc/fortran/trans-openmp.c
> @@ -2545,6 +2545,8 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
> tree decl = gfc_trans_omp_variable (n->sym, false);
> if (gfc_omp_privatize_by_reference (decl))
> decl = build_fold_indirect_ref (decl);
> + if (POINTER_TYPE_P (TREE_TYPE (decl)))
> + decl = build_fold_indirect_ref (decl);
I'm a little bit worried about this, are you sure it won't affect anything
but depobj?
> + int k = -1; /* omp_clauses->destroy */
> + if (!code->ext.omp_clauses->destroy)
> + switch (code->ext.omp_clauses->depobj_update != OMP_DEPEND_UNSET
> + ? code->ext.omp_clauses->depobj_update : n->u.depend_op)
> + {
> + case OMP_DEPEND_IN: k = GOMP_DEPEND_IN; break;
> + case OMP_DEPEND_OUT: k = GOMP_DEPEND_IN; break;
> + case OMP_DEPEND_INOUT: k = GOMP_DEPEND_IN; break;
> + case OMP_DEPEND_MUTEXINOUTSET: k = GOMP_DEPEND_MUTEXINOUTSET; break;
> + case OMP_DEPEND_DEPOBJ: k = GOMP_DEPEND_MUTEXINOUTSET; break;
Can depobj_update be OMP_DEPEND_DEPOBJ ?
Otherwise LGTM.
Jakub
^ permalink raw reply [flat|nested] 3+ messages in thread
* Re: [Patch][GCC12] Fortran/OpenMP: Add 'omp depobj' and 'depend(mutexinoutset:'
2021-03-17 18:29 ` Jakub Jelinek
@ 2021-04-20 21:15 ` Tobias Burnus
0 siblings, 0 replies; 3+ messages in thread
From: Tobias Burnus @ 2021-04-20 21:15 UTC (permalink / raw)
To: Jakub Jelinek; +Cc: gcc-patches, fortran
[-- Attachment #1: Type: text/plain, Size: 1458 bytes --]
I have now updated the patch – and intent to commit it tomorrow, unless
there are further comments.
On 17.03.21 19:29, Jakub Jelinek wrote:
> On Wed, Mar 17, 2021 at 07:19:29PM +0100, Tobias Burnus wrote:
>> @@ -1831,6 +1852,7 @@ show_omp_node (int level, gfc_code *c)
>> + case EXEC_OMP_DEPOBJ: name = "DEPBOBJ"; break;
> s/DEPBOBJ/DEPOBJ/
>> + || omp_clauses->depobj->ts.kind != 2*gfc_index_integer_kind
> Formatting (several times), I think we should use 2 * gfc_index_integer_kind
Fixed.
>> @@ -2545,6 +2545,8 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
>> + if (POINTER_TYPE_P (TREE_TYPE (decl)))
>> + decl = build_fold_indirect_ref (decl);
> I'm a little bit worried about this, are you sure it won't affect anything
> but depobj?
I have added an 'n->u.depend_op == OMP_DEPEND_DEPOBJ' to be sure.
>> + case OMP_DEPEND_MUTEXINOUTSET: k = GOMP_DEPEND_MUTEXINOUTSET; break;
>> + case OMP_DEPEND_DEPOBJ: k = GOMP_DEPEND_MUTEXINOUTSET; break;
> Can depobj_update be OMP_DEPEND_DEPOBJ ?
'update' can't but 'depend' can – but only in OpenMP 5.1; moved
testcase, fixed check & remove 'case ...DEPOBJ:' line for now.
> Otherwise LGTM.
Attached is the full patch.
Tobias
-----------------
Mentor Graphics (Deutschland) GmbH, Arnulfstrasse 201, 80634 München Registergericht München HRB 106955, Geschäftsführer: Thomas Heurung, Frank Thürauf
[-- Attachment #2: omp-depobj-v2.diff --]
[-- Type: text/x-patch, Size: 27235 bytes --]
Fortran/OpenMP: Add 'omp depobj' and 'depend(mutexinoutset:'
gcc/fortran/ChangeLog:
* dump-parse-tree.c (show_omp_namelist): Handle depobj + mutexinoutset
in the depend clause.
(show_omp_clauses, show_omp_node, show_code_node): Handle depobj.
* gfortran.h (enum gfc_statement): Add ST_OMP_DEPOBJ.
(enum gfc_omp_depend_op): Add OMP_DEPEND_UNSET,
OMP_DEPEND_MUTEXINOUTSET and OMP_DEPEND_DEPOBJ.
(gfc_omp_clauses): Add destroy, depobj_update and depobj.
(enum gfc_exec_op): Add EXEC_OMP_DEPOBJ
* match.h (gfc_match_omp_depobj): Match 'omp depobj'.
* openmp.c (gfc_match_omp_clauses): Add depobj + mutexinoutset
to depend clause.
(gfc_match_omp_depobj, resolve_omp_clauses, gfc_resolve_omp_directive):
Handle 'omp depobj'.
* parse.c (decode_omp_directive, next_statement, gfc_ascii_statement):
Likewise.
* resolve.c (gfc_resolve_code): Likewise.
* st.c (gfc_free_statement): Likewise.
* trans-openmp.c (gfc_trans_omp_clauses): Handle depobj + mutexinoutset
in the depend clause.
(gfc_trans_omp_depobj, gfc_trans_omp_directive): Handle EXEC_OMP_DEPOBJ.
* trans.c (trans_code): Likewise.
libgomp/ChangeLog:
* testsuite/libgomp.fortran/depobj-1.f90: New test.
gcc/testsuite/ChangeLog:
* gfortran.dg/gomp/depobj-1.f90: New test.
* gfortran.dg/gomp/depobj-2.f90: New test.
gcc/fortran/dump-parse-tree.c | 33 ++++++++
gcc/fortran/gfortran.h | 12 ++-
gcc/fortran/match.h | 1 +
gcc/fortran/openmp.c | 113 +++++++++++++++++++++++++
gcc/fortran/parse.c | 6 +-
gcc/fortran/resolve.c | 1 +
gcc/fortran/st.c | 1 +
gcc/fortran/trans-openmp.c | 68 +++++++++++++++
gcc/fortran/trans.c | 1 +
gcc/testsuite/gfortran.dg/gomp/depobj-1.f90 | 25 ++++++
gcc/testsuite/gfortran.dg/gomp/depobj-2.f90 | 33 ++++++++
libgomp/testsuite/libgomp.fortran/depobj-1.f90 | 113 +++++++++++++++++++++++++
12 files changed, 402 insertions(+), 5 deletions(-)
diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c
index 059d8421bb5..b50265ac742 100644
--- a/gcc/fortran/dump-parse-tree.c
+++ b/gcc/fortran/dump-parse-tree.c
@@ -1332,6 +1332,10 @@ show_omp_namelist (int list_type, gfc_omp_namelist *n)
case OMP_DEPEND_IN: fputs ("in:", dumpfile); break;
case OMP_DEPEND_OUT: fputs ("out:", dumpfile); break;
case OMP_DEPEND_INOUT: fputs ("inout:", dumpfile); break;
+ case OMP_DEPEND_DEPOBJ: fputs ("depobj:", dumpfile); break;
+ case OMP_DEPEND_MUTEXINOUTSET:
+ fputs ("mutexinoutset:", dumpfile);
+ break;
case OMP_DEPEND_SINK_FIRST:
fputs ("sink:", dumpfile);
while (1)
@@ -1754,10 +1758,27 @@ show_omp_clauses (gfc_omp_clauses *omp_clauses)
show_expr (omp_clauses->if_exprs[i]);
fputc (')', dumpfile);
}
+ if (omp_clauses->destroy)
+ fputs (" DESTROY", dumpfile);
if (omp_clauses->depend_source)
fputs (" DEPEND(source)", dumpfile);
if (omp_clauses->capture)
fputs (" CAPTURE", dumpfile);
+ if (omp_clauses->depobj_update != OMP_DEPEND_UNSET)
+ {
+ const char *deptype;
+ fputs (" UPDATE(", dumpfile);
+ switch (omp_clauses->depobj_update)
+ {
+ case OMP_DEPEND_IN: deptype = "IN"; break;
+ case OMP_DEPEND_OUT: deptype = "OUT"; break;
+ case OMP_DEPEND_INOUT: deptype = "INOUT"; break;
+ case OMP_DEPEND_MUTEXINOUTSET: deptype = "MUTEXINOUTSET"; break;
+ default: gcc_unreachable ();
+ }
+ fputs (deptype, dumpfile);
+ fputc (')', dumpfile);
+ }
if (omp_clauses->atomic_op != GFC_OMP_ATOMIC_UNSET)
{
const char *atomic_op;
@@ -1831,6 +1852,7 @@ show_omp_node (int level, gfc_code *c)
case EXEC_OMP_FLUSH: name = "FLUSH"; break;
case EXEC_OMP_MASTER: name = "MASTER"; break;
case EXEC_OMP_ORDERED: name = "ORDERED"; break;
+ case EXEC_OMP_DEPOBJ: name = "DEPOBJ"; break;
case EXEC_OMP_PARALLEL: name = "PARALLEL"; break;
case EXEC_OMP_PARALLEL_DO: name = "PARALLEL DO"; break;
case EXEC_OMP_PARALLEL_DO_SIMD: name = "PARALLEL DO SIMD"; break;
@@ -1941,6 +1963,15 @@ show_omp_node (int level, gfc_code *c)
if (omp_clauses)
fprintf (dumpfile, " (%s)", c->ext.omp_clauses->critical_name);
break;
+ case EXEC_OMP_DEPOBJ:
+ omp_clauses = c->ext.omp_clauses;
+ if (omp_clauses)
+ {
+ fputc ('(', dumpfile);
+ show_expr (c->ext.omp_clauses->depobj);
+ fputc (')', dumpfile);
+ }
+ break;
case EXEC_OMP_FLUSH:
if (c->ext.omp_namelist)
{
@@ -1969,6 +2000,7 @@ show_omp_node (int level, gfc_code *c)
|| c->op == EXEC_OACC_ENTER_DATA || c->op == EXEC_OACC_EXIT_DATA
|| c->op == EXEC_OMP_TARGET_UPDATE || c->op == EXEC_OMP_TARGET_ENTER_DATA
|| c->op == EXEC_OMP_TARGET_EXIT_DATA || c->op == EXEC_OMP_SCAN
+ || c->op == EXEC_OMP_DEPOBJ
|| (c->op == EXEC_OMP_ORDERED && c->block == NULL))
return;
if (c->op == EXEC_OMP_SECTIONS || c->op == EXEC_OMP_PARALLEL_SECTIONS)
@@ -3094,6 +3126,7 @@ show_code_node (int level, gfc_code *c)
case EXEC_OMP_CANCELLATION_POINT:
case EXEC_OMP_BARRIER:
case EXEC_OMP_CRITICAL:
+ case EXEC_OMP_DEPOBJ:
case EXEC_OMP_DISTRIBUTE:
case EXEC_OMP_DISTRIBUTE_PARALLEL_DO:
case EXEC_OMP_DISTRIBUTE_PARALLEL_DO_SIMD:
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 7935aca23db..d12be0cdbab 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -261,7 +261,7 @@ enum gfc_statement
ST_OMP_TARGET_PARALLEL_DO_SIMD, ST_OMP_END_TARGET_PARALLEL_DO_SIMD,
ST_OMP_TARGET_ENTER_DATA, ST_OMP_TARGET_EXIT_DATA,
ST_OMP_TARGET_SIMD, ST_OMP_END_TARGET_SIMD,
- ST_OMP_TASKLOOP, ST_OMP_END_TASKLOOP, ST_OMP_SCAN,
+ 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_GET_FCN_CHARACTERISTICS, ST_LOCK, ST_UNLOCK, ST_EVENT_POST,
@@ -1198,9 +1198,12 @@ enum gfc_omp_reduction_op
enum gfc_omp_depend_op
{
+ OMP_DEPEND_UNSET,
OMP_DEPEND_IN,
OMP_DEPEND_OUT,
OMP_DEPEND_INOUT,
+ OMP_DEPEND_MUTEXINOUTSET,
+ OMP_DEPEND_DEPOBJ,
OMP_DEPEND_SINK_FIRST,
OMP_DEPEND_SINK
};
@@ -1402,11 +1405,12 @@ typedef struct gfc_omp_clauses
bool nowait, ordered, untied, mergeable;
bool inbranch, notinbranch, defaultmap, nogroup;
bool sched_simd, sched_monotonic, sched_nonmonotonic;
- bool simd, threads, depend_source, order_concurrent, capture;
+ bool simd, threads, depend_source, destroy, order_concurrent, capture;
enum gfc_omp_atomic_op atomic_op;
enum gfc_omp_memorder memorder;
enum gfc_omp_cancel_kind cancel;
enum gfc_omp_proc_bind_kind proc_bind;
+ enum gfc_omp_depend_op depobj_update;
struct gfc_expr *safelen_expr;
struct gfc_expr *simdlen_expr;
struct gfc_expr *num_teams;
@@ -1417,6 +1421,7 @@ typedef struct gfc_omp_clauses
struct gfc_expr *num_tasks;
struct gfc_expr *priority;
struct gfc_expr *detach;
+ struct gfc_expr *depobj;
struct gfc_expr *if_exprs[OMP_IF_LAST];
enum gfc_omp_sched_kind dist_sched_kind;
struct gfc_expr *dist_chunk_size;
@@ -1437,7 +1442,6 @@ typedef struct gfc_omp_clauses
unsigned par_auto:1, gang_static:1;
unsigned if_present:1, finalize:1;
locus loc;
-
}
gfc_omp_clauses;
@@ -2700,7 +2704,7 @@ enum gfc_exec_op
EXEC_OMP_TARGET_ENTER_DATA, EXEC_OMP_TARGET_EXIT_DATA,
EXEC_OMP_TARGET_PARALLEL, EXEC_OMP_TARGET_PARALLEL_DO,
EXEC_OMP_TARGET_PARALLEL_DO_SIMD, EXEC_OMP_TARGET_SIMD,
- EXEC_OMP_TASKLOOP, EXEC_OMP_TASKLOOP_SIMD, EXEC_OMP_SCAN
+ EXEC_OMP_TASKLOOP, EXEC_OMP_TASKLOOP_SIMD, EXEC_OMP_SCAN, EXEC_OMP_DEPOBJ
};
typedef struct gfc_code
diff --git a/gcc/fortran/match.h b/gcc/fortran/match.h
index 20a530f23c2..b72ec67d665 100644
--- a/gcc/fortran/match.h
+++ b/gcc/fortran/match.h
@@ -160,6 +160,7 @@ match gfc_match_omp_critical (void);
match gfc_match_omp_declare_reduction (void);
match gfc_match_omp_declare_simd (void);
match gfc_match_omp_declare_target (void);
+match gfc_match_omp_depobj (void);
match gfc_match_omp_distribute (void);
match gfc_match_omp_distribute_parallel_do (void);
match gfc_match_omp_distribute_parallel_do_simd (void);
diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
index 1f1920cf0e1..a1b057227b7 100644
--- a/gcc/fortran/openmp.c
+++ b/gcc/fortran/openmp.c
@@ -1381,6 +1381,10 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
depend_op = OMP_DEPEND_IN;
else if (gfc_match ("out") == MATCH_YES)
depend_op = OMP_DEPEND_OUT;
+ else if (gfc_match ("mutexinoutset") == MATCH_YES)
+ depend_op = OMP_DEPEND_MUTEXINOUTSET;
+ else if (gfc_match ("depobj") == MATCH_YES)
+ depend_op = OMP_DEPEND_DEPOBJ;
else if (!c->depend_source
&& gfc_match ("source )") == MATCH_YES)
{
@@ -2898,6 +2902,86 @@ gfc_match_omp_end_critical (void)
return MATCH_YES;
}
+/* depobj(depobj) depend(dep-type:loc)|destroy|update(dep-type)
+ dep-type = in/out/inout/mutexinoutset/depobj/source/sink
+ depend: !source, !sink
+ update: !source, !sink, !depobj
+ locator = exactly one list item .*/
+match
+gfc_match_omp_depobj (void)
+{
+ gfc_omp_clauses *c = NULL;
+ gfc_expr *depobj;
+
+ if (gfc_match (" ( %v ) ", &depobj) != MATCH_YES)
+ {
+ gfc_error ("Expected %<( depobj )%> at %C");
+ return MATCH_ERROR;
+ }
+ if (gfc_match ("update ( ") == MATCH_YES)
+ {
+ c = gfc_get_omp_clauses ();
+ if (gfc_match ("inout )") == MATCH_YES)
+ c->depobj_update = OMP_DEPEND_INOUT;
+ else if (gfc_match ("in )") == MATCH_YES)
+ c->depobj_update = OMP_DEPEND_IN;
+ else if (gfc_match ("out )") == MATCH_YES)
+ c->depobj_update = OMP_DEPEND_OUT;
+ else if (gfc_match ("mutexinoutset )") == MATCH_YES)
+ c->depobj_update = OMP_DEPEND_MUTEXINOUTSET;
+ else
+ {
+ gfc_error ("Expected IN, OUT, INOUT, MUTEXINOUTSET followed by "
+ "%<)%> at %C");
+ goto error;
+ }
+ }
+ else if (gfc_match ("destroy") == MATCH_YES)
+ {
+ c = gfc_get_omp_clauses ();
+ c->destroy = true;
+ }
+ else if (gfc_match_omp_clauses (&c, omp_mask (OMP_CLAUSE_DEPEND), true, false)
+ != MATCH_YES)
+ goto error;
+
+ if (c->depobj_update == OMP_DEPEND_UNSET && !c->destroy)
+ {
+ if (!c->depend_source && !c->lists[OMP_LIST_DEPEND])
+ {
+ gfc_error ("Expected DEPEND, UPDATE, or DESTROY clause at %C");
+ goto error;
+ }
+ if (c->depend_source
+ || c->lists[OMP_LIST_DEPEND]->u.depend_op == OMP_DEPEND_SINK_FIRST
+ || c->lists[OMP_LIST_DEPEND]->u.depend_op == OMP_DEPEND_SINK
+ || c->lists[OMP_LIST_DEPEND]->u.depend_op == OMP_DEPEND_DEPOBJ)
+ {
+ gfc_error ("DEPEND clause at %L of OMP DEPOBJ construct shall not "
+ "have dependence-type SOURCE, SINK or DEPOBJ",
+ c->lists[OMP_LIST_DEPEND]
+ ? &c->lists[OMP_LIST_DEPEND]->where : &gfc_current_locus);
+ goto error;
+ }
+ if (c->lists[OMP_LIST_DEPEND]->next)
+ {
+ gfc_error ("DEPEND clause at %L of OMP DEPOBJ construct shall have "
+ "only a single locator",
+ &c->lists[OMP_LIST_DEPEND]->next->where);
+ goto error;
+ }
+ }
+
+ c->depobj = depobj;
+ new_st.op = EXEC_OMP_DEPOBJ;
+ new_st.ext.omp_clauses = c;
+ return MATCH_YES;
+
+error:
+ gfc_free_expr (depobj);
+ gfc_free_omp_clauses (c);
+ return MATCH_ERROR;
+}
match
gfc_match_omp_distribute (void)
@@ -4877,6 +4961,14 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
"clause at %L", &code->loc);
}
+ if (omp_clauses->depobj
+ && (!gfc_resolve_expr (omp_clauses->depobj)
+ || omp_clauses->depobj->ts.type != BT_INTEGER
+ || omp_clauses->depobj->ts.kind != 2 * gfc_index_integer_kind
+ || omp_clauses->depobj->rank != 0))
+ 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++)
@@ -5173,6 +5265,26 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
gfc_error ("Only SOURCE or SINK dependence types "
"are allowed on ORDERED directive at %L",
&n->where);
+ else if (n->u.depend_op == OMP_DEPEND_DEPOBJ
+ && !n->expr
+ && (n->sym->ts.type != BT_INTEGER
+ || n->sym->ts.kind
+ != 2 * gfc_index_integer_kind
+ || n->sym->attr.dimension))
+ gfc_error ("Locator %qs at %L in DEPEND clause of depobj "
+ "type shall be a scalar integer of "
+ "OMP_DEPEND_KIND kind", n->sym->name,
+ &n->where);
+ else if (n->u.depend_op == OMP_DEPEND_DEPOBJ
+ && n->expr
+ && (!gfc_resolve_expr (n->expr)
+ || n->expr->ts.type != BT_INTEGER
+ || n->expr->ts.kind
+ != 2 * gfc_index_integer_kind
+ || n->expr->rank != 0))
+ gfc_error ("Locator at %L in DEPEND clause of depobj "
+ "type shall be a scalar integer of "
+ "OMP_DEPEND_KIND kind", &n->expr->where);
}
gfc_ref *lastref = NULL, *lastslice = NULL;
bool resolved = false;
@@ -7211,6 +7323,7 @@ gfc_resolve_omp_directive (gfc_code *code, gfc_namespace *ns)
case EXEC_OMP_TASK:
case EXEC_OMP_TEAMS:
case EXEC_OMP_WORKSHARE:
+ case EXEC_OMP_DEPOBJ:
if (code->ext.omp_clauses)
resolve_omp_clauses (code, code->ext.omp_clauses, NULL);
break;
diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
index 1549f8e1635..9bbe9e83c8e 100644
--- a/gcc/fortran/parse.c
+++ b/gcc/fortran/parse.c
@@ -895,6 +895,7 @@ decode_omp_directive (void)
case 'd':
matchds ("declare reduction", gfc_match_omp_declare_reduction,
ST_OMP_DECLARE_REDUCTION);
+ matcho ("depobj", gfc_match_omp_depobj, ST_OMP_DEPOBJ);
matchs ("distribute parallel do simd",
gfc_match_omp_distribute_parallel_do_simd,
ST_OMP_DISTRIBUTE_PARALLEL_DO_SIMD);
@@ -1588,7 +1589,7 @@ next_statement (void)
case ST_ASSIGNMENT: case ST_ARITHMETIC_IF: case ST_WHERE: case ST_FORALL: \
case ST_LABEL_ASSIGNMENT: case ST_FLUSH: case ST_OMP_FLUSH: \
case ST_OMP_BARRIER: case ST_OMP_TASKWAIT: case ST_OMP_TASKYIELD: \
- case ST_OMP_CANCEL: case ST_OMP_CANCELLATION_POINT: \
+ case ST_OMP_CANCEL: case ST_OMP_CANCELLATION_POINT: case ST_OMP_DEPOBJ: \
case ST_OMP_TARGET_UPDATE: case ST_OMP_TARGET_ENTER_DATA: \
case ST_OMP_TARGET_EXIT_DATA: case ST_OMP_ORDERED_DEPEND: \
case ST_ERROR_STOP: case ST_OMP_SCAN: case ST_SYNC_ALL: \
@@ -2285,6 +2286,9 @@ gfc_ascii_statement (gfc_statement st)
case ST_OMP_DECLARE_TARGET:
p = "!$OMP DECLARE TARGET";
break;
+ case ST_OMP_DEPOBJ:
+ p = "!$OMP DEPOBJ";
+ break;
case ST_OMP_DISTRIBUTE:
p = "!$OMP DISTRIBUTE";
break;
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index dd4b26680e0..5a81387e277 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -12198,6 +12198,7 @@ start:
case EXEC_OMP_CANCELLATION_POINT:
case EXEC_OMP_CRITICAL:
case EXEC_OMP_FLUSH:
+ case EXEC_OMP_DEPOBJ:
case EXEC_OMP_DISTRIBUTE:
case EXEC_OMP_DISTRIBUTE_PARALLEL_DO:
case EXEC_OMP_DISTRIBUTE_PARALLEL_DO_SIMD:
diff --git a/gcc/fortran/st.c b/gcc/fortran/st.c
index 13b3880720a..9e761996eec 100644
--- a/gcc/fortran/st.c
+++ b/gcc/fortran/st.c
@@ -218,6 +218,7 @@ gfc_free_statement (gfc_code *p)
case EXEC_OMP_CANCEL:
case EXEC_OMP_CANCELLATION_POINT:
case EXEC_OMP_CRITICAL:
+ case EXEC_OMP_DEPOBJ:
case EXEC_OMP_DISTRIBUTE:
case EXEC_OMP_DISTRIBUTE_PARALLEL_DO:
case EXEC_OMP_DISTRIBUTE_PARALLEL_DO_SIMD:
diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c
index 349df1cc346..bf3f2617776 100644
--- a/gcc/fortran/trans-openmp.c
+++ b/gcc/fortran/trans-openmp.c
@@ -2545,6 +2545,9 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
tree decl = gfc_trans_omp_variable (n->sym, false);
if (gfc_omp_privatize_by_reference (decl))
decl = build_fold_indirect_ref (decl);
+ if (n->u.depend_op == OMP_DEPEND_DEPOBJ
+ && POINTER_TYPE_P (TREE_TYPE (decl)))
+ decl = build_fold_indirect_ref (decl);
if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (decl)))
{
decl = gfc_conv_descriptor_data_get (decl);
@@ -2587,6 +2590,13 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
case OMP_DEPEND_INOUT:
OMP_CLAUSE_DEPEND_KIND (node) = OMP_CLAUSE_DEPEND_INOUT;
break;
+ case OMP_DEPEND_MUTEXINOUTSET:
+ OMP_CLAUSE_DEPEND_KIND (node)
+ = OMP_CLAUSE_DEPEND_MUTEXINOUTSET;
+ break;
+ case OMP_DEPEND_DEPOBJ:
+ OMP_CLAUSE_DEPEND_KIND (node) = OMP_CLAUSE_DEPEND_DEPOBJ;
+ break;
default:
gcc_unreachable ();
}
@@ -4912,6 +4922,62 @@ gfc_trans_oacc_combined_directive (gfc_code *code)
return gfc_finish_block (&block);
}
+static tree
+gfc_trans_omp_depobj (gfc_code *code)
+{
+ stmtblock_t block;
+ gfc_se se;
+ gfc_init_se (&se, NULL);
+ gfc_init_block (&block);
+ gfc_conv_expr (&se, code->ext.omp_clauses->depobj);
+ gcc_assert (se.pre.head == NULL && se.post.head == NULL);
+ tree depobj = se.expr;
+ location_t loc = EXPR_LOCATION (depobj);
+ if (!POINTER_TYPE_P (TREE_TYPE (depobj)))
+ depobj = gfc_build_addr_expr (NULL, depobj);
+ depobj = fold_convert (build_pointer_type_for_mode (ptr_type_node,
+ TYPE_MODE (ptr_type_node),
+ true), depobj);
+ gfc_omp_namelist *n = code->ext.omp_clauses->lists[OMP_LIST_DEPEND];
+ if (n)
+ {
+ tree var;
+ if (n->expr)
+ var = gfc_convert_expr_to_tree (&block, n->expr);
+ else
+ var = gfc_get_symbol_decl (n->sym);
+ if (!POINTER_TYPE_P (TREE_TYPE (var)))
+ var = gfc_build_addr_expr (NULL, var);
+ depobj = save_expr (depobj);
+ tree r = build_fold_indirect_ref_loc (loc, depobj);
+ gfc_add_expr_to_block (&block,
+ build2 (MODIFY_EXPR, void_type_node, r, var));
+ }
+
+ /* Only one may be set. */
+ gcc_assert (((int)(n != NULL) + (int)(code->ext.omp_clauses->destroy)
+ + (int)(code->ext.omp_clauses->depobj_update != OMP_DEPEND_UNSET))
+ == 1);
+ int k = -1; /* omp_clauses->destroy */
+ if (!code->ext.omp_clauses->destroy)
+ switch (code->ext.omp_clauses->depobj_update != OMP_DEPEND_UNSET
+ ? code->ext.omp_clauses->depobj_update : n->u.depend_op)
+ {
+ case OMP_DEPEND_IN: k = GOMP_DEPEND_IN; break;
+ case OMP_DEPEND_OUT: k = GOMP_DEPEND_IN; break;
+ case OMP_DEPEND_INOUT: k = GOMP_DEPEND_IN; break;
+ case OMP_DEPEND_MUTEXINOUTSET: k = GOMP_DEPEND_MUTEXINOUTSET; break;
+ default: gcc_unreachable ();
+ }
+ tree t = build_int_cst (ptr_type_node, k);
+ depobj = build2_loc (loc, POINTER_PLUS_EXPR, TREE_TYPE (depobj), depobj,
+ TYPE_SIZE_UNIT (ptr_type_node));
+ depobj = build_fold_indirect_ref_loc (loc, depobj);
+ gfc_add_expr_to_block (&block, build2 (MODIFY_EXPR, void_type_node, depobj, t));
+
+ return gfc_finish_block (&block);
+}
+
static tree
gfc_trans_omp_flush (gfc_code *code)
{
@@ -6181,6 +6247,8 @@ gfc_trans_omp_directive (gfc_code *code)
return gfc_trans_omp_cancellation_point (code);
case EXEC_OMP_CRITICAL:
return gfc_trans_omp_critical (code);
+ case EXEC_OMP_DEPOBJ:
+ return gfc_trans_omp_depobj (code);
case EXEC_OMP_DISTRIBUTE:
case EXEC_OMP_DO:
case EXEC_OMP_SIMD:
diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c
index 9e8e8619ff8..624c7132539 100644
--- a/gcc/fortran/trans.c
+++ b/gcc/fortran/trans.c
@@ -2161,6 +2161,7 @@ trans_code (gfc_code * code, tree cond)
case EXEC_OMP_CANCEL:
case EXEC_OMP_CANCELLATION_POINT:
case EXEC_OMP_CRITICAL:
+ case EXEC_OMP_DEPOBJ:
case EXEC_OMP_DISTRIBUTE:
case EXEC_OMP_DISTRIBUTE_PARALLEL_DO:
case EXEC_OMP_DISTRIBUTE_PARALLEL_DO_SIMD:
diff --git a/gcc/testsuite/gfortran.dg/gomp/depobj-1.f90 b/gcc/testsuite/gfortran.dg/gomp/depobj-1.f90
new file mode 100644
index 00000000000..66cfb61060f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/depobj-1.f90
@@ -0,0 +1,25 @@
+! { dg-do compile { target { fortran_integer_16 || ilp32 } } }
+! omp_depend_kind = 2*intptr_t --> 16 (128 bit) on 64bit-pointer systems
+! --> 8 (128 bit) on 32bit-pointer systems
+subroutine f1
+ !use omp_lib ! N/A in gcc/testsuite
+ use iso_c_binding, only: c_intptr_t
+ implicit none
+ integer, parameter :: omp_depend_kind = 2*c_intptr_t
+ integer :: a
+ integer(kind=omp_depend_kind) :: depobj1, depobj2, depobj3, depobj4, depobj5
+ !$omp depobj(depobj1) depend (in : a)
+ !$omp depobj(depobj2) depend (out : a)
+ !$omp depobj(depobj3) depend( inout : a)
+ !$omp depobj(depobj4) depend(mutexinoutset: a)
+ !$omp depobj(depobj1) update(out)
+ !$omp depobj(depobj2) update(mutexinoutset)
+ !$omp depobj(depobj3) update(in)
+ !$omp depobj(depobj4) update(inout)
+ !$omp task depend (depobj: depobj1, depobj2, depobj3)
+ !$omp end task
+
+ !$omp task depend(mutexinoutset: a)
+ !$omp end task
+ !$omp depobj(depobj2) destroy
+end subroutine f1
diff --git a/gcc/testsuite/gfortran.dg/gomp/depobj-2.f90 b/gcc/testsuite/gfortran.dg/gomp/depobj-2.f90
new file mode 100644
index 00000000000..3ffd3d5d01b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/depobj-2.f90
@@ -0,0 +1,33 @@
+! { dg-do compile { target { fortran_integer_16 || ilp32 } } }
+! omp_depend_kind = 2*intptr_t --> 16 (128 bit) on 64bit-pointer systems
+! --> 8 (128 bit) on 32bit-pointer systems
+subroutine f1
+ !use omp_lib ! N/A in gcc/testsuite
+ use iso_c_binding, only: c_intptr_t
+ implicit none
+ integer, parameter :: omp_depend_kind = 2*c_intptr_t
+ integer :: a, b
+ integer(kind=omp_depend_kind) :: depobj, depobj1(5)
+ real :: r
+ integer(1) :: d
+
+ !$omp depobj ! { dg-error "Expected '\\( depobj \\)\'" }
+ !$omp depobj(depobj) ! { dg-error "Expected DEPEND, UPDATE, or DESTROY clause" }
+ !$omp depobj destroy ! { dg-error "Expected '\\( depobj \\)\'" }
+ !$omp depobj ( depobj1 ( 1 ) ) depend( inout : a) ! OK
+ !$omp depobj(depobj1) depend( inout : a) ! { dg-error "DEPOBJ in DEPOBJ construct at .1. shall be a scalar integer of OMP_DEPEND_KIND kind" }
+ !$omp depobj(depobj1(:)) depend( inout : a) ! { dg-error "DEPOBJ in DEPOBJ construct at .1. shall be a scalar integer of OMP_DEPEND_KIND kind" }
+ !$omp depobj(r) depend( inout : a) ! { dg-error "DEPOBJ in DEPOBJ construct at .1. shall be a scalar integer of OMP_DEPEND_KIND kind" }
+ !$omp depobj(d) depend( inout : a) ! { dg-error "DEPOBJ in DEPOBJ construct at .1. shall be a scalar integer of OMP_DEPEND_KIND kind" }
+ !$omp depobj(depobj) depend( inout : a, b) ! { dg-error "DEPEND clause at .1. of OMP DEPOBJ construct shall have only a single locator" }
+ !$omp depobj(depobj) depend(mutexinoutset : a) ! OK
+ !$omp depobj(depobj) depend(source) ! { dg-error "DEPEND clause at .1. of OMP DEPOBJ construct shall not have dependence-type SOURCE, SINK or DEPOBJ" }
+ !$omp depobj(depobj) depend(sink : i + 1) ! { dg-error "DEPEND clause at .1. of OMP DEPOBJ construct shall not have dependence-type SOURCE, SINK or DEPOBJ" }
+ !$omp depobj(depobj) update(source) ! { dg-error "Expected IN, OUT, INOUT, MUTEXINOUTSET followed by '\\)'" }
+ !$omp depobj(depobj) update(sink) ! { dg-error "Expected IN, OUT, INOUT, MUTEXINOUTSET followed by '\\)'" }
+ !$omp depobj(depobj) update(depobj) ! { dg-error "Expected IN, OUT, INOUT, MUTEXINOUTSET followed by '\\)'" }
+
+ ! Valid in OpenMP 5.1:
+ !$omp depobj(depobj5) depend(depobj: depobj3) ! { dg-error "DEPEND clause at .1. of OMP DEPOBJ construct shall not have dependence-type SOURCE, SINK or DEPOBJ" }
+end subroutine f1
+
diff --git a/libgomp/testsuite/libgomp.fortran/depobj-1.f90 b/libgomp/testsuite/libgomp.fortran/depobj-1.f90
new file mode 100644
index 00000000000..eb314f67bae
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/depobj-1.f90
@@ -0,0 +1,113 @@
+module m
+! use omp_lib
+ implicit none (type, external)
+integer, parameter :: omp_depend_kind = 16
+ integer :: xx
+ integer(omp_depend_kind) :: dd1, dd2
+contains
+ subroutine dep
+ integer :: x
+ integer(omp_depend_kind) :: d1, d2
+ x = 1
+
+ !$omp depobj (d1) depend(in: x)
+ !$omp depobj (d2) depend(in: x)
+ !$omp depobj (d2) update(out)
+ !$omp parallel
+ !$omp single
+ !$omp task shared (x) depend(depobj: d2)
+ x = 2
+ !$omp end task
+ !$omp task shared (x) depend(depobj: d1)
+ if (x /= 2) &
+ stop 1
+ !$omp end task
+ !$omp end single
+ !$omp end parallel
+ !$omp depobj (d2) destroy
+ !$omp depobj (d1) destroy
+ end
+
+ subroutine dep2
+ integer, pointer :: x
+ integer(omp_depend_kind) :: d1, d2
+ pointer :: d1
+ allocate(d1, x)
+ call dep2i(d1, d2, x)
+ deallocate(d1)
+ contains
+ subroutine dep2i(d1, d2, x)
+ integer(omp_depend_kind) :: d1
+ integer(omp_depend_kind), optional :: d2
+ integer, pointer, optional :: x
+ pointer :: d1
+ !$omp parallel
+ !$omp single
+ x = 1
+ !$omp depobj (d1) depend(out: x)
+ !$omp depobj (d2) depend (in:x)
+ !$omp depobj(d2)update(in)
+ !$omp task shared (x) depend(depobj:d1)
+ x = 2
+ !$omp end task
+ !$omp task shared (x) depend(depobj : d2)
+ if (x /= 2) &
+ stop 2
+ !$omp end task
+ !$omp taskwait
+ !$omp depobj(d1)destroy
+ !$omp depobj(d2) destroy
+ !$omp end single
+ !$omp end parallel
+ end
+ end
+
+ subroutine dep3
+ integer :: x
+ integer(omp_depend_kind) :: d(2)
+ !$omp parallel
+ x = 1
+ !$omp single
+ !$omp depobj(d(1)) depend(out:x)
+ !$omp depobj(d(2)) depend(in: x)
+ !$omp task shared (x) depend(depobj: d(1))
+ x = 2
+ !$omp end task
+ !$omp task shared (x) depend(depobj: d(2))
+ if (x /= 2) &
+ stop 3
+ !$omp end task
+ !$omp end single
+ !$omp end parallel
+ !$omp depobj(d(1)) destroy
+ !$omp depobj(d(2)) destroy
+ end
+
+ subroutine antidep
+ xx = 1
+ !$omp parallel
+ !$omp single
+ !$omp task shared(xx) depend(depobj:dd2)
+ if (xx /= 1) &
+ stop 4
+ !$omp end task
+ !$omp task shared(xx) depend(depobj:dd1)
+ xx = 2
+ !$omp end task
+ !$omp end single
+ !$omp end parallel
+ end
+end module m
+
+program main
+ use m
+ implicit none (type, external)
+ call dep ()
+ call dep2 ()
+ call dep3 ()
+ !$omp depobj (dd1) depend (inout: xx)
+ !$omp depobj (dd2) depend (in : xx)
+ call antidep ()
+ !$omp depobj (dd2) destroy
+ !$omp depobj (dd1) destroy
+end program main
^ permalink raw reply [flat|nested] 3+ messages in thread
end of thread, other threads:[~2021-04-20 21:18 UTC | newest]
Thread overview: 3+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2021-03-17 18:19 [Patch][GCC12] Fortran/OpenMP: Add 'omp depobj' and 'depend(mutexinoutset:' Tobias Burnus
2021-03-17 18:29 ` Jakub Jelinek
2021-04-20 21:15 ` Tobias Burnus
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).