OpenMP 6 permits non-executable directives in intervening code; this commit adds
support for a sensible subset, namely metadirectives, nothing, assume, and
'error at(compilation)'.
Also handle the special case where a metadirective can be resolved at parse time
to 'omp nothing'.
This fixes a build issue that affects 10 out 12 SPECaccel benchmarks.
Co-authored by: Tobias Burnus <tburnus@baylibre.com>
PR c/120180
PR fortran/122306
gcc/c/ChangeLog:
* c-parser.cc (c_parser_pragma): Accept a subset of non-executable
OpenMP directives in intervening code.
(c_parser_omp_error): Reject 'error at(execution)' in intervening code.
(c_parser_omp_metadirective): Return early if only one selector matches
and it resolves to 'omp nothing'.
gcc/cp/ChangeLog:
* parser.cc (cp_parser_omp_metadirective): Return early if only one
selector matches and it resolves to 'omp nothing'.
(cp_parser_omp_error): Reject 'error at(execution)' in intervening code.
(cp_parser_pragma): Accept a subset of non-executable OpenMP directives
as intervening code.
gcc/fortran/ChangeLog:
* gfortran.h (enum gfc_exec_op): Add EXEC_OMP_FIRST_OPENMP_EXEC and
EXEC_OMP_LAST_OPENMP_EXEC.
* openmp.cc (gfc_match_omp_context_selector): Remove static. Remove
checks on score. Add cleanup. Remove checks on trait properties.
(gfc_match_omp_context_selector_specification): Remove static. Adjust
calls to gfc_match_omp_context_selector.
(gfc_match_omp_declare_variant): Adjust call to
gfc_match_omp_context_selector_specification.
(match_omp_metadirective): Likewise.
(icode_code_error_callback): Reject all statements except
'assume' and 'metadirective'.
(gfc_resolve_omp_context_selector): New function.
(resolve_omp_metadirective): Skip metadirectives which context selectors
can be statically resolved to false. Replace metadirective by its body
if only 'nothing' remains.
(gfc_resolve_omp_declare): Call gfc_resolve_omp_context_selector for
each variant.
gcc/testsuite/ChangeLog:
* c-c++-common/gomp/imperfect1.c: Adjust dg-error.
* c-c++-common/gomp/imperfect4.c: Likewise.
* c-c++-common/gomp/pr120180.c: Move to...
* c-c++-common/gomp/pr120180-1.c: ...here. Remove dg-error.
* g++.dg/gomp/attrs-imperfect1.C: Adjust dg-error.
* g++.dg/gomp/attrs-imperfect4.C: Likewise.
* gfortran.dg/gomp/declare-variant-2.f90: Adjust dg-error.
* gfortran.dg/gomp/declare-variant-20.f90: Likewise.
* c-c++-common/gomp/pr120180-2.c: New test.
* g++.dg/gomp/pr120180-1.C: New test.
* gfortran.dg/gomp/pr120180-1.f90: New test.
* gfortran.dg/gomp/pr120180-2.f90: New test.
* gfortran.dg/gomp/pr122306-1.f90: New file.
* gfortran.dg/gomp/pr122306-2.f90: New file.
gcc_assert (id != PRAGMA_NONE);
if (parser->omp_for_parse_state
&& parser->omp_for_parse_state->in_intervening_code
- && id >= PRAGMA_OMP__START_
- && id <= PRAGMA_OMP__LAST_)
- {
- error_at (input_location,
- "intervening code must not contain OpenMP directives");
+ && id >= PRAGMA_OMP__START_ && id <= PRAGMA_OMP__LAST_
+ /* Allow a safe subset of non-executable directives. See classification in
+ array c_omp_directives. */
+ && id != PRAGMA_OMP_METADIRECTIVE && id != PRAGMA_OMP_NOTHING
+ && id != PRAGMA_OMP_ASSUME && id != PRAGMA_OMP_ERROR)
+ {
+ error_at (
+ input_location,
+ "intervening code must not contain executable OpenMP directives");
parser->omp_for_parse_state->fail = true;
c_parser_skip_until_found (parser, CPP_PRAGMA_EOL, NULL);
return false;
"may only be used in compound statements");
return true;
}
+ if (parser->omp_for_parse_state
+ && parser->omp_for_parse_state->in_intervening_code)
+ {
+ error_at (loc, "%<#pragma omp error%> with %<at(execution)%> clause "
+ "may not be used in intervening code");
+ parser->omp_for_parse_state->fail = true;
+ return true;
+ }
tree fndecl
= builtin_decl_explicit (severity_fatal ? BUILT_IN_GOMP_ERROR
: BUILT_IN_GOMP_WARNING);
}
c_parser_skip_to_pragma_eol (parser);
+ /* If only one selector matches and it evaluates to 'omp nothing', no need to
+ proceed. */
+ if (ctxs.length () == 1)
+ {
+ tree ctx = ctxs[0];
+ if (ctx == NULL_TREE
+ || (omp_context_selector_matches (ctx, NULL_TREE, false) == 1
+ && directive_tokens[0].pragma_kind == PRAGMA_OMP_NOTHING))
+ return;
+ }
+
if (!default_seen)
{
/* Add a default clause that evaluates to 'omp nothing'. */
if (standalone_body == NULL_TREE)
{
standalone_body = push_stmt_list ();
- c_parser_statement (parser, if_p);
+ c_parser_statement (parser, if_p); // TODO skip this
standalone_body = pop_stmt_list (standalone_body);
}
else
}
cp_parser_skip_to_pragma_eol (parser, pragma_tok);
+ /* If only one selector matches and it evaluates to 'omp nothing', no need to
+ proceed. */
+ if (ctxs.length () == 1)
+ {
+ tree ctx = ctxs[0];
+ if (ctx == NULL_TREE
+ || (omp_context_selector_matches (ctx, NULL_TREE, false) == 1
+ && cp_parser_pragma_kind (&directive_tokens[0])
+ == PRAGMA_OMP_NOTHING))
+ return;
+ }
+
if (!default_seen)
{
/* Add a default clause that evaluates to 'omp nothing'. */
"may only be used in compound statements");
return true;
}
+ if (parser->omp_for_parse_state
+ && parser->omp_for_parse_state->in_intervening_code)
+ {
+ error_at (loc, "%<#pragma omp error%> with %<at(execution)%> clause "
+ "may not be used in intervening code");
+ parser->omp_for_parse_state->fail = true;
+ return true;
+ }
tree fndecl
= builtin_decl_explicit (severity_fatal ? BUILT_IN_GOMP_ERROR
: BUILT_IN_GOMP_WARNING);
id = cp_parser_pragma_kind (pragma_tok);
if (parser->omp_for_parse_state
&& parser->omp_for_parse_state->in_intervening_code
- && id >= PRAGMA_OMP__START_
- && id <= PRAGMA_OMP__LAST_)
- {
- error_at (pragma_tok->location,
- "intervening code must not contain OpenMP directives");
+ && id >= PRAGMA_OMP__START_ && id <= PRAGMA_OMP__LAST_
+ /* Allow a safe subset of non-executable directives. See classification in
+ array c_omp_directives. */
+ && id != PRAGMA_OMP_METADIRECTIVE && id != PRAGMA_OMP_NOTHING
+ && id != PRAGMA_OMP_ASSUME && id != PRAGMA_OMP_ERROR)
+ {
+ error_at (
+ pragma_tok->location,
+ "intervening code must not contain executable OpenMP directives");
parser->omp_for_parse_state->fail = true;
cp_parser_skip_to_pragma_eol (parser, pragma_tok);
return false;
EXEC_OACC_DATA, EXEC_OACC_HOST_DATA, EXEC_OACC_LOOP, EXEC_OACC_UPDATE,
EXEC_OACC_WAIT, EXEC_OACC_CACHE, EXEC_OACC_ENTER_DATA, EXEC_OACC_EXIT_DATA,
EXEC_OACC_ATOMIC, EXEC_OACC_DECLARE,
- EXEC_OMP_CRITICAL, EXEC_OMP_DO, EXEC_OMP_FLUSH, EXEC_OMP_MASTER,
+ EXEC_OMP_CRITICAL, EXEC_OMP_FIRST_OPENMP_EXEC = EXEC_OMP_CRITICAL,
+ EXEC_OMP_DO, EXEC_OMP_FLUSH, EXEC_OMP_MASTER,
EXEC_OMP_ORDERED, EXEC_OMP_PARALLEL, EXEC_OMP_PARALLEL_DO,
EXEC_OMP_PARALLEL_SECTIONS, EXEC_OMP_PARALLEL_WORKSHARE,
EXEC_OMP_SECTIONS, EXEC_OMP_SINGLE, EXEC_OMP_WORKSHARE,
EXEC_OMP_PARALLEL_MASKED_TASKLOOP, EXEC_OMP_PARALLEL_MASKED_TASKLOOP_SIMD,
EXEC_OMP_MASKED_TASKLOOP, EXEC_OMP_MASKED_TASKLOOP_SIMD, EXEC_OMP_SCOPE,
EXEC_OMP_UNROLL, EXEC_OMP_TILE, EXEC_OMP_INTEROP, EXEC_OMP_METADIRECTIVE,
- EXEC_OMP_ERROR, EXEC_OMP_ALLOCATE, EXEC_OMP_ALLOCATORS, EXEC_OMP_DISPATCH
+ EXEC_OMP_ERROR, EXEC_OMP_ALLOCATE, EXEC_OMP_ALLOCATORS, EXEC_OMP_DISPATCH,
+ EXEC_OMP_LAST_OPENMP_EXEC = EXEC_OMP_DISPATCH
};
/* Enum Definition for locality types. */
trait-score:
score(score-expression) */
-match
-gfc_match_omp_context_selector (gfc_omp_set_selector *oss,
- bool metadirective_p)
+static match
+gfc_match_omp_context_selector (gfc_omp_set_selector *oss)
{
do
{
gfc_error ("expected %<(%> at %C");
return MATCH_ERROR;
}
- if (gfc_match_expr (&os->score) != MATCH_YES
- || !gfc_resolve_expr (os->score)
- || os->score->ts.type != BT_INTEGER
- || os->score->rank != 0)
- {
- gfc_error ("%<score%> argument must be constant integer "
- "expression at %C");
- return MATCH_ERROR;
- }
-
- if (os->score->expr_type == EXPR_CONSTANT
- && mpz_sgn (os->score->value.integer) < 0)
- {
- gfc_error ("%<score%> argument must be non-negative at %C");
- return MATCH_ERROR;
- }
+ if (gfc_match_expr (&os->score) != MATCH_YES)
+ return MATCH_ERROR;
if (gfc_match (" )") != MATCH_YES)
{
else
{
gfc_error ("expected identifier at %C");
+ free (otp);
+ os->properties = nullptr;
return MATCH_ERROR;
}
}
{
gfc_error ("expected identifier or string literal "
"at %C");
+ free (otp);
+ os->properties = nullptr;
return MATCH_ERROR;
}
if (gfc_match_expr (&otp->expr) != MATCH_YES)
{
gfc_error ("expected expression at %C");
- return MATCH_ERROR;
- }
- if (!gfc_resolve_expr (otp->expr)
- || (property_kind == OMP_TRAIT_PROPERTY_BOOL_EXPR
- && otp->expr->ts.type != BT_LOGICAL)
- || (property_kind == OMP_TRAIT_PROPERTY_DEV_NUM_EXPR
- && otp->expr->ts.type != BT_INTEGER)
- || otp->expr->rank != 0
- || (!metadirective_p
- && otp->expr->expr_type != EXPR_CONSTANT))
- {
- if (metadirective_p)
- {
- if (property_kind == OMP_TRAIT_PROPERTY_BOOL_EXPR)
- gfc_error ("property must be a "
- "logical expression at %L",
- &otp->expr->where);
- else
- gfc_error ("property must be an "
- "integer expression at %L",
- &otp->expr->where);
- }
- else
- {
- if (property_kind == OMP_TRAIT_PROPERTY_BOOL_EXPR)
- gfc_error ("property must be a constant "
- "logical expression at %L",
- &otp->expr->where);
- else
- gfc_error ("property must be a constant "
- "integer expression at %L",
- &otp->expr->where);
- }
- return MATCH_ERROR;
- }
- /* Device number must be conforming, which includes
- omp_initial_device (-1) and omp_invalid_device (-4). */
- if (property_kind == OMP_TRAIT_PROPERTY_DEV_NUM_EXPR
- && otp->expr->expr_type == EXPR_CONSTANT
- && mpz_sgn (otp->expr->value.integer) < 0
- && mpz_cmp_si (otp->expr->value.integer, -1) != 0
- && mpz_cmp_si (otp->expr->value.integer, -4) != 0)
- {
- gfc_error ("property must be a conforming device number "
- "at %C");
+ free (otp);
+ os->properties = nullptr;
return MATCH_ERROR;
}
break;
implementation
user */
-match
-gfc_match_omp_context_selector_specification (gfc_omp_set_selector **oss_head,
- bool metadirective_p)
+static match
+gfc_match_omp_context_selector_specification (gfc_omp_set_selector **oss_head)
{
do
{
oss->code = set;
*oss_head = oss;
- if (gfc_match_omp_context_selector (oss, metadirective_p) != MATCH_YES)
+ if (gfc_match_omp_context_selector (oss) != MATCH_YES)
return MATCH_ERROR;
m = gfc_match (" }");
return MATCH_ERROR;
}
has_match = true;
- if (gfc_match_omp_context_selector_specification (&odv->set_selectors,
- false)
+ if (gfc_match_omp_context_selector_specification (&odv->set_selectors)
!= MATCH_YES)
return MATCH_ERROR;
if (gfc_match (" )") != MATCH_YES)
if (!default_p)
{
- if (gfc_match_omp_context_selector_specification (&selectors, true)
+ if (gfc_match_omp_context_selector_specification (&selectors)
!= MATCH_YES)
return MATCH_ERROR;
/* Errors have already been diagnosed in match_exit_cycle. */
state->errorp = true;
break;
- case EXEC_OMP_CRITICAL:
- case EXEC_OMP_DO:
- case EXEC_OMP_FLUSH:
- case EXEC_OMP_MASTER:
- case EXEC_OMP_ORDERED:
- case EXEC_OMP_PARALLEL:
- case EXEC_OMP_PARALLEL_DO:
- case EXEC_OMP_PARALLEL_SECTIONS:
- case EXEC_OMP_PARALLEL_WORKSHARE:
- case EXEC_OMP_SECTIONS:
- case EXEC_OMP_SINGLE:
- case EXEC_OMP_WORKSHARE:
- case EXEC_OMP_ATOMIC:
- case EXEC_OMP_BARRIER:
- case EXEC_OMP_END_NOWAIT:
- case EXEC_OMP_END_SINGLE:
- case EXEC_OMP_TASK:
- case EXEC_OMP_TASKWAIT:
- case EXEC_OMP_TASKYIELD:
- case EXEC_OMP_CANCEL:
- case EXEC_OMP_CANCELLATION_POINT:
- case EXEC_OMP_TASKGROUP:
- case EXEC_OMP_SIMD:
- case EXEC_OMP_DO_SIMD:
- case EXEC_OMP_PARALLEL_DO_SIMD:
- case EXEC_OMP_TARGET:
- case EXEC_OMP_TARGET_DATA:
- case EXEC_OMP_TEAMS:
- case EXEC_OMP_DISTRIBUTE:
- case EXEC_OMP_DISTRIBUTE_SIMD:
- case EXEC_OMP_DISTRIBUTE_PARALLEL_DO:
- case EXEC_OMP_DISTRIBUTE_PARALLEL_DO_SIMD:
- case EXEC_OMP_TARGET_TEAMS:
- case EXEC_OMP_TEAMS_DISTRIBUTE:
- case EXEC_OMP_TEAMS_DISTRIBUTE_SIMD:
- case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE:
- case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD:
- case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO:
- case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO:
- case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
- case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
- case EXEC_OMP_TARGET_UPDATE:
- case EXEC_OMP_END_CRITICAL:
- case EXEC_OMP_TARGET_ENTER_DATA:
- case EXEC_OMP_TARGET_EXIT_DATA:
- case EXEC_OMP_TARGET_PARALLEL:
- case EXEC_OMP_TARGET_PARALLEL_DO:
- case EXEC_OMP_TARGET_PARALLEL_DO_SIMD:
- case EXEC_OMP_TARGET_SIMD:
- case EXEC_OMP_TASKLOOP:
- case EXEC_OMP_TASKLOOP_SIMD:
- case EXEC_OMP_SCAN:
- case EXEC_OMP_DEPOBJ:
- case EXEC_OMP_PARALLEL_MASTER:
- case EXEC_OMP_PARALLEL_MASTER_TASKLOOP:
- case EXEC_OMP_PARALLEL_MASTER_TASKLOOP_SIMD:
- case EXEC_OMP_MASTER_TASKLOOP:
- case EXEC_OMP_MASTER_TASKLOOP_SIMD:
- case EXEC_OMP_LOOP:
- case EXEC_OMP_PARALLEL_LOOP:
- case EXEC_OMP_TEAMS_LOOP:
- case EXEC_OMP_TARGET_PARALLEL_LOOP:
- case EXEC_OMP_TARGET_TEAMS_LOOP:
- case EXEC_OMP_MASKED:
- case EXEC_OMP_PARALLEL_MASKED:
- case EXEC_OMP_PARALLEL_MASKED_TASKLOOP:
- case EXEC_OMP_PARALLEL_MASKED_TASKLOOP_SIMD:
- case EXEC_OMP_MASKED_TASKLOOP:
- case EXEC_OMP_MASKED_TASKLOOP_SIMD:
- case EXEC_OMP_SCOPE:
- case EXEC_OMP_ERROR:
- case EXEC_OMP_DISPATCH:
- gfc_error ("%s cannot contain OpenMP directive in intervening code "
- "at %L",
- state->name, &code->loc);
- state->errorp = true;
+ case EXEC_OMP_ASSUME:
+ case EXEC_OMP_METADIRECTIVE:
+ /* Per OpenMP 6.0, some non-executable directives are allowed in
+ intervening code. */
break;
case EXEC_CALL:
/* Per OpenMP 5.2, the "omp_" prefix is reserved, so we don't have to
}
break;
default:
- break;
+ if (code->op >= EXEC_OMP_FIRST_OPENMP_EXEC
+ && code->op <= EXEC_OMP_LAST_OPENMP_EXEC)
+ {
+ gfc_error ("%s cannot contain OpenMP directive in intervening code "
+ "at %L",
+ state->name, &code->loc);
+ state->errorp = true;
+ }
}
return 0;
}
non_generated_count);
}
+/* Resolve the context selector. In particular, SKIP_P is set to true,
+ the context can never be matched. */
+
+static void
+gfc_resolve_omp_context_selector (gfc_omp_set_selector *oss,
+ bool is_metadirective, bool *skip_p)
+{
+ if (skip_p)
+ *skip_p = false;
+ for (gfc_omp_set_selector *set_selector = oss; set_selector;
+ set_selector = set_selector->next)
+ for (gfc_omp_selector *os = set_selector->trait_selectors; os; os = os->next)
+ {
+ if (os->score)
+ {
+ if (!gfc_resolve_expr (os->score)
+ || os->score->ts.type != BT_INTEGER
+ || os->score->rank != 0)
+ {
+ gfc_error ("%<score%> argument must be constant integer "
+ "expression at %L", &os->score->where);
+ gfc_free_expr (os->score);
+ os->score = nullptr;
+ }
+ else if (os->score->expr_type == EXPR_CONSTANT
+ && mpz_sgn (os->score->value.integer) < 0)
+ {
+ gfc_error ("%<score%> argument must be non-negative at %L",
+ &os->score->where);
+ gfc_free_expr (os->score);
+ os->score = nullptr;
+ }
+ }
+
+ enum omp_tp_type property_kind = omp_ts_map[os->code].tp_type;
+ gfc_omp_trait_property *otp = os->properties;
+
+ if (!otp)
+ continue;
+ switch (property_kind)
+ {
+ case OMP_TRAIT_PROPERTY_DEV_NUM_EXPR:
+ case OMP_TRAIT_PROPERTY_BOOL_EXPR:
+ if (!gfc_resolve_expr (otp->expr)
+ || (property_kind == OMP_TRAIT_PROPERTY_BOOL_EXPR
+ && otp->expr->ts.type != BT_LOGICAL)
+ || (property_kind == OMP_TRAIT_PROPERTY_DEV_NUM_EXPR
+ && otp->expr->ts.type != BT_INTEGER)
+ || otp->expr->rank != 0
+ || (!is_metadirective && otp->expr->expr_type != EXPR_CONSTANT))
+ {
+ if (is_metadirective)
+ {
+ if (property_kind == OMP_TRAIT_PROPERTY_BOOL_EXPR)
+ gfc_error ("property must be a "
+ "logical expression at %L",
+ &otp->expr->where);
+ else
+ gfc_error ("property must be an "
+ "integer expression at %L",
+ &otp->expr->where);
+ }
+ else
+ {
+ if (property_kind == OMP_TRAIT_PROPERTY_BOOL_EXPR)
+ gfc_error ("property must be a constant "
+ "logical expression at %L",
+ &otp->expr->where);
+ else
+ gfc_error ("property must be a constant "
+ "integer expression at %L",
+ &otp->expr->where);
+ }
+ /* Prevent later ICEs. */
+ gfc_expr *e;
+ if (property_kind == OMP_TRAIT_PROPERTY_BOOL_EXPR)
+ e = gfc_get_logical_expr (gfc_default_logical_kind,
+ &otp->expr->where, true);
+ else
+ e = gfc_get_int_expr (gfc_default_integer_kind,
+ &otp->expr->where, 0);
+ gfc_free_expr (otp->expr);
+ otp->expr = e;
+ continue;
+ }
+ /* Device number must be conforming, which includes
+ omp_initial_device (-1) and omp_invalid_device (-4). */
+ if (property_kind == OMP_TRAIT_PROPERTY_DEV_NUM_EXPR
+ && otp->expr->expr_type == EXPR_CONSTANT
+ && mpz_sgn (otp->expr->value.integer) < 0
+ && mpz_cmp_si (otp->expr->value.integer, -1) != 0
+ && mpz_cmp_si (otp->expr->value.integer, -4) != 0)
+ gfc_error ("property must be a conforming device number at %L",
+ &otp->expr->where);
+ break;
+ default:
+ break;
+ }
+ /* This only handles one specific case: User condition.
+ FIXME: Handle more cases by calling omp_context_selector_matches;
+ unfortunately, we cannot generate the tree here as, e.g., PARM_DECL
+ backend decl are not available at this stage - but might be used in,
+ e.g. user conditions. See PR122361. */
+ if (skip_p && otp
+ && os->code == OMP_TRAIT_USER_CONDITION
+ && otp->expr->expr_type == EXPR_CONSTANT
+ && otp->expr->value.logical == false)
+ *skip_p = true;
+ }
+}
+
+
static void
resolve_omp_metadirective (gfc_code *code, gfc_namespace *ns)
{
while (variant)
{
+ bool skip;
+ gfc_resolve_omp_context_selector (variant->selectors, true, &skip);
gfc_code *variant_code = variant->code;
gfc_resolve_code (variant_code, ns);
- variant = variant->next;
+ if (skip)
+ {
+ /* The following should only be true if an error occurred
+ as the 'otherwise' clause should always match. */
+ if (variant == code->ext.omp_variants && !variant->next)
+ break;
+ if (variant == code->ext.omp_variants)
+ code->ext.omp_variants = variant->next;
+ gfc_omp_variant *tmp = variant;
+ variant = variant->next;
+ gfc_free_omp_set_selector_list (tmp->selectors);
+ free (tmp);
+ }
+ else
+ variant = variant->next;
+ }
+ /* Replace metadirective by its body if only 'nothing' remains. */
+ if (!code->ext.omp_variants->next && code->ext.omp_variants->stmt == ST_NONE)
+ {
+ gfc_code *next = code->next;
+ gfc_code *inner = code->ext.omp_variants->code;
+ gfc_free_omp_set_selector_list (code->ext.omp_variants->selectors);
+ free (code->ext.omp_variants);
+ *code = *inner;
+ free (inner);
+ while (code->next)
+ code = code->next;
+ code->next = next;
}
}
gfc_omp_declare_variant *odv;
gfc_omp_namelist *range_begin = NULL;
+
+ for (odv = ns->omp_declare_variant; odv; odv = odv->next)
+ gfc_resolve_omp_context_selector (odv->set_selectors, false, nullptr);
for (odv = ns->omp_declare_variant; odv; odv = odv->next)
for (gfc_omp_namelist *n = odv->adjust_args_list; n != NULL; n = n->next)
{
f1 (0, i);
for (j = 0; j < a2; j++)
{
-#pragma omp barrier /* { dg-error "intervening code must not contain OpenMP directives" } */
+#pragma omp barrier /* { dg-error "intervening code must not contain executable OpenMP directives" } */
f1 (1, j);
if (i == 2)
continue; /* { dg-error "invalid exit" } */
/* According to the grammar, this is intervening code; we
don't know that we are also missing a nested for loop
until we have parsed this whole compound expression. */
-#pragma omp barrier /* { dg-error "intervening code must not contain OpenMP directives" } */
+#pragma omp barrier /* { dg-error "intervening code must not contain executable OpenMP directives" } */
f1 (2, k);
f2 (2, k);
}
/* { dg-do compile } */
-/* This test used to ICE after erroring on the metadirective in the
- loop nest. */
+/* This test case checks that the inner metadirective is accepted as intervening
+ code since it resolves to 'omp nothing'. */
int main()
{
when(user={condition(1)}: target teams loop collapse(2) map(qq[:0]) private(i))
for(k=0; k<blksize; k++)
{
-#pragma omp metadirective when(user={condition(0)}: simd) default() // { dg-error "intervening code must not contain OpenMP directives" }
+#pragma omp metadirective when(user={condition(0)}: simd) default()
for (i=0; i<nq; i++)
qq[k*nq + i] = 0.0;
}
--- /dev/null
+/* { dg-do compile } */
+
+/* This test case checks that a non-executable OpenMP directive is accepted
+ as intervening code. */
+
+int
+test1 ()
+{
+ int blksize = 15000;
+ double *qq;
+ int i, k, nq;
+#pragma omp target parallel for collapse(2) map(qq[ : 0]) private(i)
+ for (k = 0; k < blksize; k++)
+ {
+#pragma omp nothing
+ for (i = 0; i < nq; i++)
+ qq[k * nq + i] = 0.0;
+ }
+ return 0;
+}
+
+int
+test2 ()
+{
+ int i, k, m, n;
+ double *qq, x, z;
+#pragma omp for collapse(2)
+ for (i = 1; i < n; i++)
+ {
+#pragma omp assume holds(x > 1)
+ z = __builtin_fabs (x - i);
+ for (k = 0; k < m; k++)
+ qq[k * m + i] = z;
+ }
+ return 0;
+}
+
+int
+test3 ()
+{
+ int i, k, m, n;
+ double *qq, z;
+#pragma omp for collapse(2)
+ for (i = 1; i < n; i++)
+ {
+#pragma omp error at(compilation) /* { dg-error "'pragma omp error' encountered" } */
+ for (k = 0; k < m; k++)
+ qq[k * m + i] = z;
+ }
+ return 0;
+}
+
+int
+test4 ()
+{
+ int i, k, m, n;
+ double *qq, z;
+#pragma omp for collapse(2)
+ for (i = 1; i < n; i++)
+ {
+#pragma omp error at(execution) /* { dg-error "pragma omp error' with 'at\\(execution\\)' clause may not be used in intervening code" } */
+ for (k = 0; k < m; k++)
+ qq[k * m + i] = z;
+ }
+ return 0;
+}
f1 (0, i);
for (j = 0; j < a2; j++)
{
- [[ omp :: directive (barrier) ]] ; /* { dg-error "intervening code must not contain OpenMP directives" } */
+ [[ omp :: directive (barrier) ]] ; /* { dg-error "intervening code must not contain executable OpenMP directives" } */
f1 (1, j);
if (i == 2)
continue; /* { dg-error "invalid exit" } */
/* According to the grammar, this is intervening code; we
don't know that we are also missing a nested for loop
until we have parsed this whole compound expression. */
- [[ omp :: directive (barrier) ]] ; /* { dg-error "intervening code must not contain OpenMP directives" } */
+ [[ omp :: directive (barrier) ]] ; /* { dg-error "intervening code must not contain executable OpenMP directives" } */
f1 (2, k);
f2 (2, k);
}
--- /dev/null
+// { dg-do compile }
+// { dg-additional-options "-std=c++11" }
+
+// This test case checks that the inner metadirective is accepted as intervening
+// code since it resolves to 'omp nothing'.
+
+int main()
+{
+ constexpr int use_teams = 1;
+ constexpr int use_simd = 0;
+
+ int blksize = 15000;
+ double *qq;
+ int i, k, nq;
+
+ #pragma omp metadirective when(user={condition(use_teams)}: teams distribute parallel for collapse(2)) \
+ otherwise(parallel for collapse(1))
+ for(k=0; k<blksize; k++)
+ {
+ #pragma omp metadirective when(user={condition(use_simd)}: simd) \
+ otherwise(nothing)
+ for (i=0; i<nq; i++)
+ qq[k*nq + i] = 0.0;
+ }
+ return 0;
+}
!$omp declare variant (f1) match(implementation={atomic_default_mem_order("relaxed")}) ! { dg-error "expected identifier at .1." }
end subroutine
subroutine f77 ()
- !$omp declare variant (f1) match(user={condition(score(f76):.true.)}) ! { dg-error ".score. argument must be constant integer expression at .1." }
+ !$omp declare variant (f1) match(user={condition(score(f76):.true.)}) ! { dg-error "Unexpected use of subroutine name 'f76'" }
end subroutine
subroutine f78 ()
!$omp declare variant (f1) match(user={condition(score(-130):.true.)}) ! { dg-error ".score. argument must be non-negative" }
!$omp declare variant(variant5) match(target_device={device_num(-4)}) ! OK - omp_invalid_device (will never match)
! OK - but not handled -> PR middle-end/113904
!$omp declare variant(variant5) match(target_device={device_num(my_device)}) ! { dg-error "property must be a constant integer expression" }
+ ! { dg-error "Symbol 'my_device' at .1. has no IMPLICIT type" "" { target *-*-* } .-1 }
!$omp declare variant(variant5) match(target_device={device_num(-2)}) ! { dg-error "property must be a conforming device number" }
res = 99
--- /dev/null
+! { dg-do compile }
+
+! This test case checks that the inner metadirective is accepted as intervening
+! code since it resolves to 'omp nothing'.
+
+SUBROUTINE test1(x_min, x_max, y_min, y_max, xarea, vol_flux_x)
+
+ IMPLICIT NONE
+
+ INTEGER, INTENT(IN) :: x_min, x_max, y_min, y_max
+
+ REAL(KIND=8), DIMENSION(x_min:x_max,y_min:y_max) :: xarea
+ REAL(KIND=8), DIMENSION(x_min:x_max,y_min:y_max) :: vol_flux_x
+
+ INTEGER :: j,k
+
+ !$omp metadirective &
+ !$omp when(user={condition(.false.)}: &
+ !$omp target teams distribute parallel do simd collapse(2)) &
+ !$omp when(user={condition(.false.)}: &
+ !$omp target teams distribute parallel do) &
+ !$omp default( &
+ !$omp target teams loop collapse(2))
+ DO k=y_min,y_max
+ !$omp metadirective when(user={condition(.false.)}: simd)
+ DO j=x_min,x_max
+ vol_flux_x(j,k)=0.25_8*xarea(j,k)
+ ENDDO
+ ENDDO
+
+END SUBROUTINE test1
--- /dev/null
+! { dg-do compile }
+
+! This test case checks that a non-executable OpenMP directive is accepted
+! as intervening code.
+
+SUBROUTINE test1(x_min, x_max, y_min, y_max, xarea, vol_flux_x)
+
+ IMPLICIT NONE
+
+ INTEGER, INTENT(IN) :: x_min, x_max, y_min, y_max
+
+ REAL(KIND=8), DIMENSION(x_min:x_max,y_min:y_max) :: xarea
+ REAL(KIND=8), DIMENSION(x_min:x_max,y_min:y_max) :: vol_flux_x
+
+ INTEGER :: j,k
+
+ !$omp do collapse(2)
+ DO k=y_min,y_max
+ !$omp nothing
+ DO j=x_min,x_max
+ vol_flux_x(j,k)=0.25_8*xarea(j,k)
+ ENDDO
+ ENDDO
+
+END SUBROUTINE test1
+
+SUBROUTINE test2(x_min, x_max, y_min, y_max, x, z, vol_flux_x)
+
+ IMPLICIT NONE
+
+ INTEGER, INTENT(IN) :: x_min, x_max, y_min, y_max
+
+ REAL(KIND=8) :: x, z
+ REAL(KIND=8), DIMENSION(x_min:x_max,y_min:y_max) :: vol_flux_x
+
+ INTEGER :: j,k
+
+ !$omp do collapse(2)
+ DO k=y_min,y_max
+ !$omp assume holds(x>1)
+ z = abs(x-1)
+ !$omp end assume
+ DO j=x_min,x_max
+ vol_flux_x(j,k)=0.25_8*z
+ ENDDO
+ ENDDO
+
+END SUBROUTINE test2
+
+SUBROUTINE test3(x_min, x_max, y_min, y_max, z, vol_flux_x)
+
+ IMPLICIT NONE
+
+ INTEGER, INTENT(IN) :: x_min, x_max, y_min, y_max
+
+ REAL(KIND=8) :: z
+ REAL(KIND=8), DIMENSION(x_min:x_max,y_min:y_max) :: vol_flux_x
+
+ INTEGER :: j,k
+
+ !$omp do collapse(2)
+ DO k=y_min,y_max
+ !$omp error at(compilation) ! { dg-error "OMP ERROR encountered at" }
+ DO j=x_min,x_max
+ vol_flux_x(j,k)=0.25_8*z
+ ENDDO
+ ENDDO
+
+END SUBROUTINE test3
+
+SUBROUTINE test4(x_min, x_max, y_min, y_max, z, vol_flux_x)
+
+ IMPLICIT NONE
+
+ INTEGER, INTENT(IN) :: x_min, x_max, y_min, y_max
+
+ REAL(KIND=8) :: z
+ REAL(KIND=8), DIMENSION(x_min:x_max,y_min:y_max) :: vol_flux_x
+
+ INTEGER :: j,k
+
+ !$omp do collapse(2)
+ DO k=y_min,y_max
+ !$omp error at(execution) ! { dg-error "OMP DO cannot contain OpenMP directive in intervening code" }
+ DO j=x_min,x_max
+ vol_flux_x(j,k)=0.25_8*z
+ ENDDO
+ ENDDO
+
+END SUBROUTINE test4
--- /dev/null
+! { dg-do compile }
+
+! This test case checks that a function call in a context selector is accepted.
+
+module m
+ implicit none (type, external)
+contains
+ integer function f(n)
+ integer :: i, n
+ f = 0
+ !$omp metadirective &
+ !$omp& when(user={condition(use_target())}: target parallel do map(f) reduction(+:f)) &
+ !$omp& otherwise(parallel do reduction(+:f))
+ do i = 1, n
+ f = f + 1
+ end do
+ end
+ logical function use_target()
+ use_target = .false.
+ end
+end
--- /dev/null
+! { dg-do compile }
+
+! This test case checks that various user-condition context selectors correctly
+! parsed and resolved.
+
+SUBROUTINE test1(x_min, x_max, vol_flux_x)
+ IMPLICIT NONE
+ INTEGER, INTENT(IN) :: x_min, x_max
+ REAL(KIND=8), DIMENSION(x_min:x_max) :: vol_flux_x
+ integer, parameter :: one = 1
+ INTEGER :: j
+
+ !$omp begin metadirective when(user={condition(one < 0)}: parallel)
+ DO j=x_min,x_max
+ vol_flux_x(j)=0.25_8
+ ENDDO
+ !$omp end metadirective
+END SUBROUTINE test1
+
+SUBROUTINE test2(x_min, x_max, vol_flux_x, flag)
+ IMPLICIT NONE
+ INTEGER, INTENT(IN) :: x_min, x_max
+ REAL(KIND=8), DIMENSION(x_min:x_max) :: vol_flux_x
+ LOGICAL :: flag
+ INTEGER :: j
+
+ !$omp begin metadirective when(user={condition(flag)}: parallel)
+ DO j=x_min,x_max
+ vol_flux_x(j)=0.25_8
+ ENDDO
+ !$omp end metadirective
+END SUBROUTINE test2
+
projects / thirdparty / gcc.git / commitdiff
