mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-04-04 14:31:29 +08:00
Code Issues Packages Projects Releases Wiki Activity

OpenMP: Add 'omp requires' to Fortran (mostly parsing)

Browse Source 
gcc/fortran/ChangeLog:

	* gfortran.h (enum gfc_statement): Add ST_OMP_REQUIRES.
	(enum gfc_omp_requires_kind): New.
	(enum gfc_omp_atomic_op): Add GFC_OMP_ATOMIC_ACQ_REL.
	(struct gfc_namespace): Add omp_requires and omp_target_seen.
	(gfc_omp_requires_add_clause,
	(gfc_check_omp_requires): New.
	* match.h (gfc_match_omp_requires): New.
	* module.c (enum ab_attribute, attr_bits): Add omp requires clauses.
	(mio_symbol_attribute): Read/write them.
	* openmp.c (gfc_check_omp_requires, (gfc_omp_requires_add_clause,
	gfc_match_omp_requires): New.
	(gfc_match_omp_oacc_atomic): Use requires's default mem-order.
	* parse.c (decode_omp_directive): Match requires, set omp_target_seen.
	(gfc_ascii_statement): Handle ST_OMP_REQUIRES.
	* trans-openmp.c (gfc_trans_omp_atomic): Handle GFC_OMP_ATOMIC_ACQ_REL.

gcc/testsuite/ChangeLog:

	* gfortran.dg/gomp/requires-1.f90: New test.
	* gfortran.dg/gomp/requires-2.f90: New test.
	* gfortran.dg/gomp/requires-3.f90: New test.
	* gfortran.dg/gomp/requires-4.f90: New test.
	* gfortran.dg/gomp/requires-5.f90: New test.
	* gfortran.dg/gomp/requires-6.f90: New test.
	* gfortran.dg/gomp/requires-7.f90: New test.
	* gfortran.dg/gomp/requires-8.f90: New test.
	* gfortran.dg/gomp/requires-9.f90: New test.
This commit is contained in:
Tobias Burnus 2020-07-29 10:37:44 +02:00
parent 5c180464b7
commit 269322ece1
15 changed files with 648 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
gcc/fortran/gfortran.h
View File

@ -263,7 +263,7 @@ enum gfc_statement
ST_OMP_TARGET_SIMD, ST_OMP_END_TARGET_SIMD,
ST_OMP_TASKLOOP, ST_OMP_END_TASKLOOP,
ST_OMP_TASKLOOP_SIMD, ST_OMP_END_TASKLOOP_SIMD, ST_OMP_ORDERED_DEPEND,
ST_PROCEDURE, ST_GENERIC, ST_CRITICAL, ST_END_CRITICAL,
ST_OMP_REQUIRES, ST_PROCEDURE, ST_GENERIC, ST_CRITICAL, ST_END_CRITICAL,
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_NONE
@ -1334,6 +1334,24 @@ enum gfc_omp_if_kind
OMP_IF_LAST
};
enum gfc_omp_requires_kind
{
/* Keep in sync with gfc_namespace, esp. with omp_req_mem_order. */
OMP_REQ_ATOMIC_MEM_ORDER_SEQ_CST = 1, /* 01 */
OMP_REQ_ATOMIC_MEM_ORDER_ACQ_REL = 2, /* 10 */
OMP_REQ_ATOMIC_MEM_ORDER_RELAXED = 3, /* 11 */
OMP_REQ_REVERSE_OFFLOAD = (1 << 2),
OMP_REQ_UNIFIED_ADDRESS = (1 << 3),
OMP_REQ_UNIFIED_SHARED_MEMORY = (1 << 4),
OMP_REQ_DYNAMIC_ALLOCATORS = (1 << 5),
OMP_REQ_TARGET_MASK = (OMP_REQ_REVERSE_OFFLOAD
| OMP_REQ_UNIFIED_ADDRESS
| OMP_REQ_UNIFIED_SHARED_MEMORY),
OMP_REQ_ATOMIC_MEM_ORDER_MASK = (OMP_REQ_ATOMIC_MEM_ORDER_SEQ_CST
| OMP_REQ_ATOMIC_MEM_ORDER_ACQ_REL
| OMP_REQ_ATOMIC_MEM_ORDER_RELAXED)
};
typedef struct gfc_omp_clauses
{
struct gfc_expr *if_expr;
@ -1915,6 +1933,10 @@ typedef struct gfc_namespace
/* Set to 1 if there are any calls to procedures with implicit interface. */
unsigned implicit_interface_calls:1;
/* OpenMP requires. */
unsigned omp_requires:6;
unsigned omp_target_seen:1;
}
gfc_namespace;
@ -2645,7 +2667,8 @@ enum gfc_omp_atomic_op
GFC_OMP_ATOMIC_CAPTURE = 3,
GFC_OMP_ATOMIC_MASK = 3,
GFC_OMP_ATOMIC_SEQ_CST = 4,
GFC_OMP_ATOMIC_SWAP = 8
GFC_OMP_ATOMIC_ACQ_REL = 8,
GFC_OMP_ATOMIC_SWAP = 16
};
typedef struct gfc_code
@ -3270,6 +3293,9 @@ gfc_expr *gfc_get_parentheses (gfc_expr *);
/* openmp.c */
struct gfc_omp_saved_state { void *ptrs[2]; int ints[1]; };
bool gfc_omp_requires_add_clause (gfc_omp_requires_kind, const char *,
locus *, const char *);
void gfc_check_omp_requires (gfc_namespace *, int);
void gfc_free_omp_clauses (gfc_omp_clauses *);
void gfc_free_oacc_declare_clauses (struct gfc_oacc_declare *);
void gfc_free_omp_declare_simd (gfc_omp_declare_simd *);

1
gcc/fortran/match.h
View File

@ -177,6 +177,7 @@ match gfc_match_omp_parallel_do (void);
match gfc_match_omp_parallel_do_simd (void);
match gfc_match_omp_parallel_sections (void);
match gfc_match_omp_parallel_workshare (void);
match gfc_match_omp_requires (void);
match gfc_match_omp_sections (void);
match gfc_match_omp_simd (void);
match gfc_match_omp_single (void);

73
gcc/fortran/module.c
View File

@ -2047,7 +2047,11 @@ enum ab_attribute
AB_OMP_DECLARE_TARGET_LINK, AB_PDT_KIND, AB_PDT_LEN, AB_PDT_TYPE,
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
AB_OACC_ROUTINE_LOP_VECTOR, AB_OACC_ROUTINE_LOP_SEQ,
AB_OMP_REQ_REVERSE_OFFLOAD, AB_OMP_REQ_UNIFIED_ADDRESS,
AB_OMP_REQ_UNIFIED_SHARED_MEMORY, AB_OMP_REQ_DYNAMIC_ALLOCATORS,
AB_OMP_REQ_MEM_ORDER_SEQ_CST, AB_OMP_REQ_MEM_ORDER_ACQ_REL,
AB_OMP_REQ_MEM_ORDER_RELAXED
};
static const mstring attr_bits[] =
@ -2121,6 +2125,13 @@ static const mstring attr_bits[] =
minit ("OACC_ROUTINE_LOP_WORKER", AB_OACC_ROUTINE_LOP_WORKER),
minit ("OACC_ROUTINE_LOP_VECTOR", AB_OACC_ROUTINE_LOP_VECTOR),
minit ("OACC_ROUTINE_LOP_SEQ", AB_OACC_ROUTINE_LOP_SEQ),
minit ("OMP_REQ_REVERSE_OFFLOAD", AB_OMP_REQ_REVERSE_OFFLOAD),
minit ("OMP_REQ_UNIFIED_ADDRESS", AB_OMP_REQ_UNIFIED_ADDRESS),
minit ("OMP_REQ_UNIFIED_SHARED_MEMORY", AB_OMP_REQ_UNIFIED_SHARED_MEMORY),
minit ("OMP_REQ_DYNAMIC_ALLOCATORS", AB_OMP_REQ_DYNAMIC_ALLOCATORS),
minit ("OMP_REQ_MEM_ORDER_SEQ_CST", AB_OMP_REQ_MEM_ORDER_SEQ_CST),
minit ("OMP_REQ_MEM_ORDER_ACQ_REL", AB_OMP_REQ_MEM_ORDER_ACQ_REL),
minit ("OMP_REQ_MEM_ORDER_RELAXED", AB_OMP_REQ_MEM_ORDER_RELAXED),
minit (NULL, -1)
};
@ -2366,8 +2377,27 @@ mio_symbol_attribute (symbol_attribute *attr)
gcc_unreachable ();
}
if (attr->flavor == FL_MODULE && gfc_current_ns->omp_requires)
{
if (gfc_current_ns->omp_requires & OMP_REQ_REVERSE_OFFLOAD)
MIO_NAME (ab_attribute) (AB_OMP_REQ_REVERSE_OFFLOAD, attr_bits);
if (gfc_current_ns->omp_requires & OMP_REQ_UNIFIED_ADDRESS)
MIO_NAME (ab_attribute) (AB_OMP_REQ_UNIFIED_ADDRESS, attr_bits);
if (gfc_current_ns->omp_requires & OMP_REQ_UNIFIED_SHARED_MEMORY)
MIO_NAME (ab_attribute) (AB_OMP_REQ_UNIFIED_SHARED_MEMORY, attr_bits);
if (gfc_current_ns->omp_requires & OMP_REQ_DYNAMIC_ALLOCATORS)
MIO_NAME (ab_attribute) (AB_OMP_REQ_DYNAMIC_ALLOCATORS, attr_bits);
if ((gfc_current_ns->omp_requires & OMP_REQ_ATOMIC_MEM_ORDER_MASK)
== OMP_REQ_ATOMIC_MEM_ORDER_SEQ_CST)
MIO_NAME (ab_attribute) (AB_OMP_REQ_MEM_ORDER_SEQ_CST, attr_bits);
if ((gfc_current_ns->omp_requires & OMP_REQ_ATOMIC_MEM_ORDER_MASK)
== OMP_REQ_ATOMIC_MEM_ORDER_ACQ_REL)
MIO_NAME (ab_attribute) (AB_OMP_REQ_MEM_ORDER_ACQ_REL, attr_bits);
if ((gfc_current_ns->omp_requires & OMP_REQ_ATOMIC_MEM_ORDER_MASK)
== OMP_REQ_ATOMIC_MEM_ORDER_RELAXED)
MIO_NAME (ab_attribute) (AB_OMP_REQ_MEM_ORDER_RELAXED, attr_bits);
}
mio_rparen ();
}
else
{
@ -2592,6 +2622,45 @@ mio_symbol_attribute (symbol_attribute *attr)
verify_OACC_ROUTINE_LOP_NONE (attr->oacc_routine_lop);
attr->oacc_routine_lop = OACC_ROUTINE_LOP_SEQ;
break;
case AB_OMP_REQ_REVERSE_OFFLOAD:
gfc_omp_requires_add_clause (OMP_REQ_REVERSE_OFFLOAD,
"reverse_offload",
&gfc_current_locus,
module_name);
break;
case AB_OMP_REQ_UNIFIED_ADDRESS:
gfc_omp_requires_add_clause (OMP_REQ_UNIFIED_ADDRESS,
"unified_address",
&gfc_current_locus,
module_name);
break;
case AB_OMP_REQ_UNIFIED_SHARED_MEMORY:
gfc_omp_requires_add_clause (OMP_REQ_UNIFIED_SHARED_MEMORY,
"unified_shared_memory",
&gfc_current_locus,
module_name);
break;
case AB_OMP_REQ_DYNAMIC_ALLOCATORS:
gfc_omp_requires_add_clause (OMP_REQ_DYNAMIC_ALLOCATORS,
"dynamic_allocators",
&gfc_current_locus,
module_name);
break;
case AB_OMP_REQ_MEM_ORDER_SEQ_CST:
gfc_omp_requires_add_clause (OMP_REQ_ATOMIC_MEM_ORDER_SEQ_CST,
"seq_cst", &gfc_current_locus,
module_name);
break;
case AB_OMP_REQ_MEM_ORDER_ACQ_REL:
gfc_omp_requires_add_clause (OMP_REQ_ATOMIC_MEM_ORDER_ACQ_REL,
"acq_rel", &gfc_current_locus,
module_name);
break;
case AB_OMP_REQ_MEM_ORDER_RELAXED:
gfc_omp_requires_add_clause (OMP_REQ_ATOMIC_MEM_ORDER_RELAXED,
"relaxed", &gfc_current_locus,
module_name);
break;
}
}
}

244
gcc/fortran/openmp.c
View File

@ -3424,6 +3424,230 @@ gfc_match_omp_parallel_workshare (void)
return match_omp (EXEC_OMP_PARALLEL_WORKSHARE, OMP_PARALLEL_CLAUSES);
}
void
gfc_check_omp_requires (gfc_namespace *ns, int ref_omp_requires)
{
if (ns->omp_target_seen
&& (ns->omp_requires & OMP_REQ_TARGET_MASK)
!= (ref_omp_requires & OMP_REQ_TARGET_MASK))
{
gcc_assert (ns->proc_name);
if ((ref_omp_requires & OMP_REQ_REVERSE_OFFLOAD)
&& !(ns->omp_requires & OMP_REQ_REVERSE_OFFLOAD))
gfc_error ("Program unit at %L has OpenMP device constructs/routines "
"but does not set !$OMP REQUIRES REVERSE_OFFSET but other "
"program units do", &ns->proc_name->declared_at);
if ((ref_omp_requires & OMP_REQ_UNIFIED_ADDRESS)
&& !(ns->omp_requires & OMP_REQ_UNIFIED_ADDRESS))
gfc_error ("Program unit at %L has OpenMP device constructs/routines "
"but does not set !$OMP REQUIRES UNIFIED_ADDRESS but other "
"program units do", &ns->proc_name->declared_at);
if ((ref_omp_requires & OMP_REQ_UNIFIED_SHARED_MEMORY)
&& !(ns->omp_requires & OMP_REQ_UNIFIED_SHARED_MEMORY))
gfc_error ("Program unit at %L has OpenMP device constructs/routines "
"but does not set !$OMP REQUIRES UNIFIED_SHARED_MEMORY but "
"other program units do", &ns->proc_name->declared_at);
}
}
bool
gfc_omp_requires_add_clause (gfc_omp_requires_kind clause,
const char *clause_name, locus *loc,
const char *module_name)
{
gfc_namespace *prog_unit = gfc_current_ns;
while (prog_unit->parent)
{
if (gfc_state_stack->previous
&& gfc_state_stack->previous->state == COMP_INTERFACE)
break;
prog_unit = prog_unit->parent;
}
/* Requires added after use. */
if (prog_unit->omp_target_seen
&& (clause & OMP_REQ_TARGET_MASK)
&& !(prog_unit->omp_requires & clause))
{
if (module_name)
gfc_error ("!$OMP REQUIRES clause %qs specified via module %qs use "
"at %L comes after using a device construct/routine",
clause_name, module_name, loc);
else
gfc_error ("!$OMP REQUIRES clause %qs specified at %L comes after "
"using a device construct/routine", clause_name, loc);
return false;
}
/* Overriding atomic_default_mem_order clause value. */
if ((clause & OMP_REQ_ATOMIC_MEM_ORDER_MASK)
&& (prog_unit->omp_requires & OMP_REQ_ATOMIC_MEM_ORDER_MASK)
&& (prog_unit->omp_requires & OMP_REQ_ATOMIC_MEM_ORDER_MASK)
!= (int) clause)
{
const char *other;
if (prog_unit->omp_requires & OMP_REQ_ATOMIC_MEM_ORDER_SEQ_CST)
other = "seq_cst";
else if (prog_unit->omp_requires & OMP_REQ_ATOMIC_MEM_ORDER_ACQ_REL)
other = "acq_rel";
else if (prog_unit->omp_requires & OMP_REQ_ATOMIC_MEM_ORDER_RELAXED)
other = "relaxed";
else
gcc_unreachable ();
if (module_name)
gfc_error ("!$OMP REQUIRES clause %<atomic_default_mem_order(%s)%> "
"specified via module %qs use at %L overrides a previous "
"%<atomic_default_mem_order(%s)%> (which might be through "
"using a module)", clause_name, module_name, loc, other);
else
gfc_error ("!$OMP REQUIRES clause %<atomic_default_mem_order(%s)%> "
"specified at %L overrides a previous "
"%<atomic_default_mem_order(%s)%> (which might be through "
"using a module)", clause_name, loc, other);
return false;
}
/* Requires via module not at program-unit level and not repeating clause. */
if (prog_unit != gfc_current_ns && !(prog_unit->omp_requires & clause))
{
if (clause & OMP_REQ_ATOMIC_MEM_ORDER_MASK)
gfc_error ("!$OMP REQUIRES clause %<atomic_default_mem_order(%s)%> "
"specified via module %qs use at %L but same clause is "
"not set at for the program unit", clause_name, module_name,
loc);
else
gfc_error ("!$OMP REQUIRES clause %qs specified via module %qs use at "
"%L but same clause is not set at for the program unit",
clause_name, module_name, loc);
return false;
}
if (!gfc_state_stack->previous
|| gfc_state_stack->previous->state != COMP_INTERFACE)
prog_unit->omp_requires |= clause;
return true;
}
match
gfc_match_omp_requires (void)
{
static const char *clauses[] = {"reverse_offload",
"unified_address",
"unified_shared_memory",
"dynamic_allocators",
"atomic_default"};
const char *clause = NULL;
int requires_clauses = 0;
bool first = true;
locus old_loc;
if (gfc_current_ns->parent
&& (!gfc_state_stack->previous
|| gfc_state_stack->previous->state != COMP_INTERFACE))
{
gfc_error ("!$OMP REQUIRES at %C must appear in the specification part "
"of a program unit");
return MATCH_ERROR;
}
while (true)
{
old_loc = gfc_current_locus;
gfc_omp_requires_kind requires_clause;
if ((first || gfc_match_char (',') != MATCH_YES)
&& (first && gfc_match_space () != MATCH_YES))
goto error;
first = false;
gfc_gobble_whitespace ();
old_loc = gfc_current_locus;
if (gfc_match_omp_eos () != MATCH_NO)
break;
if (gfc_match (clauses[0]) == MATCH_YES)
{
clause = clauses[0];
requires_clause = OMP_REQ_REVERSE_OFFLOAD;
if (requires_clauses & OMP_REQ_REVERSE_OFFLOAD)
goto duplicate_clause;
}
else if (gfc_match (clauses[1]) == MATCH_YES)
{
clause = clauses[1];
requires_clause = OMP_REQ_UNIFIED_ADDRESS;
if (requires_clauses & OMP_REQ_UNIFIED_ADDRESS)
goto duplicate_clause;
}
else if (gfc_match (clauses[2]) == MATCH_YES)
{
clause = clauses[2];
requires_clause = OMP_REQ_UNIFIED_SHARED_MEMORY;
if (requires_clauses & OMP_REQ_UNIFIED_SHARED_MEMORY)
goto duplicate_clause;
}
else if (gfc_match (clauses[3]) == MATCH_YES)
{
clause = clauses[3];
requires_clause = OMP_REQ_DYNAMIC_ALLOCATORS;
if (requires_clauses & OMP_REQ_DYNAMIC_ALLOCATORS)
goto duplicate_clause;
}
else if (gfc_match ("atomic_default_mem_order (") == MATCH_YES)
{
clause = clauses[4];
if (requires_clauses & OMP_REQ_ATOMIC_MEM_ORDER_MASK)
goto duplicate_clause;
if (gfc_match (" seq_cst )") == MATCH_YES)
{
clause = "seq_cst";
requires_clause = OMP_REQ_ATOMIC_MEM_ORDER_SEQ_CST;
}
else if (gfc_match (" acq_rel )") == MATCH_YES)
{
clause = "acq_rel";
requires_clause = OMP_REQ_ATOMIC_MEM_ORDER_ACQ_REL;
}
else if (gfc_match (" relaxed )") == MATCH_YES)
{
clause = "relaxed";
requires_clause = OMP_REQ_ATOMIC_MEM_ORDER_RELAXED;
}
else
{
gfc_error ("Expected SEQ_CST, ACQ_REL or RELAXED for "
"ATOMIC_DEFAULT_MEM_ORDER clause at %C");
goto error;
}
}
else
goto error;
if (requires_clause & ~OMP_REQ_ATOMIC_MEM_ORDER_MASK)
gfc_error_now ("Sorry, %qs clause at %L on REQUIRES directive is not "
"yet supported", clause, &old_loc);
if (!gfc_omp_requires_add_clause (requires_clause, clause, &old_loc, NULL))
goto error;
requires_clauses |= requires_clause;
}
if (requires_clauses == 0)
{
if (!gfc_error_flag_test ())
gfc_error ("Clause expected at %C");
goto error;
}
return MATCH_YES;
duplicate_clause:
gfc_error ("%qs clause at %L specified more than once", clause, &old_loc);
error:
if (!gfc_error_flag_test ())
gfc_error ("Expected UNIFIED_ADDRESS, UNIFIED_SHARED_MEMORY, "
"DYNAMIC_ALLOCATORS, REVERSE_OFFLOAD, or "
"ATOMIC_DEFAULT_MEM_ORDER clause at %L", &old_loc);
return MATCH_ERROR;
}
match
gfc_match_omp_sections (void)
@ -3745,6 +3969,26 @@ gfc_match_omp_oacc_atomic (bool omp_p)
new_st.op = (omp_p ? EXEC_OMP_ATOMIC : EXEC_OACC_ATOMIC);
if (seq_cst)
op = (gfc_omp_atomic_op) (op | GFC_OMP_ATOMIC_SEQ_CST);
else if (omp_p)
{
gfc_namespace *prog_unit = gfc_current_ns;
while (prog_unit->parent)
prog_unit = prog_unit->parent;
switch (prog_unit->omp_requires & OMP_REQ_ATOMIC_MEM_ORDER_MASK)
{
case 0:
case OMP_REQ_ATOMIC_MEM_ORDER_RELAXED:
break;
case OMP_REQ_ATOMIC_MEM_ORDER_SEQ_CST:
op = (gfc_omp_atomic_op) (op | GFC_OMP_ATOMIC_SEQ_CST);
break;
case OMP_REQ_ATOMIC_MEM_ORDER_ACQ_REL:
op = (gfc_omp_atomic_op) (op | GFC_OMP_ATOMIC_ACQ_REL);
break;
default:
gcc_unreachable ();
}
}
new_st.ext.omp_atomic = op;
return MATCH_YES;
}

53
gcc/fortran/parse.c
View File

@ -995,6 +995,9 @@ decode_omp_directive (void)
ST_OMP_PARALLEL_WORKSHARE);
matcho ("parallel", gfc_match_omp_parallel, ST_OMP_PARALLEL);
break;
case 'r':
matcho ("requires", gfc_match_omp_requires, ST_OMP_REQUIRES);
break;
case 's':
matcho ("sections", gfc_match_omp_sections, ST_OMP_SECTIONS);
matcho ("section", gfc_match_omp_eos_error, ST_OMP_SECTION);
@ -1086,6 +1089,38 @@ decode_omp_directive (void)
return ST_NONE;
}
}
switch (ret)
{
case ST_OMP_DECLARE_TARGET:
case ST_OMP_TARGET:
case ST_OMP_TARGET_DATA:
case ST_OMP_TARGET_ENTER_DATA:
case ST_OMP_TARGET_EXIT_DATA:
case ST_OMP_TARGET_TEAMS:
case ST_OMP_TARGET_TEAMS_DISTRIBUTE:
case ST_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD:
case ST_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO:
case ST_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
case ST_OMP_TARGET_PARALLEL:
case ST_OMP_TARGET_PARALLEL_DO:
case ST_OMP_TARGET_PARALLEL_DO_SIMD:
case ST_OMP_TARGET_SIMD:
case ST_OMP_TARGET_UPDATE:
{
gfc_namespace *prog_unit = gfc_current_ns;
while (prog_unit->parent)
{
if (gfc_state_stack->previous
&& gfc_state_stack->previous->state == COMP_INTERFACE)
break;
prog_unit = prog_unit->parent;
}
prog_unit->omp_target_seen = true;
break;
}
default:
break;
}
return ret;
do_spec_only:
@ -1604,7 +1639,8 @@ next_statement (void)
/* OpenMP declaration statements. */
#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_TARGET: case ST_OMP_DECLARE_REDUCTION: \
case ST_OMP_REQUIRES
/* Block end statements. Errors associated with interchanging these
are detected in gfc_match_end(). */
@ -2407,6 +2443,9 @@ gfc_ascii_statement (gfc_statement st)
case ST_OMP_PARALLEL_WORKSHARE:
p = "!$OMP PARALLEL WORKSHARE";
break;
case ST_OMP_REQUIRES:
p = "!$OMP REQUIRES";
break;
case ST_OMP_SECTIONS:
p = "!$OMP SECTIONS";
break;
@ -6516,10 +6555,18 @@ done:
}
while (changed);
/* Fixup for external procedures. */
/* Fixup for external procedures and resolve 'omp requires'. */
int omp_requires;
omp_requires = 0;
for (gfc_current_ns = gfc_global_ns_list; gfc_current_ns;
gfc_current_ns = gfc_current_ns->sibling)
gfc_check_externals (gfc_current_ns);
{
omp_requires |= gfc_current_ns->omp_requires;
gfc_check_externals (gfc_current_ns);
}
for (gfc_current_ns = gfc_global_ns_list; gfc_current_ns;
gfc_current_ns = gfc_current_ns->sibling)
gfc_check_omp_requires (gfc_current_ns, omp_requires);
/* Do the parse tree dump. */
gfc_current_ns = flag_dump_fortran_original ? gfc_global_ns_list : NULL;

10
gcc/fortran/trans-openmp.c
View File

@ -3932,9 +3932,13 @@ gfc_trans_omp_atomic (gfc_code *code)
enum tree_code op = ERROR_MARK;
enum tree_code aop = OMP_ATOMIC;
bool var_on_left = false;
enum omp_memory_order mo
= ((atomic_code->ext.omp_atomic & GFC_OMP_ATOMIC_SEQ_CST)
? OMP_MEMORY_ORDER_SEQ_CST : OMP_MEMORY_ORDER_RELAXED);
enum omp_memory_order mo;
if (atomic_code->ext.omp_atomic & GFC_OMP_ATOMIC_SEQ_CST)
mo = OMP_MEMORY_ORDER_SEQ_CST;
else if (atomic_code->ext.omp_atomic & GFC_OMP_ATOMIC_ACQ_REL)
mo = OMP_MEMORY_ORDER_ACQ_REL;
else
mo = OMP_MEMORY_ORDER_RELAXED;
code = code->block->next;
gcc_assert (code->op == EXEC_ASSIGN);

13
gcc/testsuite/gfortran.dg/gomp/requires-1.f90 Normal file
View File

@ -0,0 +1,13 @@
subroutine foo
!$omp requires unified_address
!$omp requires unified_shared_memory
!$omp requires unified_shared_memory unified_address
!$omp requires dynamic_allocators,reverse_offload
end
subroutine bar
!$omp requires unified_shared_memory unified_address
!$omp requires atomic_default_mem_order(seq_cst)
end
! { dg-prune-output "not yet supported" }

14
gcc/testsuite/gfortran.dg/gomp/requires-2.f90 Normal file
View File

@ -0,0 +1,14 @@
!$omp requires ! { dg-error "Clause expected" }
!$omp requires unified_shared_memory,unified_shared_memory ! { dg-error "specified more than once" }
!$omp requires unified_address unified_address ! { dg-error "specified more than once" }
!$omp requires reverse_offload reverse_offload ! { dg-error "specified more than once" }
!$omp requires foobarbaz ! { dg-error "Expected UNIFIED_ADDRESS, UNIFIED_SHARED_MEMORY, DYNAMIC_ALLOCATORS, REVERSE_OFFLOAD, or ATOMIC_DEFAULT_MEM_ORDER clause" }
!$omp requires dynamic_allocators , dynamic_allocators ! { dg-error "specified more than once" }
!$omp requires atomic_default_mem_order(seq_cst) atomic_default_mem_order(seq_cst) ! { dg-error "specified more than once" }
!$omp requires atomic_default_mem_order (seq_cst)
!$omp requires atomic_default_mem_order (seq_cst)
!$omp requires atomic_default_mem_order (acq_rel) ! { dg-error "overrides a previous 'atomic_default_mem_order\\(seq_cst\\)'" }
!$omp requires atomic_default_mem_order (foo) ! { dg-error "Expected SEQ_CST, ACQ_REL or RELAXED for ATOMIC_DEFAULT_MEM_ORDER clause" }
end
! { dg-prune-output "not yet supported" }

4
gcc/testsuite/gfortran.dg/gomp/requires-3.f90 Normal file
View File

@ -0,0 +1,4 @@
!$omp requires atomic_default_mem_order(acquire) ! { dg-error "Expected SEQ_CST, ACQ_REL or RELAXED for ATOMIC_DEFAULT_MEM_ORDER clause" }
!$omp requires atomic_default_mem_order(release) ! { dg-error "Expected SEQ_CST, ACQ_REL or RELAXED for ATOMIC_DEFAULT_MEM_ORDER clause" }
!$omp requires atomic_default_mem_order(foobar) ! { dg-error "Expected SEQ_CST, ACQ_REL or RELAXED for ATOMIC_DEFAULT_MEM_ORDER clause" }
end

36
gcc/testsuite/gfortran.dg/gomp/requires-4.f90 Normal file
View File

@ -0,0 +1,36 @@
subroutine bar
!$omp requires unified_shared_memory,unified_address,reverse_offload
end
module m
!$omp requires unified_shared_memory,unified_address,reverse_offload
end module m
subroutine foo
!$omp target
!$omp end target
! { dg-error "OpenMP device constructs/routines but does not set !.OMP REQUIRES REVERSE_OFFSET but other program units do" "" { target *-*-* } 9 }
! { dg-error "OpenMP device constructs/routines but does not set !.OMP REQUIRES UNIFIED_ADDRESS but other program units do" "" { target *-*-* } 9 }
! { dg-error "OpenMP device constructs/routines but does not set !.OMP REQUIRES UNIFIED_SHARED_MEMORY but other program units do" "" { target *-*-* } 9 }
end
subroutine foobar
i = 5 ! < execution statement
!$omp requires atomic_default_mem_order(seq_cst) ! { dg-error "Unexpected ..OMP REQUIRES statement" }
end
program main
!$omp requires dynamic_allocators ! OK
!$omp requires unified_shared_memory
!$omp requires unified_address
!$omp requires reverse_offload
contains
subroutine foo
!$target
!$end target
end subroutine
subroutine bar
!$omp requires unified_addres ! { dg-error "must appear in the specification part of a program unit" }
end subroutine bar
end
! { dg-prune-output "not yet supported" }

16
gcc/testsuite/gfortran.dg/gomp/requires-5.f90 Normal file
View File

@ -0,0 +1,16 @@
subroutine bar
!$omp requires atomic_default_mem_order(seq_cst)
!$omp requires unified_shared_memory
end
subroutine foo
!$omp requires unified_shared_memory
!$omp requires unified_shared_memory
!$omp requires atomic_default_mem_order(relaxed)
!$omp requires atomic_default_mem_order(relaxed)
!$omp requires atomic_default_mem_order(seq_cst) ! { dg-error "overrides a previous 'atomic_default_mem_order\\(seq_cst\\)'" }
!$omp target
!$omp end target
end
! { dg-prune-output "not yet supported" }

16
gcc/testsuite/gfortran.dg/gomp/requires-6.f90 Normal file
View File

@ -0,0 +1,16 @@
subroutine bar
!$omp atomic
i = i + 5
end
subroutine foo
!$omp requires atomic_default_mem_order(seq_cst)
end
subroutine foobar
!$omp atomic
i = i + 5
!$omp requires atomic_default_mem_order(acq_rel) ! { dg-error "Unexpected !.OMP REQUIRES statement" }
end
! { dg-prune-output "not yet supported" }

41
gcc/testsuite/gfortran.dg/gomp/requires-7.f90 Normal file
View File

@ -0,0 +1,41 @@
subroutine bar2
block
!$omp requires unified_shared_memory ! { dg-error "must appear in the specification part of a program unit" }
end block
end
subroutine bar
contains
subroutine foo
!$omp requires unified_shared_memory ! { dg-error "must appear in the specification part of a program unit" }
end
end
module m
contains
subroutine foo
!$omp requires unified_shared_memory ! { dg-error "must appear in the specification part of a program unit" }
end
end
module m2
interface
module subroutine foo()
end
end interface
end
submodule (m2) m2_sub
!$omp requires unified_shared_memory
contains
module procedure foo
end
end
program main
contains
subroutine foo
!$omp requires unified_shared_memory ! { dg-error "must appear in the specification part of a program unit" }
end
end
! { dg-prune-output "not yet supported" }

22
gcc/testsuite/gfortran.dg/gomp/requires-8.f90 Normal file
View File

@ -0,0 +1,22 @@
module m ! { dg-error "has OpenMP device constructs/routines but does not set !.OMP REQUIRES UNIFIED_SHARED_MEMORY but other program units do" }
!$omp requires reverse_offload
contains
subroutine foo
interface
subroutine bar2
!$!omp requires dynamic_allocators
end subroutine
end interface
!$omp target
call bar2()
!$omp end target
end subroutine foo
end module m
subroutine bar ! { dg-error "has OpenMP device constructs/routines but does not set !.OMP REQUIRES REVERSE_OFFSET but other program units do" }
!use m
!$omp requires unified_shared_memory
!$omp declare target
end subroutine bar
! { dg-prune-output "not yet supported" }

85
gcc/testsuite/gfortran.dg/gomp/requires-9.f90 Normal file
View File

@ -0,0 +1,85 @@
! { dg-additional-options "-fdump-tree-original" }
module relaxed
!$omp requires atomic_default_mem_order(relaxed)
end module relaxed
module seq
!$omp requires atomic_default_mem_order(seq_cst)
end module seq
module acq
!$omp requires atomic_default_mem_order(acq_rel)
end module acq
subroutine sub1
!$omp atomic ! <= relaxed
i1 = i1 + 5
end subroutine
subroutine sub2
!$omp atomic seq_cst
i2 = i2 + 5
end subroutine
subroutine sub3
use relaxed
!$omp atomic
i3 = i3 + 5
end subroutine
subroutine sub4
use relaxed
!$omp atomic seq_cst
i4 = i4 + 5
end subroutine
subroutine sub5
use seq
!$omp atomic
i5 = i5 + 5
contains
subroutine bar
block
!$omp atomic
i5b = i5b + 5
end block
end
end subroutine
subroutine sub6
use seq
!$omp atomic seq_cst
i6 = i6 + 5
end subroutine
subroutine sub7
use acq
!$omp atomic
i7 = i7 + 5
contains
subroutine foobar
block
!$omp atomic
i7b = i7b + 5
end block
end
end subroutine
subroutine sub8
use acq
!$omp atomic seq_cst
i8 = i8 + 5
end subroutine
! { dg-final { scan-tree-dump-times "#pragma omp atomic relaxed\[\n\r]\[^\n\r]*&i1 =" 1 "original" } }
! { dg-final { scan-tree-dump-times "#pragma omp atomic seq_cst\[\n\r]\[^\n\r]*&i2 =" 1 "original" } }
! { dg-final { scan-tree-dump-times "#pragma omp atomic relaxed\[\n\r]\[^\n\r]*&i3 =" 1 "original" } }
! { dg-final { scan-tree-dump-times "#pragma omp atomic seq_cst\[\n\r]\[^\n\r]*&i4 =" 1 "original" } }
! { dg-final { scan-tree-dump-times "#pragma omp atomic seq_cst\[\n\r]\[^\n\r]*&i5 =" 1 "original" } }
! { dg-final { scan-tree-dump-times "#pragma omp atomic seq_cst\[\n\r]\[^\n\r]*&i5 =" 1 "original" } }
! { dg-final { scan-tree-dump-times "#pragma omp atomic seq_cst\[\n\r]\[^\n\r]*&i5b =" 1 "original" } }
! { dg-final { scan-tree-dump-times "#pragma omp atomic seq_cst\[\n\r]\[^\n\r]*&i6 =" 1 "original" } }
! { dg-final { scan-tree-dump-times "#pragma omp atomic acq_rel\[\n\r]\[^\n\r]*&i7 =" 1 "original" } }
! { dg-final { scan-tree-dump-times "#pragma omp atomic acq_rel\[\n\r]\[^\n\r]*&i7b =" 1 "original" } }
! { dg-final { scan-tree-dump-times "#pragma omp atomic seq_cst\[\n\r]\[^\n\r]*&i8 =" 1 "original" } }