On 20/10/2025 17:28, Tobias Burnus wrote:
Paul-Antoine Arras wrote:
In summary:
- Make clear in the changelog that this is about non-executable
directives not (only) about 'nothing' (even if only a subset
is handled).
Reworded accordingly.
Namely,
As permitted by OpenMP 6, accept a subset of non-executable directives
-- namely
'metadirective', 'nothing', 'assume' and 'error at(compilation)' -- in
intervening code.
I think it would be helpful to make the distinction between
the spec and what is implemented, e.g.
"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)'."
Used the suggested wording verbatim.
* * *
Actually, when writing this I used on purpose the wording
'metadirectives' - because there is also
begin metadirective ... end metadirective
Thus, I ended up trying it.
For C/C++, I think it is not implemented - it only makes sense with
those directives that take an end directive and those are all of
declarative nature - hence, we excluded it, even if one can construct
mildly sensible cases.
However, for Fortran it is - unsurprisingly, as it has tons of
end directives.
* * *
I was suggesting that you try it + add a testcase, but I am running
into the issue that for '.false.' the 'end metadirective' is no
longer parsed → https://gcc.gnu.org/PR122306 (comment 2)
However, this seems to be unrelated to your patch. Hence,
no action is required on your side.
As discussed off-list, this was actually caused by the previous
iteration of the patch. The attached revision includes a fix contributed
by Tobias.
* * *
[...]
* * *
+ /* If only one selector matches and it evaluates to 'omp nothing',
no need to
+ * proceed. */
GCC does not seem to use this comment style in any file.
Namely, there is no '* ' at the beginning of consecutive comment lines.
Can you fix it?
Fixed. (For some reason, clang-format insists on formatting it like that...)
* * *
+++ b/gcc/c/c-parser.cc
[…]
+ && id >= PRAGMA_OMP__START_ && id <= PRAGMA_OMP__LAST_
+ /* Allow a safe subset of non-executable directives. See
classification in
+ array c_omp_directives. */
and
+ case EXEC_OMP_ASSUME:
+ case EXEC_OMP_METADIRECTIVE:
+ /* Per OpenMP 6.0, some non-executable directives are allowed in
+ * intervening code. */
You could also cross ref to the gfc_omp_directives array for symmetry.
Added cross-ref as suggested.
* * *
With the nits fixed: LGTM.
Tobias
PS: For Fortran, we really should fix PR122306 - the way we handle it
currently is ugly in multiple ways and, as shown, breaks in some cases.
But that's largely unrelated to your modifications.
The attached patch now fixes both PR120180 and PR122306.
See PR122361 for additional cases of context selectors that could be
resolved earlier.
Thanks,
--
PA
From d3174eb247da741e253d5b63f282cb796555df3c Mon Sep 17 00:00:00 2001
From: Paul-Antoine Arras <[email protected]>
Date: Thu, 16 Oct 2025 17:22:08 +0100
Subject: [PATCH] OpenMP: Handle non-executable directives in intervening code
[PR120180,PR122306]
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 <[email protected]>
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/c/c-parser.cc | 33 +-
gcc/cp/parser.cc | 32 +-
gcc/fortran/gfortran.h | 6 +-
gcc/fortran/openmp.cc | 321 ++++++++++--------
gcc/testsuite/c-c++-common/gomp/imperfect1.c | 2 +-
gcc/testsuite/c-c++-common/gomp/imperfect4.c | 2 +-
.../gomp/{pr120180.c => pr120180-1.c} | 6 +-
gcc/testsuite/c-c++-common/gomp/pr120180-2.c | 66 ++++
gcc/testsuite/g++.dg/gomp/attrs-imperfect1.C | 2 +-
gcc/testsuite/g++.dg/gomp/attrs-imperfect4.C | 2 +-
gcc/testsuite/g++.dg/gomp/pr120180-1.C | 26 ++
.../gfortran.dg/gomp/declare-variant-2.f90 | 2 +-
.../gfortran.dg/gomp/declare-variant-20.f90 | 1 +
gcc/testsuite/gfortran.dg/gomp/pr120180-1.f90 | 31 ++
gcc/testsuite/gfortran.dg/gomp/pr120180-2.f90 | 90 +++++
gcc/testsuite/gfortran.dg/gomp/pr122306-1.f90 | 21 ++
gcc/testsuite/gfortran.dg/gomp/pr122306-2.f90 | 33 ++
17 files changed, 508 insertions(+), 168 deletions(-)
rename gcc/testsuite/c-c++-common/gomp/{pr120180.c => pr120180-1.c} (79%)
create mode 100644 gcc/testsuite/c-c++-common/gomp/pr120180-2.c
create mode 100644 gcc/testsuite/g++.dg/gomp/pr120180-1.C
create mode 100644 gcc/testsuite/gfortran.dg/gomp/pr120180-1.f90
create mode 100644 gcc/testsuite/gfortran.dg/gomp/pr120180-2.f90
create mode 100644 gcc/testsuite/gfortran.dg/gomp/pr122306-1.f90
create mode 100644 gcc/testsuite/gfortran.dg/gomp/pr122306-2.f90
diff --git a/gcc/c/c-parser.cc b/gcc/c/c-parser.cc
index 7c2452644bd..776458d5129 100644
--- a/gcc/c/c-parser.cc
+++ b/gcc/c/c-parser.cc
@@ -15761,11 +15761,15 @@ c_parser_pragma (c_parser *parser, enum pragma_context context, bool *if_p,
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_)
+ && 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 OpenMP directives");
+ 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;
@@ -29308,6 +29312,14 @@ c_parser_omp_error (c_parser *parser, enum pragma_context context)
"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);
@@ -29837,6 +29849,17 @@ c_parser_omp_metadirective (c_parser *parser, bool *if_p)
}
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'. */
@@ -29917,7 +29940,7 @@ c_parser_omp_metadirective (c_parser *parser, bool *if_p)
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
diff --git a/gcc/cp/parser.cc b/gcc/cp/parser.cc
index 362cddbaf69..4643b891756 100644
--- a/gcc/cp/parser.cc
+++ b/gcc/cp/parser.cc
@@ -52609,6 +52609,18 @@ cp_parser_omp_metadirective (cp_parser *parser, cp_token *pragma_tok,
}
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'. */
@@ -53721,6 +53733,14 @@ cp_parser_omp_error (cp_parser *parser, cp_token *pragma_tok,
"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);
@@ -54638,11 +54658,15 @@ cp_parser_pragma (cp_parser *parser, enum pragma_context context, bool *if_p)
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_)
+ && 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 OpenMP directives");
+ 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;
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 219c4b67ed8..9712ae915cc 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -3161,7 +3161,8 @@ enum gfc_exec_op
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,
@@ -3192,7 +3193,8 @@ enum gfc_exec_op
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. */
diff --git a/gcc/fortran/openmp.cc b/gcc/fortran/openmp.cc
index 9e282c7b9f1..72348657f1b 100644
--- a/gcc/fortran/openmp.cc
+++ b/gcc/fortran/openmp.cc
@@ -6306,9 +6306,8 @@ gfc_match_omp_interop (void)
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
{
@@ -6372,22 +6371,8 @@ gfc_match_omp_context_selector (gfc_omp_set_selector *oss,
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)
{
@@ -6420,6 +6405,8 @@ gfc_match_omp_context_selector (gfc_omp_set_selector *oss,
else
{
gfc_error ("expected identifier at %C");
+ free (otp);
+ os->properties = nullptr;
return MATCH_ERROR;
}
}
@@ -6440,6 +6427,8 @@ gfc_match_omp_context_selector (gfc_omp_set_selector *oss,
{
gfc_error ("expected identifier or string literal "
"at %C");
+ free (otp);
+ os->properties = nullptr;
return MATCH_ERROR;
}
@@ -6460,51 +6449,8 @@ gfc_match_omp_context_selector (gfc_omp_set_selector *oss,
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;
@@ -6580,9 +6526,8 @@ gfc_match_omp_context_selector (gfc_omp_set_selector *oss,
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
{
@@ -6619,7 +6564,7 @@ gfc_match_omp_context_selector_specification (gfc_omp_set_selector **oss_head,
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 (" }");
@@ -6750,8 +6695,7 @@ gfc_match_omp_declare_variant (void)
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)
@@ -7042,7 +6986,7 @@ match_omp_metadirective (bool begin_p)
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;
@@ -11418,82 +11362,10 @@ icode_code_error_callback (gfc_code **codep,
/* 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
@@ -11509,7 +11381,14 @@ icode_code_error_callback (gfc_code **codep,
}
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;
}
@@ -12312,6 +12191,118 @@ resolve_omp_do (gfc_code *code)
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)
{
@@ -12319,9 +12310,38 @@ 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;
}
}
@@ -13098,6 +13118,9 @@ gfc_resolve_omp_declare (gfc_namespace *ns)
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)
{
diff --git a/gcc/testsuite/c-c++-common/gomp/imperfect1.c b/gcc/testsuite/c-c++-common/gomp/imperfect1.c
index 705626ad169..bef783bb907 100644
--- a/gcc/testsuite/c-c++-common/gomp/imperfect1.c
+++ b/gcc/testsuite/c-c++-common/gomp/imperfect1.c
@@ -15,7 +15,7 @@ void s1 (int a1, int a2, int a3)
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" } */
diff --git a/gcc/testsuite/c-c++-common/gomp/imperfect4.c b/gcc/testsuite/c-c++-common/gomp/imperfect4.c
index 1a0c07cd48e..30d1cc66235 100644
--- a/gcc/testsuite/c-c++-common/gomp/imperfect4.c
+++ b/gcc/testsuite/c-c++-common/gomp/imperfect4.c
@@ -21,7 +21,7 @@ void s1 (int a1, int a2, int a3)
/* 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);
}
diff --git a/gcc/testsuite/c-c++-common/gomp/pr120180.c b/gcc/testsuite/c-c++-common/gomp/pr120180-1.c
similarity index 79%
rename from gcc/testsuite/c-c++-common/gomp/pr120180.c
rename to gcc/testsuite/c-c++-common/gomp/pr120180-1.c
index cb5a0d5a819..52b5082b4e7 100644
--- a/gcc/testsuite/c-c++-common/gomp/pr120180.c
+++ b/gcc/testsuite/c-c++-common/gomp/pr120180-1.c
@@ -1,7 +1,7 @@
/* { 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()
{
@@ -14,7 +14,7 @@ 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;
}
diff --git a/gcc/testsuite/c-c++-common/gomp/pr120180-2.c b/gcc/testsuite/c-c++-common/gomp/pr120180-2.c
new file mode 100644
index 00000000000..9d9ef3044bd
--- /dev/null
+++ b/gcc/testsuite/c-c++-common/gomp/pr120180-2.c
@@ -0,0 +1,66 @@
+/* { 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;
+}
diff --git a/gcc/testsuite/g++.dg/gomp/attrs-imperfect1.C b/gcc/testsuite/g++.dg/gomp/attrs-imperfect1.C
index cf293b5081c..b43139c8968 100644
--- a/gcc/testsuite/g++.dg/gomp/attrs-imperfect1.C
+++ b/gcc/testsuite/g++.dg/gomp/attrs-imperfect1.C
@@ -15,7 +15,7 @@ void s1 (int a1, int a2, int a3)
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" } */
diff --git a/gcc/testsuite/g++.dg/gomp/attrs-imperfect4.C b/gcc/testsuite/g++.dg/gomp/attrs-imperfect4.C
index 16636ab3eb6..94b4db856a9 100644
--- a/gcc/testsuite/g++.dg/gomp/attrs-imperfect4.C
+++ b/gcc/testsuite/g++.dg/gomp/attrs-imperfect4.C
@@ -21,7 +21,7 @@ void s1 (int a1, int a2, int a3)
/* 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);
}
diff --git a/gcc/testsuite/g++.dg/gomp/pr120180-1.C b/gcc/testsuite/g++.dg/gomp/pr120180-1.C
new file mode 100644
index 00000000000..819b3ee9045
--- /dev/null
+++ b/gcc/testsuite/g++.dg/gomp/pr120180-1.C
@@ -0,0 +1,26 @@
+// { 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;
+}
diff --git a/gcc/testsuite/gfortran.dg/gomp/declare-variant-2.f90 b/gcc/testsuite/gfortran.dg/gomp/declare-variant-2.f90
index 11be76e84ff..02bd86236aa 100644
--- a/gcc/testsuite/gfortran.dg/gomp/declare-variant-2.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/declare-variant-2.f90
@@ -195,7 +195,7 @@ contains
!$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" }
diff --git a/gcc/testsuite/gfortran.dg/gomp/declare-variant-20.f90 b/gcc/testsuite/gfortran.dg/gomp/declare-variant-20.f90
index 17fdcb7e8bc..82b8a52ac06 100644
--- a/gcc/testsuite/gfortran.dg/gomp/declare-variant-20.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/declare-variant-20.f90
@@ -44,6 +44,7 @@ contains
!$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
diff --git a/gcc/testsuite/gfortran.dg/gomp/pr120180-1.f90 b/gcc/testsuite/gfortran.dg/gomp/pr120180-1.f90
new file mode 100644
index 00000000000..f16a256f6c6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/pr120180-1.f90
@@ -0,0 +1,31 @@
+! { 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
diff --git a/gcc/testsuite/gfortran.dg/gomp/pr120180-2.f90 b/gcc/testsuite/gfortran.dg/gomp/pr120180-2.f90
new file mode 100644
index 00000000000..ea90ad68e99
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/pr120180-2.f90
@@ -0,0 +1,90 @@
+! { 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
diff --git a/gcc/testsuite/gfortran.dg/gomp/pr122306-1.f90 b/gcc/testsuite/gfortran.dg/gomp/pr122306-1.f90
new file mode 100644
index 00000000000..b7eb44f6ba6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/pr122306-1.f90
@@ -0,0 +1,21 @@
+! { 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
diff --git a/gcc/testsuite/gfortran.dg/gomp/pr122306-2.f90 b/gcc/testsuite/gfortran.dg/gomp/pr122306-2.f90
new file mode 100644
index 00000000000..799c92be6cb
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/pr122306-2.f90
@@ -0,0 +1,33 @@
+! { 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
+
--
2.51.0
