procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Fortran/OpenMP: Add 'omp depobj' and 'depend(mutexinoutset:'

Browse source 
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.
This commit is contained in:
Tobias Burnus 2021-04-21 10:58:29 +02:00
parent b4e17490c9
commit a61c4964cd
12 changed files with 402 additions and 5 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

33
gcc/fortran/dump-parse-tree.c
View file

@ -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:

12
gcc/fortran/gfortran.h
View file

@ -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

1
gcc/fortran/match.h
View file

@ -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);

113
gcc/fortran/openmp.c
View file

@ -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;

6
gcc/fortran/parse.c
View file

@ -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;

1
gcc/fortran/resolve.c
View file

@ -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:

1
gcc/fortran/st.c
View file

@ -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:

68
gcc/fortran/trans-openmp.c
View file

@ -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:

1
gcc/fortran/trans.c
View file

@ -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:

25
gcc/testsuite/gfortran.dg/gomp/depobj-1.f90 Normal file
View file

@ -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

33
gcc/testsuite/gfortran.dg/gomp/depobj-2.f90 Normal file
View file

@ -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

113
libgomp/testsuite/libgomp.fortran/depobj-1.f90 Normal file
View file

@ -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