Hi Tobias,
Thanks for the review!
See the updated patch and my replies below.
On 17/10/2025 09:51, Tobias Burnus wrote:
Paul-Antoine Arras wrote:
As permitted by OpenMP 6, accept an 'omp nothing' directive as
intervening code.
Well, as you have in the error message:
- error_at (input_location,
- "intervening code must not contain OpenMP directives");
+ error_at (
+ input_location,
+ "intervening code must not contain executable OpenMP
directives");
it is not only 'nothing' but more that is permitted. For
completeness, the OpenMP 6's wording is:
"Additionally, intervening code must not contain **executable**
directives or calls to the OpenMP runtime API in its corresponding
region."
whereas 5.1/5.2 had "... does not contain OpenMP directives ..."
In the spec current draft, OpenMP has the following non-executable
directives:
(A) declarative
allocate
begin declare_target
begin declare_variant
declare_induction
declare_mapper
declare_reduction
declare_simd
declare_target
declare_variant
groupprivate
threadprivate
(B) informational
assume
assumes
begin assumes
requires
(C) meta
begin metadirective
metadirective
(D) subsidiary
scan
section
task_iteration
(E) utility
error
nothing
Some aren't implemented, yet (like groupprivate or declare induction),
others are not permitted in interving code for other reasons (like
declare target), and some are a bit tricky like 'error' which is
'untility' but becomes 'executable' with 'at(execution)'.¹
[¹ I think all 'error' directives that make it into tree/gfc_code
are executable as the others are emitted while parsing.]
Still, it seems as if at least 'assume' makes sense and should be
supported:
#pragma omp for collapse(2)
for (int i = 1; i < n; i++)
{
#pragma omp assume holds (x > 1)
z = fabs(x - i);
for (int k = 0; k < m; k++)
...
}
NOTE: GCC already classifies the directives. In Fortran, there
is the gfc_omp_directives array in openmp.cc and for C/C++,
in c-common.h/c-omp.cc there is the c_omp_directives.
Technically, 'declare {reduction,induction}' would probably
be fine inside a scope - but why would you do this as
intervening code in a loop?
Likewise
int y; / #pragma omp allocate(y) allocator(my_allocator)
is valid but does not seem to make sense in a hot loop.
(BTW: The latter by construction has to use a call to an
allocate function; maybe not need this for a predefined
allocator, but for a user-defined one always.)
* * *
I think the wording in the changelog needs to be adapted to
talk about non-executable directives and not single out
'nothing'.
For the support: While a bunch is permitted, I guess it would
be sufficient to permit additionally:
- 'error at(compilation)' - presumably works already, should be tested
- 'assume'
* * *
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.
Namely, by resolving this early, conflicting results like 'collapse(2)'
with an 'omp simd' before the inner loop can be prevented if it is known
that the condition can never be true.
* * *
The early evaluation works using:
+ /* If only one selector matches and it evaluates to 'omp nothing',
no need to
+ * proceed. */
+ if (ctxs.length () == 1)
This is based on the evaluation of 'omp_context_selector_matches'
with complete_p = false while parsing. I that happens, this
case is ignored (not pushed to ctxs).
The omp_context_selector_matches returns 'no match' for:
- ignored selectors
- if implementation != "gnu"
- ...
* * *
Moving to Fortran:
--- a/gcc/fortran/parse.cc
+++ b/gcc/fortran/parse.cc
@@ -6518,7 +6518,16 @@ parse_omp_metadirective_body (gfc_statement
omp_st)
locus body_locus = gfc_current_locus;
bool saw_error = false;
- accept_statement (omp_st);
+ /* If there is only one variant and it evaluates to 'omp nothing',
no need to
+ proceed. */
+ if (variant->selectors == NULL && variant->stmt == ST_NONE
+ && variant->next == NULL)
+ {
+ reject_statement ();
+ return next_statement ();
+ }
+ else
+ accept_statement (omp_st);
In Fortran, parsing and resolution are usually two
separate items as many things are only known after
having parsed a whole subprogram (e.g. module) as
especially procedure definitions might come later.
Likewise, one needs to know the whole specification
part before one knows everything about location
declarations (variables, types, ...).
Thus, the Fortran way is: parse everything, once
finished, resolve it.
In any case, the following is mishandles as I get
Error: not enough DO loops for collapsed !$OMP TARGET TEAMS LOOP (level
1) at (1)
for the program
INTEGER, INTENT(IN) :: x_min, x_max, y_min, y_max
integer, parameter :: one = 1
...
!$omp target teams loop collapse(2))
DO k=y_min,y_max
!$omp metadirective &
when(user={condition((one < 0 ? x_min > 0: one /= 1))}: simd)
DO j=x_min,x_max
I would claim that the condition statically resolves to .false.
* * *
Actually, the parser vs. resolution thing is not as bleak. If
we talk about constant expressions, they can be resolved earlier
and, indeed, there is a call to 'gfc_resolve_expr' during parsing.
The question is why is it not active for the case above?
And, unrelated, this resolve_expr call actually rejects
valid code (function call to a later function; unrelated to
this patch as we talk here about compile-time resolvable
cases) => https://gcc.gnu.org/PR122306
* * *
I guess for now we can live with that broken part as it
was broken before - still: why is the conditional expression
not evaluated is the question.
* * *
@@ -7089,6 +7089,16 @@ match_omp_metadirective (bool begin_p)
return MATCH_ERROR;
}
+ /* Don't record the variant if the selector is a false user
condition. */
+ if (selectors != NULL && selectors->code == OMP_TRAIT_SET_USER
+ && selectors->trait_selectors->code == OMP_TRAIT_USER_CONDITION
+ && selectors->trait_selectors->properties->property_kind
+ == OMP_TRAIT_PROPERTY_BOOL_EXPR
+ && selectors->trait_selectors->properties->expr->expr_type
+ == EXPR_CONSTANT
+ && selectors->trait_selectors->properties->expr-
>value.logical == 0)
+ continue;
This seems to be extremely tailored for the testcase. If one uses:
implementation={vendor(gnu)}
it would fail immediately as well.
The question is how to salvage this.
Currently, there is in gfc_trans_omp_metadirective:
tree ctx = gfc_trans_omp_set_selector (variant->selectors,
variant->where);
ctx = omp_check_context_selector (gfc_get_location (&variant-
>where),
ctx, OMP_CTX_METADIRECTIVE);
[…] /* If the selector doesn't match, drop the whole variant. */
if (!omp_context_selector_matches (ctx, NULL_TREE, false))
This is fine - but comes much later then the case we want to solve:
resolving loop collapse.
My feeling is that we want to move both some checking and the tree
conversion of *only* the selector (+ omp_context_selector_matches)
to the resolving stage - such that we can then skip some parts.
(This implies adding a 'tree selector_tree' besides 'selector' to
'gfc_omp_variant, but that's fine.)
Admittedly, that's a bit more complex - and we probably want to
stay first with the current version.
Can you add a note to https://gcc.gnu.org/PR122306 about this
case? - It kind of feels the same issue:
- your check + the existing is-boolean check comes too early
- the can be removed check comes too late
And it seems as if properly fixing will involve touching the
same code - and should be done together.
Hence: Please add a note to that PR once this patch has
landed.
* * *
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.
- We should probably add a comment before the check that this
only handles a sensible subset of non-executable directives,
possibly cross-referencing to the (not used) classification
in the array.
Added comments accordingly.
- 'assume' should be permitted in intervening code.
(and 'error at(compilation)', but I think that's not a
compiler change).
Added support for 'assume' and 'error at(compilation)' in C and C++.
Fortran already accepted it but probably by accident. Refactored to
explicitly list the allowed directives and reject everything else.
- For 'assume' and 'error at(compilation)' (warning or error,
does not matter), having a testcase would be good.
Added testcases for assume, 'error at(compilation)' and 'error
at(execution)' in all three languages.
- Can you check why gfc_match_omp_context_selector's call to
if (!gfc_resolve_expr (otp->expr)
|| (property_kind == OMP_TRAIT_PROPERTY_BOOL_EXPR
&& otp->expr->ts.type != BT_LOGICAL)
failed to simply the conditional expression?
After running into GDB, my understanding is that gfc_resolve_expr
detects that the type is BT_LOGICAL but does not try to compute the value:
(gdb) p otp->expr->ts.type
$18 = BT_LOGICAL
(gdb) p otp->expr->value.logical
$13 = 72631568
looks like a random uninitialised value.
- Once the patch landed, can you add a note to PR122306
about the need to process the context selector earlier
(to be done in lock step with handling moving the
resolution later).
Sure, will do.
Thanks for the patch - and sorry for nitpicking.
Tobias
Let me know if I missed something.
Thanks,
--
PA
From d14c28ec4cf71b0365e467ecf93c944e7c586daa 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]
As permitted by OpenMP 6, accept a subset of non-executable directives -- namely
'metadirective', 'nothing', 'assume' and 'error at(compilation)' -- in
intervening code.
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.
PR c/120180
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 (icode_code_error_callback): Reject all statements except
'assume' and 'metadirective'.
(match_omp_metadirective): Skip variants with a
user-condition selector that statically resolves to false.
* parse.cc (parse_omp_metadirective_body): Return early if there is only
one variant and it resolves to 'omp nothing'.
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.
* 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.
---
gcc/c/c-parser.cc | 33 ++++++-
gcc/cp/parser.cc | 32 +++++-
gcc/fortran/gfortran.h | 6 +-
gcc/fortran/openmp.cc | 99 +++++--------------
gcc/fortran/parse.cc | 11 ++-
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 +++++
gcc/testsuite/gfortran.dg/gomp/pr120180-1.f90 | 31 ++++++
gcc/testsuite/gfortran.dg/gomp/pr120180-2.f90 | 90 +++++++++++++++++
14 files changed, 312 insertions(+), 96 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
diff --git a/gcc/c/c-parser.cc b/gcc/c/c-parser.cc
index 7c2452644bd..c160b487c98 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..b414f1c67d6 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..c8d66166eee 100644
--- a/gcc/fortran/openmp.cc
+++ b/gcc/fortran/openmp.cc
@@ -7089,6 +7089,16 @@ match_omp_metadirective (bool begin_p)
return MATCH_ERROR;
}
+ /* Don't record the variant if the selector is a false user condition. */
+ if (selectors != NULL && selectors->code == OMP_TRAIT_SET_USER
+ && selectors->trait_selectors->code == OMP_TRAIT_USER_CONDITION
+ && selectors->trait_selectors->properties->property_kind
+ == OMP_TRAIT_PROPERTY_BOOL_EXPR
+ && selectors->trait_selectors->properties->expr->expr_type
+ == EXPR_CONSTANT
+ && selectors->trait_selectors->properties->expr->value.logical == 0)
+ continue;
+
if (default_p)
default_seen = true;
@@ -11418,82 +11428,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 +11447,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;
}
diff --git a/gcc/fortran/parse.cc b/gcc/fortran/parse.cc
index b29f6900841..e16030f0ec4 100644
--- a/gcc/fortran/parse.cc
+++ b/gcc/fortran/parse.cc
@@ -6518,7 +6518,16 @@ parse_omp_metadirective_body (gfc_statement omp_st)
locus body_locus = gfc_current_locus;
bool saw_error = false;
- accept_statement (omp_st);
+ /* If there is only one variant and it evaluates to 'omp nothing', no need to
+ proceed. */
+ if (variant->selectors == NULL && variant->stmt == ST_NONE
+ && variant->next == NULL)
+ {
+ reject_statement ();
+ return next_statement ();
+ }
+ else
+ accept_statement (omp_st);
gfc_statement next_st = ST_NONE;
locus next_loc;
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/pr120180-1.f90 b/gcc/testsuite/gfortran.dg/gomp/pr120180-1.f90
new file mode 100644
index 00000000000..a6dd68d3d36
--- /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 test(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 test
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..7944a27b923
--- /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
--
2.51.0
