Attached is an updated version – whether that will be fully
in line with OpenMP 5.1 remains to be seen. But in any case,
it now handles properly:
"If a directive appears in the declarative part of a module then the
behavior is as if that directive appears after any references to that
module."
Note: That with the current implementation, the restriction that
the 'requires' cannot come after an 'omp atomic' cannot occur as
'omp requires' belongs into the specification part of a 'program unit'
(Fortran; OpenMP: 'compilation unit') and 'omp atomic' belongs to
the execution part.
Thus, unless a later 'use m' implicitly provides the clause, it
cannot occur. (The current implementation does not permit that
use-stmt which is not at 'program unit' level can introduce new
clauses applicable at 'program unit' level.)
That's different to target as an 'omp declare target' also
belongs into the specification section. (Additionally, that
checking variable is also used for ensure that all program units
use the same offload clauses of omp requires.)
There is no 'use m' test for the three offload-related items
as the 'sorry, not implemented' prevents the creation of the
module file.
OK?
Tobias
-----------------
Mentor Graphics (Deutschland) GmbH, Arnulfstraße 201, 80634 München / Germany
Registergericht München HRB 106955, Geschäftsführer: Thomas Heurung, Alexander
Walter
OpenMP: Add 'omp requires' to Fortran (mostly parsing)
gcc/fortran/ChangeLog:
* gfortran.h (enum gfc_statement): Add ST_OMP_REQUIRES.
(enum gfc_omp_requires_kind): New.
(struct gfc_namespace): Add omp_requires and omp_target_seen.
(gfc_omp_requires): New global var.
(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_omp_requires): New global var.
(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.
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.
gcc/fortran/gfortran.h | 29 ++-
gcc/fortran/match.h | 1 +
gcc/fortran/module.c | 73 ++++++-
gcc/fortran/openmp.c | 262 ++++++++++++++++++++++++++
gcc/fortran/parse.c | 48 ++++-
gcc/testsuite/gfortran.dg/gomp/requires-1.f90 | 13 ++
gcc/testsuite/gfortran.dg/gomp/requires-2.f90 | 15 ++
gcc/testsuite/gfortran.dg/gomp/requires-3.f90 | 4 +
gcc/testsuite/gfortran.dg/gomp/requires-4.f90 | 36 ++++
gcc/testsuite/gfortran.dg/gomp/requires-5.f90 | 17 ++
gcc/testsuite/gfortran.dg/gomp/requires-6.f90 | 17 ++
gcc/testsuite/gfortran.dg/gomp/requires-7.f90 | 41 ++++
gcc/testsuite/gfortran.dg/gomp/requires-8.f90 | 22 +++
gcc/testsuite/gfortran.dg/gomp/requires-9.f90 | 59 ++++++
14 files changed, 631 insertions(+), 6 deletions(-)
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 5fa86aa4e30..a70c61c557b 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -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;
@@ -3269,7 +3291,12 @@ void gfc_free_case_list (gfc_case *);
gfc_expr *gfc_get_parentheses (gfc_expr *);
/* openmp.c */
+extern int gfc_omp_requires;
+
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 *);
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 *);
diff --git a/gcc/fortran/match.h b/gcc/fortran/match.h
index b3fb7033891..7bf70d77016 100644
--- a/gcc/fortran/match.h
+++ b/gcc/fortran/match.h
@@ -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);
diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c
index eccf92bf658..684bb7578a3 100644
--- a/gcc/fortran/module.c
+++ b/gcc/fortran/module.c
@@ -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_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;
}
}
}
diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
index 4a0466f968d..e795a08bf86 100644
--- a/gcc/fortran/openmp.c
+++ b/gcc/fortran/openmp.c
@@ -28,6 +28,16 @@ along with GCC; see the file COPYING3. If not see
#include "diagnostic.h"
#include "gomp-constants.h"
+
+/* gfc_omp_requires: requires which (effectively) apply to the whole TU, namely:
+ reverse_offload, unified_address, unified_shared_memory, which have to be
+ identical in all compilation units. Plus dynamic_allocators which is only
+ per compilation unit, but can be pushed to the whole TU. By contrast,
+ atomic_default_mem_order only applies to the compilation unit and can be
+ processed by the FE. */
+
+int gfc_omp_requires = 0;
+
/* Match an end of OpenMP directive. End of OpenMP directive is optional
whitespace, followed by '\n' or comment '!'. */
@@ -3424,6 +3434,241 @@ gfc_match_omp_parallel_workshare (void)
return match_omp (EXEC_OMP_PARALLEL_WORKSHARE, OMP_PARALLEL_CLAUSES);
}
+void
+gfc_check_omp_requires (gfc_namespace *ns)
+{
+ if (ns->omp_target_seen
+ && (ns->omp_requires & OMP_REQ_TARGET_MASK)
+ != (gfc_omp_requires & OMP_REQ_TARGET_MASK))
+ {
+ gcc_assert (ns->proc_name);
+ if ((gfc_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 ((gfc_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 ((gfc_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)
+{
+ /* All clauses are added both to the TU, i.e. gfc_omp_requires, and to the
+ current program-unit namespace, except that dynamic_allocators is only
+ needed at TU level and atomic_default_memory_order for program unit. */
+ 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 (gfc_omp_requires & OMP_REQ_ATOMIC_MEM_ORDER_SEQ_CST)
+ other = "seq_cst";
+ else if (gfc_omp_requires & OMP_REQ_ATOMIC_MEM_ORDER_ACQ_REL)
+ other = "acq_rel";
+ else if (gfc_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)
+ {
+ gfc_omp_requires |= clause;
+ 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;
+ }
+ /* TODO: Middle-end support exists, but not yet FE support. */
+ if (requires_clause == OMP_REQ_ATOMIC_MEM_ORDER_ACQ_REL)
+ gfc_error_now ("Sorry, only RELAXED and SEQ_CST are currently "
+ "supported for the ATOMIC_DEFAULT_MEM_ORDER clause "
+ "at %L on the REQUIRES directive", &old_loc);
+ }
+ 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 +3990,23 @@ 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
+ {
+ 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;
+ default:
+ gcc_unreachable ();
+ }
+ }
new_st.ext.omp_atomic = op;
return MATCH_YES;
}
diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
index 96fd4aaee5e..c298659f716 100644
--- a/gcc/fortran/parse.c
+++ b/gcc/fortran/parse.c
@@ -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,13 @@ done:
}
while (changed);
- /* Fixup for external procedures. */
+ /* Fixup for external procedures and resolve 'omp requires'. */
for (gfc_current_ns = gfc_global_ns_list; gfc_current_ns;
gfc_current_ns = gfc_current_ns->sibling)
- gfc_check_externals (gfc_current_ns);
+ {
+ gfc_check_externals (gfc_current_ns);
+ gfc_check_omp_requires (gfc_current_ns);
+ }
/* Do the parse tree dump. */
gfc_current_ns = flag_dump_fortran_original ? gfc_global_ns_list : NULL;
diff --git a/gcc/testsuite/gfortran.dg/gomp/requires-1.f90 b/gcc/testsuite/gfortran.dg/gomp/requires-1.f90
new file mode 100644
index 00000000000..b115a654e71
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/requires-1.f90
@@ -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" }
diff --git a/gcc/testsuite/gfortran.dg/gomp/requires-2.f90 b/gcc/testsuite/gfortran.dg/gomp/requires-2.f90
new file mode 100644
index 00000000000..c1184ff92c7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/requires-2.f90
@@ -0,0 +1,15 @@
+!$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 "only RELAXED and SEQ_CST are currently supported" }
+! { dg-prune-output "not yet supported" }
diff --git a/gcc/testsuite/gfortran.dg/gomp/requires-3.f90 b/gcc/testsuite/gfortran.dg/gomp/requires-3.f90
new file mode 100644
index 00000000000..4429aab2ee6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/requires-3.f90
@@ -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
diff --git a/gcc/testsuite/gfortran.dg/gomp/requires-4.f90 b/gcc/testsuite/gfortran.dg/gomp/requires-4.f90
new file mode 100644
index 00000000000..e0eb4dbc603
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/requires-4.f90
@@ -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" }
diff --git a/gcc/testsuite/gfortran.dg/gomp/requires-5.f90 b/gcc/testsuite/gfortran.dg/gomp/requires-5.f90
new file mode 100644
index 00000000000..199cb7f8163
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/requires-5.f90
@@ -0,0 +1,17 @@
+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 "only RELAXED and SEQ_CST are currently supported" }
+! { dg-prune-output "not yet supported" }
diff --git a/gcc/testsuite/gfortran.dg/gomp/requires-6.f90 b/gcc/testsuite/gfortran.dg/gomp/requires-6.f90
new file mode 100644
index 00000000000..f1237ab154f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/requires-6.f90
@@ -0,0 +1,17 @@
+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 "only RELAXED and SEQ_CST are currently supported" }
+! { dg-prune-output "not yet supported" }
diff --git a/gcc/testsuite/gfortran.dg/gomp/requires-7.f90 b/gcc/testsuite/gfortran.dg/gomp/requires-7.f90
new file mode 100644
index 00000000000..3d75b89e00b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/requires-7.f90
@@ -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" }
diff --git a/gcc/testsuite/gfortran.dg/gomp/requires-8.f90 b/gcc/testsuite/gfortran.dg/gomp/requires-8.f90
new file mode 100644
index 00000000000..3c32ae9860e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/requires-8.f90
@@ -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" }
diff --git a/gcc/testsuite/gfortran.dg/gomp/requires-9.f90 b/gcc/testsuite/gfortran.dg/gomp/requires-9.f90
new file mode 100644
index 00000000000..00c3ef1084c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/requires-9.f90
@@ -0,0 +1,59 @@
+! { 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
+
+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
+
+! { 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" } }
