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
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;
/* 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;
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
/* 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 *);
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);
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[] =
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)
};
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
{
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;
}
}
}
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)
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;
}
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);
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:
/* 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(). */
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;
}
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)
+ {
+ 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_externals (gfc_current_ns);
+ 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;
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);
--- /dev/null
+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" }
--- /dev/null
+!$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" }
--- /dev/null
+!$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
--- /dev/null
+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" }
--- /dev/null
+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" }
--- /dev/null
+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" }
--- /dev/null
+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" }
--- /dev/null
+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" }
--- /dev/null
+! { 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" } }
git://gcc.gnu.org / gcc.git / commitdiff