* [OG13 1/6] OpenMP: Handle loop transformation clauses in nested functions
2023-06-14 22:07 [OG13 0/6] OpenMP: Support for imperfectly-nested loops Sandra Loosemore
@ 2023-06-14 22:07 ` Sandra Loosemore
2023-06-14 22:08 ` [OG13 2/6] OpenMP: C support for imperfectly-nested loops Sandra Loosemore
` (4 subsequent siblings)
5 siblings, 0 replies; 7+ messages in thread
From: Sandra Loosemore @ 2023-06-14 22:07 UTC (permalink / raw)
To: gcc-patches
The new internal clauses introduced for loop transformations were missing
from the big switch statements over all clauses in these functions.
gcc/ChangeLog:
* tree-nested.cc (convert_nonlocal_omp_clauses): Handle loop
transformation clauses.
(convert_local_omp_clauses): Likewise.
libgomp/ChangeLog:
* testsuite/libgomp.fortran/loop-transforms/nested-fn.f90: New test.
Co-Authored-By: Frederik Harwath <frederik@codesourcery.com>
---
gcc/ChangeLog.omp | 7 +++++++
gcc/tree-nested.cc | 14 ++++++++++++++
libgomp/ChangeLog.omp | 5 +++++
.../loop-transforms/nested-fn.f90 | 19 +++++++++++++++++++
4 files changed, 45 insertions(+)
create mode 100644 libgomp/testsuite/libgomp.fortran/loop-transforms/nested-fn.f90
diff --git a/gcc/ChangeLog.omp b/gcc/ChangeLog.omp
index b4ebf6c0dea..d77d01076c2 100644
--- a/gcc/ChangeLog.omp
+++ b/gcc/ChangeLog.omp
@@ -1,3 +1,10 @@
+2023-06-13 Sandra Loosemore <sandra@codesourcery.com>
+ Frederik Harwath <frederik@codesourcery.com>
+
+ * tree-nested.cc (convert_nonlocal_omp_clauses): Handle loop
+ transformation clauses.
+ (convert_local_omp_clauses): Likewise.
+
2023-06-12 Tobias Burnus <tobias@codesourcery.com>
Backported from mainline:
diff --git a/gcc/tree-nested.cc b/gcc/tree-nested.cc
index 04651d86608..51c69dd3c10 100644
--- a/gcc/tree-nested.cc
+++ b/gcc/tree-nested.cc
@@ -1494,6 +1494,13 @@ convert_nonlocal_omp_clauses (tree *pclauses, struct walk_stmt_info *wi)
case OMP_CLAUSE__OMPACC_:
break;
+ /* Clauses related to loop transforms. */
+ case OMP_CLAUSE_TILE:
+ case OMP_CLAUSE_UNROLL_FULL:
+ case OMP_CLAUSE_UNROLL_PARTIAL:
+ case OMP_CLAUSE_UNROLL_NONE:
+ break;
+
/* The following clause belongs to the OpenACC cache directive, which
is discarded during gimplification. */
case OMP_CLAUSE__CACHE_:
@@ -2291,6 +2298,13 @@ convert_local_omp_clauses (tree *pclauses, struct walk_stmt_info *wi)
case OMP_CLAUSE__OMPACC_:
break;
+ /* Clauses related to loop transforms. */
+ case OMP_CLAUSE_TILE:
+ case OMP_CLAUSE_UNROLL_FULL:
+ case OMP_CLAUSE_UNROLL_PARTIAL:
+ case OMP_CLAUSE_UNROLL_NONE:
+ break;
+
/* The following clause belongs to the OpenACC cache directive, which
is discarded during gimplification. */
case OMP_CLAUSE__CACHE_:
diff --git a/libgomp/ChangeLog.omp b/libgomp/ChangeLog.omp
index 60dc6c1f7c2..5ce5052a8dc 100644
--- a/libgomp/ChangeLog.omp
+++ b/libgomp/ChangeLog.omp
@@ -1,3 +1,8 @@
+2023-06-13 Sandra Loosemore <sandra@codesourcery.com>
+ Frederik Harwath <frederik@codesourcery.com>
+
+ * testsuite/libgomp.fortran/loop-transforms/nested-fn.f90: New test.
+
2023-06-14 Tobias Burnus <tobias@codesourcery.com>
Backported from mainline:
diff --git a/libgomp/testsuite/libgomp.fortran/loop-transforms/nested-fn.f90 b/libgomp/testsuite/libgomp.fortran/loop-transforms/nested-fn.f90
new file mode 100644
index 00000000000..dc70c9228fd
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/loop-transforms/nested-fn.f90
@@ -0,0 +1,19 @@
+! { dg-do run }
+
+program foo
+ integer :: count
+contains
+
+subroutine s1 ()
+ integer :: i, count
+
+ count = 0
+
+ !$omp target parallel do
+ !$omp unroll partial
+ do i = 1, 100
+ end do
+
+end subroutine
+
+end program
--
2.31.1
^ permalink raw reply [flat|nested] 7+ messages in thread* [OG13 2/6] OpenMP: C support for imperfectly-nested loops
2023-06-14 22:07 [OG13 0/6] OpenMP: Support for imperfectly-nested loops Sandra Loosemore
2023-06-14 22:07 ` [OG13 1/6] OpenMP: Handle loop transformation clauses in nested functions Sandra Loosemore
@ 2023-06-14 22:08 ` Sandra Loosemore
2023-06-14 22:08 ` [OG13 3/6] OpenMP: C++ " Sandra Loosemore
` (3 subsequent siblings)
5 siblings, 0 replies; 7+ messages in thread
From: Sandra Loosemore @ 2023-06-14 22:08 UTC (permalink / raw)
To: gcc-patches
OpenMP 5.0 removed the restriction that multiple collapsed loops must
be perfectly nested, allowing "intervening code" (including nested
BLOCKs) before or after each nested loop. In GCC this code is moved
into the inner loop body by the respective front ends.
This patch changes the C front end to use recursive descent parsing
on nested loops within an "omp for" construct, rather than an iterative
approach, in order to preserve proper nesting of compound statements.
New common C/C++ testcases are in a separate patch.
gcc/c/ChangeLog
* c-parser.cc (struct c_parser): Add omp_for_parse_state field.
(struct omp_for_parse_data): New.
(check_omp_intervening_code): New.
(c_parser_compound_statement_nostart): Recognize intervening code
and nested loops in OpenMP loop constructs, and handle each
appropriately.
(c_parser_while_statement): Error on loop in intervening code.
(c_parser_do_statement): Likewise.
(c_parser_for_statement): Likewise.
(c_parser_postfix_expression_after_primary): Error on calls to
the OpenMP runtime in intervening code.
(c_parser_pragma): Error on OpenMP pragmas in intervening code.
(c_parser_see_omp_loop_nest): New.
(c_parser_omp_loop_nest): New.
(c_parser_omp_for_loop): Rewrite to use recursive descent, calling
c_parser_omp_loop_nest to do the heavy lifting.
gcc/ChangeLog
* omp-api.h: New.
* omp-general.cc (omp_runtime_api_procname): New.
(omp_runtime_api_call): Moved here from omp-low.cc, and make
non-static.
* omp-general.h: Include omp-api.h.
* omp-low.cc (omp_runtime_api_call): Delete this copy.
gcc/testsuite/ChangeLog
* c-c++-common/goacc/collapse-1.c: Update for new C error behavior.
* c-c++-common/goacc/tile-2.c: Likewise.
* c-c++-common/gomp/loop-transforms/imperfect-loop-nest.c: Likewise.
* c-c++-common/gomp/loop-transforms/tile-1.c: Likewise.
* c-c++-common/gomp/loop-transforms/tile-2.c: Likewise.
* c-c++-common/gomp/loop-transforms/tile-3.c: Likewise.
* c-c++-common/gomp/loop-transforms/unroll-inner-2.c: Likewise.
* c-c++-common/gomp/metadirective-1.c: Likewise.
* gcc.dg/gomp/collapse-1.c: Likewise.
* gcc.dg/gomp/for-1.c: Likewise.
* gcc.dg/gomp/for-11.c: Likewise.
---
gcc/ChangeLog.omp | 9 +
gcc/c/ChangeLog.omp | 19 +
gcc/c/c-parser.cc | 833 ++++++++++++------
gcc/omp-api.h | 32 +
gcc/omp-general.cc | 134 +++
gcc/omp-general.h | 1 +
gcc/omp-low.cc | 129 ---
gcc/testsuite/ChangeLog.omp | 14 +
gcc/testsuite/c-c++-common/goacc/collapse-1.c | 16 +-
gcc/testsuite/c-c++-common/goacc/tile-2.c | 4 +-
.../loop-transforms/imperfect-loop-nest.c | 4 +-
.../gomp/loop-transforms/tile-1.c | 12 +-
.../gomp/loop-transforms/tile-2.c | 12 +-
.../gomp/loop-transforms/tile-3.c | 24 +-
.../gomp/loop-transforms/unroll-inner-2.c | 3 +-
.../c-c++-common/gomp/metadirective-1.c | 2 +-
gcc/testsuite/gcc.dg/gomp/collapse-1.c | 10 +-
gcc/testsuite/gcc.dg/gomp/for-1.c | 2 +-
gcc/testsuite/gcc.dg/gomp/for-11.c | 2 +-
19 files changed, 812 insertions(+), 450 deletions(-)
create mode 100644 gcc/omp-api.h
diff --git a/gcc/ChangeLog.omp b/gcc/ChangeLog.omp
index d77d01076c2..78c655618ee 100644
--- a/gcc/ChangeLog.omp
+++ b/gcc/ChangeLog.omp
@@ -1,3 +1,12 @@
+2023-06-13 Sandra Loosemore <sandra@codesourcery.com>
+
+ * omp-api.h: New.
+ * omp-general.cc (omp_runtime_api_procname): New.
+ (omp_runtime_api_call): Moved here from omp-low.cc, and make
+ non-static.
+ * omp-general.h: Include omp-api.h.
+ * omp-low.cc (omp_runtime_api_call): Delete this copy.
+
2023-06-13 Sandra Loosemore <sandra@codesourcery.com>
Frederik Harwath <frederik@codesourcery.com>
diff --git a/gcc/c/ChangeLog.omp b/gcc/c/ChangeLog.omp
index ec4c53b165d..48cf1edd443 100644
--- a/gcc/c/ChangeLog.omp
+++ b/gcc/c/ChangeLog.omp
@@ -1,3 +1,22 @@
+2023-06-13 Sandra Loosemore <sandra@codesourcery.com>
+
+ * c-parser.cc (struct c_parser): Add omp_for_parse_state field.
+ (struct omp_for_parse_data): New.
+ (check_omp_intervening_code): New.
+ (c_parser_compound_statement_nostart): Recognize intervening code
+ and nested loops in OpenMP loop constructs, and handle each
+ appropriately.
+ (c_parser_while_statement): Error on loop in intervening code.
+ (c_parser_do_statement): Likewise.
+ (c_parser_for_statement): Likewise.
+ (c_parser_postfix_expression_after_primary): Error on calls to
+ the OpenMP runtime in intervening code.
+ (c_parser_pragma): Error on OpenMP pragmas in intervening code.
+ (c_parser_see_omp_loop_nest): New.
+ (c_parser_omp_loop_nest): New.
+ (c_parser_omp_for_loop): Rewrite to use recursive descent, calling
+ c_parser_omp_loop_nest to do the heavy lifting.
+
2023-06-12 Tobias Burnus <tobias@codesourcery.com>
Backported from mainline:
diff --git a/gcc/c/c-parser.cc b/gcc/c/c-parser.cc
index 6c84a72f8da..888446c69ec 100644
--- a/gcc/c/c-parser.cc
+++ b/gcc/c/c-parser.cc
@@ -249,6 +249,10 @@ struct GTY(()) c_parser {
/* Location of the last consumed token. */
location_t last_token_location;
+
+ /* Holds state for parsing collapsed OMP_FOR loops. Managed by
+ c_parser_omp_for_loop. */
+ struct omp_for_parse_data * GTY((skip)) omp_for_parse_state;
};
/* Return a pointer to the Nth token in PARSERs tokens_buf. */
@@ -1539,6 +1543,24 @@ struct oacc_routine_data {
/* Used for parsing objc foreach statements. */
static tree objc_foreach_break_label, objc_foreach_continue_label;
+/* Used for parsing OMP for loops. See c_parser_omp_for_loop. */
+struct omp_for_parse_data {
+ tree declv, condv, incrv, initv;
+ tree pre_body;
+ tree bindings;
+ int count;
+ int depth;
+ location_t for_loc;
+ bool want_nested_loop : 1;
+ bool ordered : 1;
+ bool in_intervening_code : 1;
+ bool perfect_nesting_fail : 1;
+ bool fail : 1;
+ bool inscan : 1;
+ enum tree_code code;
+ tree clauses;
+};
+
static bool c_parser_nth_token_starts_std_attributes (c_parser *,
unsigned int);
static tree c_parser_std_attribute_specifier_sequence (c_parser *);
@@ -1630,6 +1652,8 @@ static void c_parser_omp_threadprivate (c_parser *);
static void c_parser_omp_barrier (c_parser *);
static void c_parser_omp_depobj (c_parser *);
static void c_parser_omp_flush (c_parser *);
+static bool c_parser_see_omp_loop_nest (c_parser *, enum tree_code, bool);
+static tree c_parser_omp_loop_nest (c_parser *, bool *);
static tree c_parser_omp_for_loop (location_t, c_parser *, enum tree_code,
tree, tree *, bool *);
static void c_parser_omp_taskwait (c_parser *);
@@ -6127,6 +6151,66 @@ c_parser_compound_statement (c_parser *parser, location_t *endlocp)
return c_end_compound_stmt (brace_loc, stmt, true);
}
+/* Diagnose errors related to imperfectly nested loops in an OMP
+ loop construct. This function is called when such code is seen.
+ Only issue one such diagnostic no matter how much invalid
+ intervening code there is in the loop.
+ FIXME: maybe the location associated with the diagnostic should
+ be the current parser token instead of the location of the outer loop
+ nest. */
+
+static void
+check_omp_intervening_code (c_parser *parser)
+{
+ struct omp_for_parse_data *omp_for_parse_state = parser->omp_for_parse_state;
+ gcc_assert (omp_for_parse_state);
+
+ /* Only diagnose errors related to perfect nesting once. */
+ if (!omp_for_parse_state->perfect_nesting_fail)
+ {
+
+ /* OpenACC does not (yet) permit intervening code, in
+ addition to situations forbidden by the OpenMP spec. */
+ if (omp_for_parse_state->code == OACC_LOOP)
+ {
+ error_at (omp_for_parse_state->for_loc,
+ "inner loops must be perfectly nested in "
+ "%<#pragma acc loop%>");
+ omp_for_parse_state->perfect_nesting_fail = true;
+ }
+ else if (omp_for_parse_state->ordered)
+ {
+ error_at (omp_for_parse_state->for_loc,
+ "inner loops must be perfectly nested with "
+ "%<ordered%> clause");
+ omp_for_parse_state->perfect_nesting_fail = true;
+ }
+ else if (omp_for_parse_state->inscan)
+ {
+ error_at (omp_for_parse_state->for_loc,
+ "inner loops must be perfectly nested with "
+ "%<reduction%> %<inscan%> clause");
+ omp_for_parse_state->perfect_nesting_fail = true;
+ }
+ else
+ {
+ tree c = omp_find_clause (omp_for_parse_state->clauses,
+ OMP_CLAUSE_TILE);
+ if (c &&
+ ((int) tree_to_uhwi (OMP_CLAUSE_TRANSFORM_LEVEL (c))
+ <= omp_for_parse_state->depth))
+ {
+ error_at (omp_for_parse_state->for_loc,
+ "inner loops must be perfectly nested "
+ "with %<tile%> directive");
+ omp_for_parse_state->perfect_nesting_fail = true;
+ }
+ }
+ if (omp_for_parse_state->perfect_nesting_fail)
+ omp_for_parse_state->fail = true;
+ }
+}
+
/* Parse a compound statement except for the opening brace. This is
used for parsing both compound statements and statement expressions
(which follow different paths to handling the opening). */
@@ -6138,6 +6222,9 @@ c_parser_compound_statement_nostart (c_parser *parser)
bool last_label = false;
bool save_valid_for_pragma = valid_location_for_stdc_pragma_p ();
location_t label_loc = UNKNOWN_LOCATION; /* Quiet warning. */
+ struct omp_for_parse_data *omp_for_parse_state
+ = parser->omp_for_parse_state;
+
if (c_parser_next_token_is (parser, CPP_CLOSE_BRACE))
{
location_t endloc = c_parser_peek_token (parser)->location;
@@ -6192,6 +6279,10 @@ c_parser_compound_statement_nostart (c_parser *parser)
{
location_t loc = c_parser_peek_token (parser)->location;
loc = expansion_point_location_if_in_system_header (loc);
+
+ bool want_nested_loop = (omp_for_parse_state ?
+ omp_for_parse_state->want_nested_loop : false);
+
/* Standard attributes may start a label, statement or declaration. */
bool have_std_attrs
= c_parser_nth_token_starts_std_attributes (parser, 1);
@@ -6210,6 +6301,8 @@ c_parser_compound_statement_nostart (c_parser *parser)
last_label = true;
last_stmt = false;
mark_valid_location_for_stdc_pragma (false);
+ if (omp_for_parse_state)
+ check_omp_intervening_code (parser);
c_parser_label (parser, std_attrs);
}
else if (c_parser_next_tokens_start_declaration (parser)
@@ -6220,14 +6313,21 @@ c_parser_compound_statement_nostart (c_parser *parser)
pedwarn_c11 (c_parser_peek_token (parser)->location, OPT_Wpedantic,
"a label can only be part of a statement and "
"a declaration is not a statement");
-
+ /* It's unlikely we'll see a nested loop in a declaration in
+ intervening code in an OMP loop, but disallow it anyway. */
+ if (omp_for_parse_state)
+ {
+ check_omp_intervening_code (parser);
+ omp_for_parse_state->want_nested_loop = false;
+ }
mark_valid_location_for_stdc_pragma (false);
bool fallthru_attr_p = false;
c_parser_declaration_or_fndef (parser, true, !have_std_attrs,
true, true, true, NULL,
NULL, have_std_attrs, std_attrs,
NULL, &fallthru_attr_p);
-
+ if (omp_for_parse_state)
+ omp_for_parse_state->want_nested_loop = want_nested_loop;
if (last_stmt && !fallthru_attr_p)
pedwarn_c90 (loc, OPT_Wdeclaration_after_statement,
"ISO C90 forbids mixed declarations and code");
@@ -6255,9 +6355,18 @@ c_parser_compound_statement_nostart (c_parser *parser)
ext = disable_extension_diagnostics ();
c_parser_consume_token (parser);
last_label = false;
+ /* It's unlikely we'll see a nested loop in a declaration in
+ intervening code in an OMP loop, but disallow it anyway. */
+ if (omp_for_parse_state)
+ {
+ check_omp_intervening_code (parser);
+ omp_for_parse_state->want_nested_loop = false;
+ }
mark_valid_location_for_stdc_pragma (false);
c_parser_declaration_or_fndef (parser, true, true, true, true,
true);
+ if (omp_for_parse_state)
+ omp_for_parse_state->want_nested_loop = want_nested_loop;
/* Following the old parser, __extension__ does not
disable this diagnostic. */
restore_extension_diagnostics (ext);
@@ -6269,6 +6378,16 @@ c_parser_compound_statement_nostart (c_parser *parser)
else
goto statement;
}
+ else if (want_nested_loop
+ && c_parser_see_omp_loop_nest (parser,
+ omp_for_parse_state->code,
+ false))
+ {
+ /* Special treatment for collapsed loop nests. */
+ omp_for_parse_state->depth++;
+ add_stmt (c_parser_omp_loop_nest (parser, NULL));
+ omp_for_parse_state->depth--;
+ }
else if (c_parser_next_token_is (parser, CPP_PRAGMA))
{
if (have_std_attrs)
@@ -6311,7 +6430,20 @@ c_parser_compound_statement_nostart (c_parser *parser)
last_label = false;
last_stmt = true;
mark_valid_location_for_stdc_pragma (false);
- c_parser_statement_after_labels (parser, NULL);
+ if (omp_for_parse_state
+ && !c_parser_next_token_is (parser, CPP_OPEN_BRACE))
+ {
+ /* Nested loops can only appear directly or nested in
+ compound statements. We have neither, so set the bit
+ to treat everything inside the subsequent statement
+ as intervening code instead. */
+ omp_for_parse_state->want_nested_loop = false;
+ check_omp_intervening_code (parser);
+ c_parser_statement_after_labels (parser, NULL);
+ omp_for_parse_state->want_nested_loop = want_nested_loop;
+ }
+ else
+ c_parser_statement_after_labels (parser, NULL);
}
parser->error = false;
@@ -7153,6 +7285,14 @@ c_parser_while_statement (c_parser *parser, bool ivdep, unsigned short unroll,
gcc_assert (c_parser_next_token_is_keyword (parser, RID_WHILE));
token_indent_info while_tinfo
= get_token_indent_info (c_parser_peek_token (parser));
+
+ if (parser->omp_for_parse_state)
+ {
+ error_at (c_parser_peek_token (parser)->location,
+ "loop not permitted in intervening code in OpenMP loop body");
+ parser->omp_for_parse_state->fail = true;
+ }
+
c_parser_consume_token (parser);
block = c_begin_compound_stmt (flag_isoc99);
loc = c_parser_peek_token (parser)->location;
@@ -7204,6 +7344,14 @@ c_parser_do_statement (c_parser *parser, bool ivdep, unsigned short unroll)
unsigned char save_in_statement;
location_t loc;
gcc_assert (c_parser_next_token_is_keyword (parser, RID_DO));
+
+ if (parser->omp_for_parse_state)
+ {
+ error_at (c_parser_peek_token (parser)->location,
+ "loop not permitted in intervening code in OpenMP loop body");
+ parser->omp_for_parse_state->fail = true;
+ }
+
c_parser_consume_token (parser);
if (c_parser_next_token_is (parser, CPP_SEMICOLON))
warning_at (c_parser_peek_token (parser)->location,
@@ -7310,6 +7458,14 @@ c_parser_for_statement (c_parser *parser, bool ivdep, unsigned short unroll,
gcc_assert (c_parser_next_token_is_keyword (parser, RID_FOR));
token_indent_info for_tinfo
= get_token_indent_info (c_parser_peek_token (parser));
+
+ if (parser->omp_for_parse_state)
+ {
+ error_at (for_loc,
+ "loop not permitted in intervening code in OpenMP loop body");
+ parser->omp_for_parse_state->fail = true;
+ }
+
c_parser_consume_token (parser);
/* Open a compound statement in Objective-C as well, just in case this is
as foreach expression. */
@@ -11249,6 +11405,14 @@ c_parser_postfix_expression_after_primary (c_parser *parser,
&& fndecl_built_in_p (expr.value, BUILT_IN_NORMAL)
&& vec_safe_length (exprlist) == 1)
warn_for_abs (expr_loc, expr.value, (*exprlist)[0]);
+ if (parser->omp_for_parse_state
+ && parser->omp_for_parse_state->in_intervening_code
+ && omp_runtime_api_call (expr.value))
+ {
+ error_at (expr_loc, "calls to the OpenMP runtime API are "
+ "not permitted in intervening code");
+ parser->omp_for_parse_state->fail = true;
+ }
}
start = expr.get_start ();
@@ -13083,6 +13247,19 @@ c_parser_pragma (c_parser *parser, enum pragma_context context, bool *if_p)
input_location = c_parser_peek_token (parser)->location;
id = c_parser_peek_token (parser)->pragma_kind;
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_UNROLL
+ && id != PRAGMA_OMP_TILE)
+ {
+ error_at (input_location,
+ "intervening code must not contain OpenMP directives");
+ parser->omp_for_parse_state->fail = true;
+ c_parser_skip_until_found (parser, CPP_PRAGMA_EOL, NULL);
+ return false;
+ }
switch (id)
{
@@ -20565,6 +20742,337 @@ c_parser_omp_scan_loop_body (c_parser *parser, bool open_brace_parsed)
static int c_parser_omp_nested_loop_transform_clauses (c_parser *, tree &, int,
int, const char *);
+/* Check that the next token starts a loop nest. Return true if yes,
+ otherwise diagnose an error if ERROR_P is true, and return false. */
+static bool
+c_parser_see_omp_loop_nest (c_parser *parser, enum tree_code code,
+ bool error_p)
+{
+ if (code == OACC_LOOP)
+ {
+ if (c_parser_next_token_is_keyword (parser, RID_FOR))
+ return true;
+ if (error_p)
+ c_parser_error (parser, "for statement expected");
+ }
+ else
+ {
+ if (c_parser_next_token_is_keyword (parser, RID_FOR)
+ || c_parser_peek_token (parser)->pragma_kind == PRAGMA_OMP_UNROLL
+ || c_parser_peek_token (parser)->pragma_kind == PRAGMA_OMP_TILE)
+ return true;
+ if (error_p)
+ c_parser_error (parser, "loop nest expected");
+ }
+ return false;
+}
+
+/* This function parses a single level of a loop nest, invoking itself
+ recursively if necessary.
+
+ loop-nest :: for (...) loop-body
+ | loop-transformation-construct
+ | generated-canonical-loop
+ loop-body :: loop-nest
+ | { [intervening-code] loop-body [intervening-code] }
+ | final-loop-body
+ intervening-code :: structured-block-sequence
+ final-loop-body :: structured-block
+
+ For a collapsed loop nest, only a single OMP_FOR is built, pulling out
+ all the iterator information from the inner loops into the
+ parser->omp_for_parse_state structure.
+
+ The iterator decl, init, cond, and incr are stored in vectors.
+
+ Initialization code for iterator variables is collected into
+ parser->omp_for_parse_state->pre_body and ends up inserted directly
+ into the OMP_FOR structure. */
+
+static tree
+c_parser_omp_loop_nest (c_parser *parser, bool *if_p)
+{
+ tree decl, cond, incr, init;
+ tree body = NULL_TREE;
+ matching_parens parens;
+ bool moreloops;
+ unsigned char save_in_statement;
+ tree loop_scope;
+ location_t loc = c_parser_peek_token (parser)->location;
+ struct omp_for_parse_data *omp_for_parse_state
+ = parser->omp_for_parse_state;
+ gcc_assert (omp_for_parse_state);
+ int depth = omp_for_parse_state->depth;
+
+ /* Handle loop transformations first. Note that when we get here
+ omp_for_parse_state->depth has already been incremented to indicate
+ the depth of the *next* loop, not the level of the loop body the
+ transformation directive appears in. */
+ if (c_parser_peek_token (parser)->pragma_kind == PRAGMA_OMP_UNROLL
+ || c_parser_peek_token (parser)->pragma_kind == PRAGMA_OMP_TILE)
+ {
+ int count = omp_for_parse_state->count;
+ int more = c_parser_omp_nested_loop_transform_clauses (
+ parser, omp_for_parse_state->clauses,
+ depth, count - depth, "loop collapse");
+ if (depth + more > count)
+ {
+ count = depth + more;
+ omp_for_parse_state->count = count;
+ omp_for_parse_state->declv
+ = grow_tree_vec (omp_for_parse_state->declv, count);
+ omp_for_parse_state->initv
+ = grow_tree_vec (omp_for_parse_state->initv, count);
+ omp_for_parse_state->condv
+ = grow_tree_vec (omp_for_parse_state->condv, count);
+ omp_for_parse_state->incrv
+ = grow_tree_vec (omp_for_parse_state->incrv, count);
+ }
+ if (c_parser_see_omp_loop_nest (parser, omp_for_parse_state->code,
+ true))
+ return c_parser_omp_loop_nest (parser, if_p);
+ else
+ {
+ /* FIXME: Better error recovery here? */
+ omp_for_parse_state->fail = true;
+ return NULL_TREE;
+ }
+ }
+
+ /* We have already matched the FOR token but not consumed it yet. */
+ gcc_assert (c_parser_next_token_is_keyword (parser, RID_FOR));
+ c_parser_consume_token (parser);
+
+ /* Forbid break/continue in the loop initializer, condition, and
+ increment expressions. */
+ save_in_statement = in_statement;
+ in_statement = IN_OMP_BLOCK;
+
+ /* We are not in intervening code now. */
+ omp_for_parse_state->in_intervening_code = false;
+
+ if (!parens.require_open (parser))
+ {
+ omp_for_parse_state->fail = true;
+ return NULL_TREE;
+ }
+
+ /* An implicit scope block surrounds each level of FOR loop, for
+ declarations of iteration variables at this loop depth. */
+ loop_scope = c_begin_compound_stmt (true);
+
+ /* Parse the initialization declaration or expression. */
+ if (c_parser_next_tokens_start_declaration (parser))
+ {
+ /* This is a declaration, which must be added to the pre_body code. */
+ tree this_pre_body = push_stmt_list ();
+ c_in_omp_for = true;
+ c_parser_declaration_or_fndef (parser, true, true, true, true, true);
+ c_in_omp_for = false;
+ this_pre_body = pop_stmt_list (this_pre_body);
+ append_to_statement_list_force (this_pre_body,
+ &(omp_for_parse_state->pre_body));
+ decl = check_for_loop_decls (omp_for_parse_state->for_loc, flag_isoc99);
+ if (decl == NULL)
+ goto error_init;
+ if (DECL_INITIAL (decl) == error_mark_node)
+ decl = error_mark_node;
+ init = decl;
+ }
+ else if (c_parser_next_token_is (parser, CPP_NAME)
+ && c_parser_peek_2nd_token (parser)->type == CPP_EQ)
+ {
+ struct c_expr decl_exp;
+ struct c_expr init_exp;
+ location_t init_loc;
+
+ decl_exp = c_parser_postfix_expression (parser);
+ decl = decl_exp.value;
+
+ c_parser_require (parser, CPP_EQ, "expected %<=%>");
+
+ init_loc = c_parser_peek_token (parser)->location;
+ init_exp = c_parser_expr_no_commas (parser, NULL);
+ init_exp = default_function_array_read_conversion (init_loc,
+ init_exp);
+ c_in_omp_for = true;
+ init = build_modify_expr (init_loc, decl, decl_exp.original_type,
+ NOP_EXPR, init_loc, init_exp.value,
+ init_exp.original_type);
+ c_in_omp_for = false;
+ init = c_process_expr_stmt (init_loc, init);
+
+ c_parser_skip_until_found (parser, CPP_SEMICOLON, "expected %<;%>");
+ }
+ else
+ {
+ error_init:
+ c_parser_error (parser,
+ "expected iteration declaration or initialization");
+ c_parser_skip_until_found (parser, CPP_CLOSE_PAREN,
+ "expected %<)%>");
+ omp_for_parse_state->fail = true;
+ goto parse_next;
+ }
+
+ /* Parse the loop condition. */
+ cond = NULL_TREE;
+ if (c_parser_next_token_is_not (parser, CPP_SEMICOLON))
+ {
+ location_t cond_loc = c_parser_peek_token (parser)->location;
+ c_in_omp_for = true;
+ struct c_expr cond_expr
+ = c_parser_binary_expression (parser, NULL, NULL_TREE);
+ c_in_omp_for = false;
+
+ cond = cond_expr.value;
+ cond = c_objc_common_truthvalue_conversion (cond_loc, cond);
+ switch (cond_expr.original_code)
+ {
+ case GT_EXPR:
+ case GE_EXPR:
+ case LT_EXPR:
+ case LE_EXPR:
+ break;
+ case NE_EXPR:
+ if (omp_for_parse_state->code != OACC_LOOP)
+ break;
+ /* FALLTHRU. */
+ default:
+ /* Can't be cond = error_mark_node, because we want to preserve
+ the location until c_finish_omp_for. */
+ cond = build1 (NOP_EXPR, boolean_type_node, error_mark_node);
+ break;
+ }
+ protected_set_expr_location (cond, cond_loc);
+ }
+ c_parser_skip_until_found (parser, CPP_SEMICOLON, "expected %<;%>");
+
+ /* Parse the increment expression. */
+ incr = NULL_TREE;
+ if (c_parser_next_token_is_not (parser, CPP_CLOSE_PAREN))
+ {
+ location_t incr_loc = c_parser_peek_token (parser)->location;
+
+ incr = c_process_expr_stmt (incr_loc,
+ c_parser_expression (parser).value);
+ }
+ parens.skip_until_found_close (parser);
+
+ if (decl == NULL || decl == error_mark_node || init == error_mark_node)
+ omp_for_parse_state->fail = true;
+ else
+ {
+ TREE_VEC_ELT (omp_for_parse_state->declv, depth) = decl;
+ TREE_VEC_ELT (omp_for_parse_state->initv, depth) = init;
+ TREE_VEC_ELT (omp_for_parse_state->condv, depth) = cond;
+ TREE_VEC_ELT (omp_for_parse_state->incrv, depth) = incr;
+ }
+
+parse_next:
+ moreloops = depth < omp_for_parse_state->count - 1;
+ omp_for_parse_state->want_nested_loop = moreloops;
+ if (moreloops
+ && (c_parser_next_token_is_keyword (parser, RID_FOR)
+ || c_parser_peek_token (parser)->pragma_kind == PRAGMA_OMP_UNROLL
+ || c_parser_peek_token (parser)->pragma_kind == PRAGMA_OMP_TILE))
+ {
+ omp_for_parse_state->depth++;
+ body = c_parser_omp_loop_nest (parser, if_p);
+ omp_for_parse_state->depth--;
+ }
+ else if (moreloops && c_parser_next_token_is (parser, CPP_OPEN_BRACE))
+ {
+ /* This is the open brace in the loop-body grammar production. Rather
+ than trying to special-case braces, just parse it as a compound
+ statement and handle the nested loop-body case there. Note that
+ when we see a further open brace inside the compound statement
+ loop-body, we don't know whether it is the start of intervening
+ code that is a compound statement, or a level of braces
+ surrounding a nested loop-body. Use the WANT_NESTED_LOOP state
+ bit to ensure we have only one nested loop at each level. */
+ omp_for_parse_state->in_intervening_code = true;
+ body = c_parser_compound_statement (parser, NULL);
+ omp_for_parse_state->in_intervening_code = false;
+ if (omp_for_parse_state->want_nested_loop)
+ {
+ /* We have already parsed the whole loop body and not found a
+ nested loop. */
+ error_at (omp_for_parse_state->for_loc,
+ "not enough nested loops");
+ omp_for_parse_state->fail = true;
+ }
+ if_p = NULL;
+ }
+ else
+ {
+ /* This is the final-loop-body case in the grammar: we have
+ something that is not a FOR and not an open brace. */
+ if (moreloops)
+ {
+ /* If we were expecting a nested loop, give an error and mark
+ that parsing has failed, and try to recover by parsing the
+ body as regular code without further collapsing. */
+ error_at (omp_for_parse_state->for_loc,
+ "not enough nested loops");
+ omp_for_parse_state->fail = true;
+ }
+ in_statement = IN_OMP_FOR;
+ parser->omp_for_parse_state = NULL;
+ body = push_stmt_list ();
+ if (omp_for_parse_state->inscan)
+ c_parser_omp_scan_loop_body (parser, false);
+ else
+ add_stmt (c_parser_c99_block_statement (parser, if_p));
+ body = pop_stmt_list (body);
+ parser->omp_for_parse_state = omp_for_parse_state;
+ }
+ in_statement = save_in_statement;
+ omp_for_parse_state->want_nested_loop = false;
+ omp_for_parse_state->in_intervening_code = true;
+
+ /* Pop and return the implicit scope surrounding this level of loop.
+ If the iteration variable at this depth was bound in the for loop,
+ pull out and save the binding. Later in c_parser_omp_for_loop,
+ these bindings will be moved to the scope surrounding the entire
+ OMP_FOR. That keeps the gimplifier happy later on, and meanwhile
+ we have already resolved all references to the iteration variable
+ in its true scope. */
+ add_stmt (body);
+ body = c_end_compound_stmt (loc, loop_scope, true);
+ if (decl && TREE_CODE (body) == BIND_EXPR)
+ {
+ tree t = BIND_EXPR_VARS (body);
+ tree prev = NULL_TREE, next = NULL_TREE;
+ while (t)
+ {
+ next = DECL_CHAIN (t);
+ if (t == decl)
+ {
+ if (prev)
+ DECL_CHAIN (prev) = next;
+ else
+ {
+ BIND_EXPR_VARS (body) = next;
+ BLOCK_VARS (BIND_EXPR_BLOCK (body)) = next;
+ }
+ DECL_CHAIN (t) = omp_for_parse_state->bindings;
+ omp_for_parse_state->bindings = t;
+ break;
+ }
+ else
+ {
+ prev = t;
+ t = next;
+ }
+ }
+ if (BIND_EXPR_VARS (body) == NULL_TREE)
+ body = BIND_EXPR_BODY (body);
+ }
+
+ return body;
+}
+
/* Parse the restricted form of loop statements allowed by OpenACC and OpenMP.
The real trick here is to determine the loop control variable early
so that we can push a new decl if necessary to make it private.
@@ -20575,18 +21083,14 @@ static tree
c_parser_omp_for_loop (location_t loc, c_parser *parser, enum tree_code code,
tree clauses, tree *cclauses, bool *if_p)
{
- tree decl, cond, incr, body, init, stmt, cl;
- unsigned char save_in_statement;
- tree declv, condv, incrv, initv, ret = NULL_TREE;
- tree pre_body = NULL_TREE, this_pre_body;
+ tree body, stmt, cl;
+ tree ret = NULL_TREE;
tree ordered_cl = NULL_TREE;
- bool fail = false, open_brace_parsed = false;
- int i, collapse = 1, ordered = 0, count, nbraces = 0;
- location_t for_loc;
+ int i, collapse = 1, ordered = 0, count;
bool oacc_tiling = false;
bool inscan = false;
-
- vec<tree, va_gc> *for_block = make_tree_vector ();
+ struct omp_for_parse_data data;
+ struct omp_for_parse_data *save_data = parser->omp_for_parse_state;
for (cl = clauses; cl; cl = OMP_CLAUSE_CHAIN (cl))
if (OMP_CLAUSE_CODE (cl) == OMP_CLAUSE_COLLAPSE)
@@ -20638,266 +21142,53 @@ c_parser_omp_for_loop (location_t loc, c_parser *parser, enum tree_code code,
count = ordered ? ordered : collapse;
count = MAX (count, omp_tile_depth);
- declv = make_tree_vec (count);
- initv = make_tree_vec (count);
- condv = make_tree_vec (count);
- incrv = make_tree_vec (count);
-
- if (!c_parser_next_token_is_keyword (parser, RID_FOR))
- {
- c_parser_error (parser, "for statement expected");
- return NULL;
- }
- for_loc = c_parser_peek_token (parser)->location;
- c_parser_consume_token (parser);
-
- /* Forbid break/continue in the loop initializer, condition, and
- increment expressions. */
- save_in_statement = in_statement;
- in_statement = IN_OMP_BLOCK;
-
- for (i = 0; i < count; i++)
- {
- int bracecount = 0;
-
- matching_parens parens;
- if (!parens.require_open (parser))
- goto pop_scopes;
-
- /* Parse the initialization declaration or expression. */
- if (c_parser_next_tokens_start_declaration (parser))
- {
- if (i > 0)
- vec_safe_push (for_block, c_begin_compound_stmt (true));
- this_pre_body = push_stmt_list ();
- c_in_omp_for = true;
- c_parser_declaration_or_fndef (parser, true, true, true, true, true);
- c_in_omp_for = false;
- if (this_pre_body)
- {
- this_pre_body = pop_stmt_list (this_pre_body);
- if (pre_body)
- {
- tree t = pre_body;
- pre_body = push_stmt_list ();
- add_stmt (t);
- add_stmt (this_pre_body);
- pre_body = pop_stmt_list (pre_body);
- }
- else
- pre_body = this_pre_body;
- }
- decl = check_for_loop_decls (for_loc, flag_isoc99);
- if (decl == NULL)
- goto error_init;
- if (DECL_INITIAL (decl) == error_mark_node)
- decl = error_mark_node;
- init = decl;
- }
- else if (c_parser_next_token_is (parser, CPP_NAME)
- && c_parser_peek_2nd_token (parser)->type == CPP_EQ)
- {
- struct c_expr decl_exp;
- struct c_expr init_exp;
- location_t init_loc;
-
- decl_exp = c_parser_postfix_expression (parser);
- decl = decl_exp.value;
-
- c_parser_require (parser, CPP_EQ, "expected %<=%>");
-
- init_loc = c_parser_peek_token (parser)->location;
- init_exp = c_parser_expr_no_commas (parser, NULL);
- init_exp = default_function_array_read_conversion (init_loc,
- init_exp);
- c_in_omp_for = true;
- init = build_modify_expr (init_loc, decl, decl_exp.original_type,
- NOP_EXPR, init_loc, init_exp.value,
- init_exp.original_type);
- c_in_omp_for = false;
- init = c_process_expr_stmt (init_loc, init);
-
- c_parser_skip_until_found (parser, CPP_SEMICOLON, "expected %<;%>");
- }
- else
- {
- error_init:
- c_parser_error (parser,
- "expected iteration declaration or initialization");
- c_parser_skip_until_found (parser, CPP_CLOSE_PAREN,
- "expected %<)%>");
- fail = true;
- goto parse_next;
- }
-
- /* Parse the loop condition. */
- cond = NULL_TREE;
- if (c_parser_next_token_is_not (parser, CPP_SEMICOLON))
- {
- location_t cond_loc = c_parser_peek_token (parser)->location;
- c_in_omp_for = true;
- struct c_expr cond_expr
- = c_parser_binary_expression (parser, NULL, NULL_TREE);
- c_in_omp_for = false;
-
- cond = cond_expr.value;
- cond = c_objc_common_truthvalue_conversion (cond_loc, cond);
- switch (cond_expr.original_code)
- {
- case GT_EXPR:
- case GE_EXPR:
- case LT_EXPR:
- case LE_EXPR:
- break;
- case NE_EXPR:
- if (code != OACC_LOOP)
- break;
- /* FALLTHRU. */
- default:
- /* Can't be cond = error_mark_node, because we want to preserve
- the location until c_finish_omp_for. */
- cond = build1 (NOP_EXPR, boolean_type_node, error_mark_node);
- break;
- }
- protected_set_expr_location (cond, cond_loc);
- }
- c_parser_skip_until_found (parser, CPP_SEMICOLON, "expected %<;%>");
-
- /* Parse the increment expression. */
- incr = NULL_TREE;
- if (c_parser_next_token_is_not (parser, CPP_CLOSE_PAREN))
- {
- location_t incr_loc = c_parser_peek_token (parser)->location;
-
- incr = c_process_expr_stmt (incr_loc,
- c_parser_expression (parser).value);
- }
- parens.skip_until_found_close (parser);
-
- if (decl == NULL || decl == error_mark_node || init == error_mark_node)
- fail = true;
- else
- {
- TREE_VEC_ELT (declv, i) = decl;
- TREE_VEC_ELT (initv, i) = init;
- TREE_VEC_ELT (condv, i) = cond;
- TREE_VEC_ELT (incrv, i) = incr;
- }
-
- parse_next:
- if (i == count - 1)
- break;
-
- /* FIXME: OpenMP 3.0 draft isn't very clear on what exactly is allowed
- in between the collapsed for loops to be still considered perfectly
- nested. Hopefully the final version clarifies this.
- For now handle (multiple) {'s and empty statements. */
- do
- {
- if (c_parser_next_token_is_keyword (parser, RID_FOR))
- {
- c_parser_consume_token (parser);
- break;
- }
- else if (c_parser_next_token_is (parser, CPP_OPEN_BRACE))
- {
- c_parser_consume_token (parser);
- bracecount++;
- }
- else if (bracecount
- && c_parser_next_token_is (parser, CPP_SEMICOLON))
- c_parser_consume_token (parser);
- else if (c_parser_peek_token (parser)->pragma_kind
- == PRAGMA_OMP_UNROLL
- || c_parser_peek_token (parser)->pragma_kind
- == PRAGMA_OMP_TILE)
- {
- int depth = c_parser_omp_nested_loop_transform_clauses (
- parser, clauses, i + 1, count - i - 1, "loop collapse");
- if (i + 1 + depth > count)
- {
- count = i + 1 + depth;
- declv = grow_tree_vec (declv, count);
- initv = grow_tree_vec (initv, count);
- condv = grow_tree_vec (condv, count);
- incrv = grow_tree_vec (incrv, count);
- }
- }
- else
- {
- c_parser_error (parser, "not enough perfectly nested loops");
- if (bracecount)
- {
- open_brace_parsed = true;
- bracecount--;
- }
- fail = true;
- count = 0;
- break;
- }
- }
- while (1);
-
- nbraces += bracecount;
- }
-
- if (nbraces)
- if_p = NULL;
-
- in_statement = IN_OMP_FOR;
- body = push_stmt_list ();
-
- if (inscan)
- c_parser_omp_scan_loop_body (parser, open_brace_parsed);
- else if (open_brace_parsed)
- {
- location_t here = c_parser_peek_token (parser)->location;
- stmt = c_begin_compound_stmt (true);
- c_parser_compound_statement_nostart (parser);
- add_stmt (c_end_compound_stmt (here, stmt, true));
- }
- else
- add_stmt (c_parser_c99_block_statement (parser, if_p));
-
- body = pop_stmt_list (body);
- in_statement = save_in_statement;
+ if (!c_parser_see_omp_loop_nest (parser, code, true))
+ return NULL;
- while (nbraces)
- {
- if (c_parser_next_token_is (parser, CPP_CLOSE_BRACE))
- {
- c_parser_consume_token (parser);
- nbraces--;
- }
- else if (c_parser_next_token_is (parser, CPP_SEMICOLON))
- c_parser_consume_token (parser);
- else
- {
- c_parser_error (parser, "collapsed loops not perfectly nested");
- while (nbraces)
- {
- location_t here = c_parser_peek_token (parser)->location;
- stmt = c_begin_compound_stmt (true);
- add_stmt (body);
- c_parser_compound_statement_nostart (parser);
- body = c_end_compound_stmt (here, stmt, true);
- nbraces--;
- }
- goto pop_scopes;
- }
+ /* Initialize parse state for recursive descent. */
+ data.declv = make_tree_vec (count);
+ data.initv = make_tree_vec (count);
+ data.condv = make_tree_vec (count);
+ data.incrv = make_tree_vec (count);
+ data.pre_body = NULL_TREE;;
+ data.bindings = NULL_TREE;
+ data.for_loc = c_parser_peek_token (parser)->location;
+ data.count = count;
+ data.depth = 0;
+ data.want_nested_loop = true;
+ data.ordered = ordered > 0;
+ data.in_intervening_code = false;
+ data.perfect_nesting_fail = false;
+ data.fail = false;
+ data.inscan = inscan;
+ data.code = code;
+ data.clauses = clauses;
+ parser->omp_for_parse_state = &data;
+
+ body = c_parser_omp_loop_nest (parser, if_p);
+
+ /* Add saved bindings for iteration variables that were declared in
+ the nested for loop to the scope surrounding the entire loop. */
+ for (tree t = data.bindings; t; )
+ {
+ tree n = TREE_CHAIN (t);
+ TREE_CHAIN (t) = NULL_TREE;
+ pushdecl (t);
+ t = n;
}
/* Only bother calling c_finish_omp_for if we haven't already generated
an error from the initialization parsing. */
- if (!fail)
+ if (!data.fail)
{
c_in_omp_for = true;
- stmt = c_finish_omp_for (loc, code, declv, NULL, initv, condv,
- incrv, body, pre_body, true);
+ stmt = c_finish_omp_for (loc, code, data.declv, NULL, data.initv,
+ data.condv, data.incrv,
+ body, data.pre_body, true);
c_in_omp_for = false;
/* Check for iterators appearing in lb, b or incr expressions. */
- if (stmt && !c_omp_check_loop_iv (stmt, declv, NULL))
+ if (stmt && !c_omp_check_loop_iv (stmt, data.declv, NULL))
stmt = NULL_TREE;
if (stmt)
@@ -20938,6 +21229,7 @@ c_parser_omp_for_loop (location_t loc, c_parser *parser, enum tree_code code,
}
}
+ clauses = data.clauses;
if (cclauses != NULL
&& cclauses[C_OMP_CLAUSE_SPLIT_PARALLEL] != NULL)
{
@@ -20949,7 +21241,7 @@ c_parser_omp_for_loop (location_t loc, c_parser *parser, enum tree_code code,
else
{
for (i = 0; i < count; i++)
- if (TREE_VEC_ELT (declv, i) == OMP_CLAUSE_DECL (*c))
+ if (TREE_VEC_ELT (data.declv, i) == OMP_CLAUSE_DECL (*c))
break;
if (i == count)
c = &OMP_CLAUSE_CHAIN (*c);
@@ -20962,7 +21254,8 @@ c_parser_omp_for_loop (location_t loc, c_parser *parser, enum tree_code code,
}
else
{
- /* Move lastprivate (decl) clause to OMP_FOR_CLAUSES. */
+ /* Move lastprivate (decl) clause to
+ OMP_FOR_CLAUSES. */
tree l = *c;
*c = OMP_CLAUSE_CHAIN (*c);
if (code == OMP_SIMD)
@@ -20983,16 +21276,8 @@ c_parser_omp_for_loop (location_t loc, c_parser *parser, enum tree_code code,
}
ret = stmt;
}
-pop_scopes:
- while (!for_block->is_empty ())
- {
- /* FIXME diagnostics: LOC below should be the actual location of
- this particular for block. We need to build a list of
- locations to go along with FOR_BLOCK. */
- stmt = c_end_compound_stmt (loc, for_block->pop (), true);
- add_stmt (stmt);
- }
- release_tree_vector (for_block);
+
+ parser->omp_for_parse_state = save_data;
return ret;
}
diff --git a/gcc/omp-api.h b/gcc/omp-api.h
new file mode 100644
index 00000000000..2a7ec7b72a6
--- /dev/null
+++ b/gcc/omp-api.h
@@ -0,0 +1,32 @@
+/* Functions for querying whether a function name is reserved by the
+ OpenMP API. This is used for error checking.
+
+ Copyright (C) 2023 Free Software Foundation, Inc.
+
+This file is part of GCC.
+
+GCC is free software; you can redistribute it and/or modify it under
+the terms of the GNU General Public License as published by the Free
+Software Foundation; either version 3, or (at your option) any later
+version.
+
+GCC is distributed in the hope that it will be useful, but WITHOUT ANY
+WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License
+along with GCC; see the file COPYING3. If not see
+<http://www.gnu.org/licenses/>. */
+
+#ifndef GCC_OMP_API_H
+#define GCC_OMP_API_H
+
+#include "coretypes.h"
+
+/* In omp-general.cc, but declared in a separate header file for
+ convenience of the Fortran front end. */
+extern bool omp_runtime_api_procname (const char *name);
+extern bool omp_runtime_api_call (const_tree fndecl);
+
+#endif
diff --git a/gcc/omp-general.cc b/gcc/omp-general.cc
index c9078ce2b4e..9156eadced4 100644
--- a/gcc/omp-general.cc
+++ b/gcc/omp-general.cc
@@ -3408,4 +3408,138 @@ omp_build_component_ref (tree obj, tree field)
return ret;
}
+/* Return true if NAME is the name of an omp_* runtime API call. */
+bool
+omp_runtime_api_procname (const char *name)
+{
+ if (!startswith (name, "omp_"))
+ return false;
+
+ static const char *omp_runtime_apis[] =
+ {
+ /* This array has 3 sections. First omp_* calls that don't
+ have any suffixes. */
+ "aligned_alloc",
+ "aligned_calloc",
+ "alloc",
+ "calloc",
+ "free",
+ "get_mapped_ptr",
+ "realloc",
+ "target_alloc",
+ "target_associate_ptr",
+ "target_disassociate_ptr",
+ "target_free",
+ "target_is_accessible",
+ "target_is_present",
+ "target_memcpy",
+ "target_memcpy_async",
+ "target_memcpy_rect",
+ "target_memcpy_rect_async",
+ NULL,
+ /* Now omp_* calls that are available as omp_* and omp_*_; however, the
+ DECL_NAME is always omp_* without tailing underscore. */
+ "capture_affinity",
+ "destroy_allocator",
+ "destroy_lock",
+ "destroy_nest_lock",
+ "display_affinity",
+ "fulfill_event",
+ "get_active_level",
+ "get_affinity_format",
+ "get_cancellation",
+ "get_default_allocator",
+ "get_default_device",
+ "get_device_num",
+ "get_dynamic",
+ "get_initial_device",
+ "get_level",
+ "get_max_active_levels",
+ "get_max_task_priority",
+ "get_max_teams",
+ "get_max_threads",
+ "get_nested",
+ "get_num_devices",
+ "get_num_places",
+ "get_num_procs",
+ "get_num_teams",
+ "get_num_threads",
+ "get_partition_num_places",
+ "get_place_num",
+ "get_proc_bind",
+ "get_supported_active_levels",
+ "get_team_num",
+ "get_teams_thread_limit",
+ "get_thread_limit",
+ "get_thread_num",
+ "get_wtick",
+ "get_wtime",
+ "in_explicit_task",
+ "in_final",
+ "in_parallel",
+ "init_lock",
+ "init_nest_lock",
+ "is_initial_device",
+ "pause_resource",
+ "pause_resource_all",
+ "set_affinity_format",
+ "set_default_allocator",
+ "set_lock",
+ "set_nest_lock",
+ "test_lock",
+ "test_nest_lock",
+ "unset_lock",
+ "unset_nest_lock",
+ NULL,
+ /* And finally calls available as omp_*, omp_*_ and omp_*_8_; however,
+ as DECL_NAME only omp_* and omp_*_8 appear. */
+ "display_env",
+ "get_ancestor_thread_num",
+ "init_allocator",
+ "get_partition_place_nums",
+ "get_place_num_procs",
+ "get_place_proc_ids",
+ "get_schedule",
+ "get_team_size",
+ "set_default_device",
+ "set_dynamic",
+ "set_max_active_levels",
+ "set_nested",
+ "set_num_teams",
+ "set_num_threads",
+ "set_schedule",
+ "set_teams_thread_limit"
+ };
+
+ int mode = 0;
+ for (unsigned i = 0; i < ARRAY_SIZE (omp_runtime_apis); i++)
+ {
+ if (omp_runtime_apis[i] == NULL)
+ {
+ mode++;
+ continue;
+ }
+ size_t len = strlen (omp_runtime_apis[i]);
+ if (strncmp (name + 4, omp_runtime_apis[i], len) == 0
+ && (name[4 + len] == '\0'
+ || (mode > 1 && strcmp (name + 4 + len, "_8") == 0)))
+ return true;
+ }
+ return false;
+}
+
+/* Return true if FNDECL is an omp_* runtime API call. */
+
+bool
+omp_runtime_api_call (const_tree fndecl)
+{
+ tree declname = DECL_NAME (fndecl);
+ if (!declname
+ || (DECL_CONTEXT (fndecl) != NULL_TREE
+ && TREE_CODE (DECL_CONTEXT (fndecl)) != TRANSLATION_UNIT_DECL)
+ || !TREE_PUBLIC (fndecl))
+ return false;
+ return omp_runtime_api_procname (IDENTIFIER_POINTER (declname));
+}
+
#include "gt-omp-general.h"
diff --git a/gcc/omp-general.h b/gcc/omp-general.h
index 55f0fc06159..082ea4be368 100644
--- a/gcc/omp-general.h
+++ b/gcc/omp-general.h
@@ -23,6 +23,7 @@ along with GCC; see the file COPYING3. If not see
#define GCC_OMP_GENERAL_H
#include "gomp-constants.h"
+#include "omp-api.h"
/* Flags for an OpenACC loop. */
diff --git a/gcc/omp-low.cc b/gcc/omp-low.cc
index 0e18db87be5..3424eba2217 100644
--- a/gcc/omp-low.cc
+++ b/gcc/omp-low.cc
@@ -4550,135 +4550,6 @@ setjmp_or_longjmp_p (const_tree fndecl)
return !strcmp (name, "setjmp") || !strcmp (name, "longjmp");
}
-/* Return true if FNDECL is an omp_* runtime API call. */
-
-static bool
-omp_runtime_api_call (const_tree fndecl)
-{
- tree declname = DECL_NAME (fndecl);
- if (!declname
- || (DECL_CONTEXT (fndecl) != NULL_TREE
- && TREE_CODE (DECL_CONTEXT (fndecl)) != TRANSLATION_UNIT_DECL)
- || !TREE_PUBLIC (fndecl))
- return false;
-
- const char *name = IDENTIFIER_POINTER (declname);
- if (!startswith (name, "omp_"))
- return false;
-
- static const char *omp_runtime_apis[] =
- {
- /* This array has 3 sections. First omp_* calls that don't
- have any suffixes. */
- "aligned_alloc",
- "aligned_calloc",
- "alloc",
- "calloc",
- "free",
- "get_mapped_ptr",
- "realloc",
- "target_alloc",
- "target_associate_ptr",
- "target_disassociate_ptr",
- "target_free",
- "target_is_accessible",
- "target_is_present",
- "target_memcpy",
- "target_memcpy_async",
- "target_memcpy_rect",
- "target_memcpy_rect_async",
- NULL,
- /* Now omp_* calls that are available as omp_* and omp_*_; however, the
- DECL_NAME is always omp_* without tailing underscore. */
- "capture_affinity",
- "destroy_allocator",
- "destroy_lock",
- "destroy_nest_lock",
- "display_affinity",
- "fulfill_event",
- "get_active_level",
- "get_affinity_format",
- "get_cancellation",
- "get_default_allocator",
- "get_default_device",
- "get_device_num",
- "get_dynamic",
- "get_initial_device",
- "get_level",
- "get_max_active_levels",
- "get_max_task_priority",
- "get_max_teams",
- "get_max_threads",
- "get_nested",
- "get_num_devices",
- "get_num_places",
- "get_num_procs",
- "get_num_teams",
- "get_num_threads",
- "get_partition_num_places",
- "get_place_num",
- "get_proc_bind",
- "get_supported_active_levels",
- "get_team_num",
- "get_teams_thread_limit",
- "get_thread_limit",
- "get_thread_num",
- "get_wtick",
- "get_wtime",
- "in_explicit_task",
- "in_final",
- "in_parallel",
- "init_lock",
- "init_nest_lock",
- "is_initial_device",
- "pause_resource",
- "pause_resource_all",
- "set_affinity_format",
- "set_default_allocator",
- "set_lock",
- "set_nest_lock",
- "test_lock",
- "test_nest_lock",
- "unset_lock",
- "unset_nest_lock",
- NULL,
- /* And finally calls available as omp_*, omp_*_ and omp_*_8_; however,
- as DECL_NAME only omp_* and omp_*_8 appear. */
- "display_env",
- "get_ancestor_thread_num",
- "init_allocator",
- "get_partition_place_nums",
- "get_place_num_procs",
- "get_place_proc_ids",
- "get_schedule",
- "get_team_size",
- "set_default_device",
- "set_dynamic",
- "set_max_active_levels",
- "set_nested",
- "set_num_teams",
- "set_num_threads",
- "set_schedule",
- "set_teams_thread_limit"
- };
-
- int mode = 0;
- for (unsigned i = 0; i < ARRAY_SIZE (omp_runtime_apis); i++)
- {
- if (omp_runtime_apis[i] == NULL)
- {
- mode++;
- continue;
- }
- size_t len = strlen (omp_runtime_apis[i]);
- if (strncmp (name + 4, omp_runtime_apis[i], len) == 0
- && (name[4 + len] == '\0'
- || (mode > 1 && strcmp (name + 4 + len, "_8") == 0)))
- return true;
- }
- return false;
-}
-
/* Helper function for scan_omp.
Callback for walk_gimple_stmt used to scan for OMP directives in
diff --git a/gcc/testsuite/ChangeLog.omp b/gcc/testsuite/ChangeLog.omp
index 03d6162c5ba..408fdf4d164 100644
--- a/gcc/testsuite/ChangeLog.omp
+++ b/gcc/testsuite/ChangeLog.omp
@@ -1,3 +1,17 @@
+2023-06-13 Sandra Loosemore <sandra@codesourcery.com>
+
+ * c-c++-common/goacc/collapse-1.c: Update for new C error behavior.
+ * c-c++-common/goacc/tile-2.c: Likewise.
+ * c-c++-common/gomp/loop-transforms/imperfect-loop-nest.c: Likewise.
+ * c-c++-common/gomp/loop-transforms/tile-1.c: Likewise.
+ * c-c++-common/gomp/loop-transforms/tile-2.c: Likewise.
+ * c-c++-common/gomp/loop-transforms/tile-3.c: Likewise.
+ * c-c++-common/gomp/loop-transforms/unroll-inner-2.c: Likewise.
+ * c-c++-common/gomp/metadirective-1.c: Likewise.
+ * gcc.dg/gomp/collapse-1.c: Likewise.
+ * gcc.dg/gomp/for-1.c: Likewise.
+ * gcc.dg/gomp/for-11.c: Likewise.
+
2023-06-12 Tobias Burnus <tobias@codesourcery.com>
Backported from mainline:
diff --git a/gcc/testsuite/c-c++-common/goacc/collapse-1.c b/gcc/testsuite/c-c++-common/goacc/collapse-1.c
index 11b14383983..0feac8f8ddb 100644
--- a/gcc/testsuite/c-c++-common/goacc/collapse-1.c
+++ b/gcc/testsuite/c-c++-common/goacc/collapse-1.c
@@ -8,8 +8,8 @@ f1 (void)
{
#pragma acc parallel
#pragma acc loop collapse (2)
- for (i = 0; i < 5; i++)
- ; /* { dg-error "not enough perfectly nested" } */
+ for (i = 0; i < 5; i++) /* { dg-error "not enough nested loops" } */
+ ;
{
for (j = 0; j < 5; j++)
;
@@ -38,9 +38,9 @@ f3 (void)
{
#pragma acc parallel
#pragma acc loop collapse (2)
- for (i = 0; i < 5; i++)
+ for (i = 0; i < 5; i++) /* { dg-error "inner loops must be perfectly nested" } */
{
- int k = foo (); /* { dg-error "not enough perfectly nested" } */
+ int k = foo ();
{
{
for (j = 0; j < 5; j++)
@@ -56,12 +56,12 @@ f4 (void)
{
#pragma acc parallel
#pragma acc loop collapse (2)
- for (i = 0; i < 5; i++)
+ for (i = 0; i < 5; i++) /* { dg-error "inner loops must be perfectly nested" } */
{
{
for (j = 0; j < 5; j++)
;
- foo (); /* { dg-error "collapsed loops not perfectly nested before" } */
+ foo ();
}
}
}
@@ -71,13 +71,13 @@ f5 (void)
{
#pragma acc parallel
#pragma acc loop collapse (2)
- for (i = 0; i < 5; i++)
+ for (i = 0; i < 5; i++) /* { dg-error "inner loops must be perfectly nested" } */
{
{
for (j = 0; j < 5; j++)
;
}
- foo (); /* { dg-error "collapsed loops not perfectly nested before" } */
+ foo ();
}
}
diff --git a/gcc/testsuite/c-c++-common/goacc/tile-2.c b/gcc/testsuite/c-c++-common/goacc/tile-2.c
index c8b240d225b..98abc903bdc 100644
--- a/gcc/testsuite/c-c++-common/goacc/tile-2.c
+++ b/gcc/testsuite/c-c++-common/goacc/tile-2.c
@@ -3,8 +3,8 @@ int main ()
#pragma acc parallel
{
#pragma acc loop tile (*,*)
- for (int ix = 0; ix < 30; ix++)
- ; /* { dg-error "not enough" } */
+ for (int ix = 0; ix < 30; ix++) /* { dg-error "not enough" "" { target c } } */
+ ; /* { dg-error "not enough" "" { target c++ } } */
#pragma acc loop tile (*,*)
for (int ix = 0; ix < 30; ix++)
diff --git a/gcc/testsuite/c-c++-common/gomp/loop-transforms/imperfect-loop-nest.c b/gcc/testsuite/c-c++-common/gomp/loop-transforms/imperfect-loop-nest.c
index 57e72dffa03..3679755d03d 100644
--- a/gcc/testsuite/c-c++-common/gomp/loop-transforms/imperfect-loop-nest.c
+++ b/gcc/testsuite/c-c++-common/gomp/loop-transforms/imperfect-loop-nest.c
@@ -1,11 +1,11 @@
void test ()
{
#pragma omp tile sizes (2,4,6)
- for (unsigned i = 0; i < 10; i++)
+ for (unsigned i = 0; i < 10; i++) /* { dg-error "inner loops must be perfectly nested" { target c } } */
for (unsigned j = 0; j < 10; j++)
{
float intervening_decl = 0; /* { dg-bogus "not enough for loops to collapse" "TODO C/C++ imperfect loop nest handling" { xfail c++ } } */
- /* { dg-bogus "not enough perfectly nested loops" "TODO C/C++ imperfect loop nest handling" { xfail c } .-1 } */
+
#pragma omp unroll partial(2)
for (unsigned k = 0; k < 10; k++);
}
diff --git a/gcc/testsuite/c-c++-common/gomp/loop-transforms/tile-1.c b/gcc/testsuite/c-c++-common/gomp/loop-transforms/tile-1.c
index c423f60fe95..70e58d6fc56 100644
--- a/gcc/testsuite/c-c++-common/gomp/loop-transforms/tile-1.c
+++ b/gcc/testsuite/c-c++-common/gomp/loop-transforms/tile-1.c
@@ -110,9 +110,9 @@ test ()
dummy (i);
#pragma omp tile sizes(1, 2, 3)
- for (int i = 0; i < 100; ++i)
+ for (int i = 0; i < 100; ++i) /* { dg-error {not enough nested loops} "" { target c } } */
for (int j = 0; j < 100; ++j)
- dummy (i); /* { dg-error {not enough perfectly nested loops before 'dummy'} "" { target c } } */
+ dummy (i);
/* { dg-error {not enough for loops to collapse} "" { target c++ } .-1 } */
/* { dg-error {'i' was not declared in this scope} "" { target c++ } .-2 } */
@@ -133,20 +133,20 @@ test ()
}
#pragma omp tile sizes(1, 2)
- for (int i = 0; i < 100; ++i)
+ for (int i = 0; i < 100; ++i) /* { dg-error {inner loops must be perfectly nested} "" { target c } } */
{
- dummy (i); /* { dg-error {not enough perfectly nested loops before 'dummy'} "" { target c } } */
+ dummy (i);
/* { dg-error {not enough for loops to collapse} "" { target c++ } .-1 } */
for (int j = 0; j < 100; ++j)
dummy (j);
}
#pragma omp tile sizes(1, 2)
- for (int i = 0; i < 100; ++i)
+ for (int i = 0; i < 100; ++i) /* { dg-error {inner loops must be perfectly nested} "" { target c } } */
{
for (int j = 0; j < 100; ++j)
dummy (j);
- dummy (i); /* { dg-error {collapsed loops not perfectly nested before 'dummy'} "" { target c} } */
+ dummy (i);
/* { dg-error {collapsed loops not perfectly nested} "" { target c++ } .-1 } */
}
diff --git a/gcc/testsuite/c-c++-common/gomp/loop-transforms/tile-2.c b/gcc/testsuite/c-c++-common/gomp/loop-transforms/tile-2.c
index c48f4ad45b9..6b27f9630e2 100644
--- a/gcc/testsuite/c-c++-common/gomp/loop-transforms/tile-2.c
+++ b/gcc/testsuite/c-c++-common/gomp/loop-transforms/tile-2.c
@@ -132,9 +132,9 @@ test ()
#pragma omp parallel for
#pragma omp tile sizes(1, 2, 3)
- for (int i = 0; i < 100; ++i)
+ for (int i = 0; i < 100; ++i) /* { dg-error {not enough nested loops} "" { target c } } */
for (int j = 0; j < 100; ++j)
- dummy (i); /* { dg-error {not enough perfectly nested loops before 'dummy'} "" { target c } } */
+ dummy (i);
/* { dg-error {not enough for loops to collapse} "" { target c++ } .-1 } */
/* { dg-error {'i' was not declared in this scope} "" { target c++ } .-2 } */
@@ -158,9 +158,9 @@ test ()
#pragma omp parallel for
#pragma omp tile sizes(1, 2)
- for (int i = 0; i < 100; ++i)
+ for (int i = 0; i < 100; ++i) /* { dg-error {inner loops must be perfectly nested} "" { target c } } */
{
- dummy (i); /* { dg-error {not enough perfectly nested loops before 'dummy'} "" { target c } } */
+ dummy (i);
/* { dg-error {not enough for loops to collapse} "" { target c++ } .-1 } */
for (int j = 0; j < 100; ++j)
dummy (j);
@@ -168,11 +168,11 @@ test ()
#pragma omp parallel for
#pragma omp tile sizes(1, 2)
- for (int i = 0; i < 100; ++i)
+ for (int i = 0; i < 100; ++i) /* { dg-error {inner loops must be perfectly nested} "" { target c } } */
{
for (int j = 0; j < 100; ++j)
dummy (j);
- dummy (i); /* { dg-error {collapsed loops not perfectly nested before 'dummy'} "" { target c} } */
+ dummy (i);
/* { dg-error {collapsed loops not perfectly nested} "" { target c++ } .-1 } */
}
diff --git a/gcc/testsuite/c-c++-common/gomp/loop-transforms/tile-3.c b/gcc/testsuite/c-c++-common/gomp/loop-transforms/tile-3.c
index 7fffc72b335..db913e26d10 100644
--- a/gcc/testsuite/c-c++-common/gomp/loop-transforms/tile-3.c
+++ b/gcc/testsuite/c-c++-common/gomp/loop-transforms/tile-3.c
@@ -36,12 +36,11 @@ test ()
#pragma omp for collapse(3)
#pragma omp tile sizes(1, 2) /* { dg-error {nesting depth left after this transformation too low for loop collapse} } */
- for (int i = 0; i < 100; ++i)
+ for (int i = 0; i < 100; ++i) /* { dg-error {not enough nested loops} "" { target c } } */
for (int j = 0; j < 100; ++j)
dummy (i);
- /* { dg-error {not enough perfectly nested loops before 'dummy'} "" { target c } .-1 } */
- /* { dg-error {not enough for loops to collapse} "" { target c++ } .-2 } */
- /* { dg-error {'i' was not declared in this scope} "" { target c++ } .-3 } */
+ /* { dg-error {not enough for loops to collapse} "" { target c++ } .-1 } */
+ /* { dg-error {'i' was not declared in this scope} "" { target c++ } .-2 } */
#pragma omp for collapse(1)
#pragma omp tile sizes(1)
@@ -52,25 +51,24 @@ test ()
#pragma omp for collapse(2)
#pragma omp tile sizes(1, 2)
#pragma omp tile sizes(1) /* { dg-error {nesting depth left after this transformation too low for outer transformation} } */
- for (int i = 0; i < 100; ++i)
- dummy (i); /* { dg-error {not enough perfectly nested loops before 'dummy'} "" { target c } } */
+ for (int i = 0; i < 100; ++i) /* { dg-error {not enough nested loops} "" { target c } } */
+ dummy (i);
/* { dg-error {not enough for loops to collapse} "" { target c++ } .-1 } */
#pragma omp for collapse(2)
#pragma omp tile sizes(1, 2)
#pragma omp tile sizes(1, 2)
- for (int i = 0; i < 100; ++i)
- dummy (i); /* { dg-error {not enough perfectly nested loops before 'dummy'} "" { target c } } */
+ for (int i = 0; i < 100; ++i) /* { dg-error {not enough nested loops} "" { target c } } */
+ dummy (i);
/* { dg-error {not enough for loops to collapse} "" { target c++ } .-1 } */
#pragma omp for collapse(2)
#pragma omp tile sizes(5, 6)
#pragma omp tile sizes(1, 2, 3)
- for (int i = 0; i < 100; ++i)
- dummy (i); /* { dg-error {not enough perfectly nested loops before 'dummy'} "" { target c } } */
+ for (int i = 0; i < 100; ++i) /* { dg-error {not enough nested loops} "" { target c } } */
+ dummy (i);
/* { dg-error {not enough for loops to collapse} "" { target c++ } .-1 } */
-
#pragma omp for collapse(1)
#pragma omp tile sizes(1)
#pragma omp tile sizes(1)
@@ -102,9 +100,9 @@ test ()
#pragma omp for collapse(3)
#pragma omp tile sizes(1, 2) /* { dg-error {nesting depth left after this transformation too low for loop collapse} } */
#pragma omp tile sizes(1, 2)
- for (int i = 0; i < 100; ++i)
+ for (int i = 0; i < 100; ++i) /* { dg-error {not enough nested loops} "" { target c } } */
for (int j = 0; j < 100; ++j)
- dummy (i); /* { dg-error {not enough perfectly nested loops before 'dummy'} "" { target c } } */
+ dummy (i);
/* { dg-error {not enough for loops to collapse} "" { target c++ } .-1 } */
#pragma omp for collapse(3)
diff --git a/gcc/testsuite/c-c++-common/gomp/loop-transforms/unroll-inner-2.c b/gcc/testsuite/c-c++-common/gomp/loop-transforms/unroll-inner-2.c
index 3f8fbf2d45a..d3ba7282a9f 100644
--- a/gcc/testsuite/c-c++-common/gomp/loop-transforms/unroll-inner-2.c
+++ b/gcc/testsuite/c-c++-common/gomp/loop-transforms/unroll-inner-2.c
@@ -13,12 +13,11 @@ test ()
dummy (i);
#pragma omp target parallel for collapse(2)
- for (int i = -300; i != 100; ++i)
+ for (int i = -300; i != 100; ++i) /* { dg-error {not enough nested loops} "" { target c } } */
#pragma omp tile sizes(2, 3)
for (int j = 0; j != 100; ++j)
dummy (i); /* { dg-error {not enough for loops to collapse} "" { target c++ } } */
/* { dg-error {'i' was not declared in this scope} "" { target c++ } .-1 } */
-/* { dg-error {not enough perfectly nested loops before 'dummy'} "" { target c } .-2 } */
#pragma omp target parallel for collapse(2)
for (int i = -300; i != 100; ++i)
diff --git a/gcc/testsuite/c-c++-common/gomp/metadirective-1.c b/gcc/testsuite/c-c++-common/gomp/metadirective-1.c
index 543063a3324..d4ddbe151b2 100644
--- a/gcc/testsuite/c-c++-common/gomp/metadirective-1.c
+++ b/gcc/testsuite/c-c++-common/gomp/metadirective-1.c
@@ -36,7 +36,7 @@ void f (int a[], int b[], int c[])
when (implementation={vendor("gnu")}: parallel for)
#pragma omp metadirective \
when (implementation={vendor("cray")}: parallel for)
- /* { dg-error "for statement expected before '#pragma'" "" { target c } .-2 } */
+ /* { dg-error "loop nest expected before '#pragma'" "" { target c } .-2 } */
/* { dg-error "'#pragma' is not allowed here" "" { target c++ } .-3 } */
for (i = 0; i < N; i++) c[i] = a[i] * b[i];
}
diff --git a/gcc/testsuite/gcc.dg/gomp/collapse-1.c b/gcc/testsuite/gcc.dg/gomp/collapse-1.c
index 89b76bb669c..16a102ff3fd 100644
--- a/gcc/testsuite/gcc.dg/gomp/collapse-1.c
+++ b/gcc/testsuite/gcc.dg/gomp/collapse-1.c
@@ -8,8 +8,8 @@ void
f1 (void)
{
#pragma omp for collapse (2)
- for (i = 0; i < 5; i++)
- ; /* { dg-error "not enough perfectly nested" } */
+ for (i = 0; i < 5; i++) /* { dg-error "not enough nested loops" } */
+ ;
{
for (j = 0; j < 5; j++)
;
@@ -38,7 +38,7 @@ f3 (void)
#pragma omp for collapse (2)
for (i = 0; i < 5; i++)
{
- int k = foo (); /* { dg-error "not enough perfectly nested" } */
+ int k = foo ();
{
{
for (j = 0; j < 5; j++)
@@ -58,7 +58,7 @@ f4 (void)
{
for (j = 0; j < 5; j++)
;
- foo (); /* { dg-error "collapsed loops not perfectly nested before" } */
+ foo ();
}
}
}
@@ -73,7 +73,7 @@ f5 (void)
for (j = 0; j < 5; j++)
;
}
- foo (); /* { dg-error "collapsed loops not perfectly nested before" } */
+ foo ();
}
}
diff --git a/gcc/testsuite/gcc.dg/gomp/for-1.c b/gcc/testsuite/gcc.dg/gomp/for-1.c
index 80e0d0be844..e4c70607bb2 100644
--- a/gcc/testsuite/gcc.dg/gomp/for-1.c
+++ b/gcc/testsuite/gcc.dg/gomp/for-1.c
@@ -26,7 +26,7 @@ void foo (int j, int k)
/* Malformed parallel loops. */
#pragma omp for
- i = 0; /* { dg-error "3:for statement expected" } */
+ i = 0; /* { dg-error "loop nest expected" } */
for ( ; i < 10; )
{
baz (i);
diff --git a/gcc/testsuite/gcc.dg/gomp/for-11.c b/gcc/testsuite/gcc.dg/gomp/for-11.c
index 8c747cdb981..abafa487283 100644
--- a/gcc/testsuite/gcc.dg/gomp/for-11.c
+++ b/gcc/testsuite/gcc.dg/gomp/for-11.c
@@ -30,7 +30,7 @@ void foo (int j, int k)
/* Malformed parallel loops. */
#pragma omp for
- i = 0; /* { dg-error "for statement expected" } */
+ i = 0; /* { dg-error "loop nest expected" } */
for ( ; i < 10; )
{
baz (i);
--
2.31.1
^ permalink raw reply [flat|nested] 7+ messages in thread* [OG13 3/6] OpenMP: C++ support for imperfectly-nested loops
2023-06-14 22:07 [OG13 0/6] OpenMP: Support for imperfectly-nested loops Sandra Loosemore
2023-06-14 22:07 ` [OG13 1/6] OpenMP: Handle loop transformation clauses in nested functions Sandra Loosemore
2023-06-14 22:08 ` [OG13 2/6] OpenMP: C support for imperfectly-nested loops Sandra Loosemore
@ 2023-06-14 22:08 ` Sandra Loosemore
2023-06-14 22:08 ` [OG13 4/6] OpenMP: New c/c++ testcases " Sandra Loosemore
` (2 subsequent siblings)
5 siblings, 0 replies; 7+ messages in thread
From: Sandra Loosemore @ 2023-06-14 22:08 UTC (permalink / raw)
To: gcc-patches
OpenMP 5.0 removed the restriction that multiple collapsed loops must
be perfectly nested, allowing "intervening code" (including nested
BLOCKs) before or after each nested loop. In GCC this code is moved
into the inner loop body by the respective front ends.
This patch changes the C++ front end to use recursive descent parsing
on nested loops within an "omp for" construct, rather than an
iterative approach, in order to preserve proper nesting of compound
statements. Preserving cleanups (destructors) for class objects
declared in intervening code and loop initializers complicates moving
the former into the body of the loop; this is handled by parsing the
entire construct before reassembling any of it.
New common C/C++ testcases are in a separate patch.
gcc/cp/ChangeLog
* cp-tree.h (cp_convert_omp_range_for): Adjust declaration.
* parser.cc (struct omp_for_parse_data): New.
(cp_parser_postfix_expression): Diagnose calls to OpenMP runtime
in intervening code.
(check_omp_intervening_code): New.
(cp_parser_statement_seq_opt): Special-case nested OMP loops and
blocks in intervening code.
(cp_parser_iteration_statement): Reject loops in intervening code.
(cp_parser_omp_for_loop_init): Expand comments and tweak the
interface slightly to better distinguish input/output parameters.
(cp_parser_omp_range_for): Likewise.
(cp_convert_omp_range_for): Likewise.
(cp_parser_see_omp_loop_nest): New.
(cp_parser_omp_loop_nest): New, split from cp_parser_omp_for_loop
and largely rewritten. Add more comments.
(struct sit_data, substitute_in_tree_walker, substitute_in_tree):
New.
(fixup_blocks_walker): New.
(cp_parser_omp_for_loop): Rewrite to use recursive descent instead
of a loop. Add logic to reshuffle the bits of code collected
during parsing so intervening code gets moved to the loop body.
(cp_parser_omp_loop): Remove call to finish_omp_for_block, which
is now redundant.
(cp_parser_omp_simd): Likewise.
(cp_parser_omp_for): Likewise.
(cp_parser_omp_distribute): Likewise.
(cp_parser_oacc_loop): Likewise.
(cp_parser_omp_taskloop): Likewise.
(cp_parser_pragma): Reject OpenMP pragmas in intervening code.
* parser.h (struct cp_parser): Add omp_for_parse_state field.
* pt.cc (tsubst_omp_for_iterator): Adjust call to
cp_convert_omp_range_for.
* semantics.cc (struct fofb_data, finish_omp_for_block_walker): New.
(finish_omp_for_block): Allow variables to be bound in a BIND_EXPR
nested inside BIND instead of directly in BIND itself.
gcc/testsuite/ChangeLog
* c-c++-common/goacc/tile-2.c: Adjust expected error patterns.
* c-c++-common/gomp/loop-transforms/imperfect-loop-nest: Likewise.
* c-c++-common/gomp/loop-transforms/tile-1.c: Likewise.
* c-c++-common/gomp/loop-transforms/tile-2.c: Likewise.
* c-c++-common/gomp/loop-transforms/tile-3.c: Likewise.
* c-c++-common/gomp/loop-transforms/unroll-inner-2.c: Likewise.
* g++.dg/gomp/attrs-4.C: Likewise.
* g++.dg/gomp/for-1.C: Likewise.
* g++.dg/gomp/pr41967.C: Likewise.
* g++.dg/gomp/pr94512.C: Likewise.
libgomp/ChangeLog
* testsuite/libgomp.c++/imperfect-class-1.C: New.
* testsuite/libgomp.c++/imperfect-class-2.C: New.
* testsuite/libgomp.c++/imperfect-class-3.C: New.
* testsuite/libgomp.c++/imperfect-destructor.C: New.
* testsuite/libgomp.c++/imperfect-template-1.C: New.
* testsuite/libgomp.c++/imperfect-template-2.C: New.
* testsuite/libgomp.c++/imperfect-template-3.C: New.
---
gcc/cp/ChangeLog.omp | 38 +
gcc/cp/cp-tree.h | 2 +-
gcc/cp/parser.cc | 1331 +++++++++++------
gcc/cp/parser.h | 3 +
gcc/cp/pt.cc | 3 +-
gcc/cp/semantics.cc | 80 +-
gcc/testsuite/ChangeLog.omp | 13 +
gcc/testsuite/c-c++-common/goacc/tile-2.c | 4 +-
.../loop-transforms/imperfect-loop-nest.c | 5 +-
.../gomp/loop-transforms/tile-1.c | 10 +-
.../gomp/loop-transforms/tile-2.c | 10 +-
.../gomp/loop-transforms/tile-3.c | 16 +-
.../gomp/loop-transforms/unroll-inner-2.c | 5 +-
gcc/testsuite/g++.dg/gomp/attrs-4.C | 2 +-
gcc/testsuite/g++.dg/gomp/for-1.C | 2 +-
gcc/testsuite/g++.dg/gomp/pr41967.C | 2 +-
gcc/testsuite/g++.dg/gomp/pr94512.C | 2 +-
libgomp/ChangeLog.omp | 10 +
.../testsuite/libgomp.c++/imperfect-class-1.C | 169 +++
.../testsuite/libgomp.c++/imperfect-class-2.C | 167 +++
.../testsuite/libgomp.c++/imperfect-class-3.C | 167 +++
.../libgomp.c++/imperfect-destructor.C | 135 ++
.../libgomp.c++/imperfect-template-1.C | 172 +++
.../libgomp.c++/imperfect-template-2.C | 170 +++
.../libgomp.c++/imperfect-template-3.C | 170 +++
25 files changed, 2200 insertions(+), 488 deletions(-)
create mode 100644 libgomp/testsuite/libgomp.c++/imperfect-class-1.C
create mode 100644 libgomp/testsuite/libgomp.c++/imperfect-class-2.C
create mode 100644 libgomp/testsuite/libgomp.c++/imperfect-class-3.C
create mode 100644 libgomp/testsuite/libgomp.c++/imperfect-destructor.C
create mode 100644 libgomp/testsuite/libgomp.c++/imperfect-template-1.C
create mode 100644 libgomp/testsuite/libgomp.c++/imperfect-template-2.C
create mode 100644 libgomp/testsuite/libgomp.c++/imperfect-template-3.C
diff --git a/gcc/cp/ChangeLog.omp b/gcc/cp/ChangeLog.omp
index 9dd2f3295e7..5f126c0c6c6 100644
--- a/gcc/cp/ChangeLog.omp
+++ b/gcc/cp/ChangeLog.omp
@@ -1,3 +1,41 @@
+2023-06-13 Sandra Loosemore <sandra@codesourcery.com>
+
+ * cp-tree.h (cp_convert_omp_range_for): Adjust declaration.
+ * parser.cc (struct omp_for_parse_data): New.
+ (cp_parser_postfix_expression): Diagnose calls to OpenMP runtime
+ in intervening code.
+ (check_omp_intervening_code): New.
+ (cp_parser_statement_seq_opt): Special-case nested OMP loops and
+ blocks in intervening code.
+ (cp_parser_iteration_statement): Reject loops in intervening code.
+ (cp_parser_omp_for_loop_init): Expand comments and tweak the
+ interface slightly to better distinguish input/output parameters.
+ (cp_parser_omp_range_for): Likewise.
+ (cp_convert_omp_range_for): Likewise.
+ (cp_parser_see_omp_loop_nest): New.
+ (cp_parser_omp_loop_nest): New, split from cp_parser_omp_for_loop
+ and largely rewritten. Add more comments.
+ (struct sit_data, substitute_in_tree_walker, substitute_in_tree):
+ New.
+ (fixup_blocks_walker): New.
+ (cp_parser_omp_for_loop): Rewrite to use recursive descent instead
+ of a loop. Add logic to reshuffle the bits of code collected
+ during parsing so intervening code gets moved to the loop body.
+ (cp_parser_omp_loop): Remove call to finish_omp_for_block, which
+ is now redundant.
+ (cp_parser_omp_simd): Likewise.
+ (cp_parser_omp_for): Likewise.
+ (cp_parser_omp_distribute): Likewise.
+ (cp_parser_oacc_loop): Likewise.
+ (cp_parser_omp_taskloop): Likewise.
+ (cp_parser_pragma): Reject OpenMP pragmas in intervening code.
+ * parser.h (struct cp_parser): Add omp_for_parse_state field.
+ * pt.cc (tsubst_omp_for_iterator): Adjust call to
+ cp_convert_omp_range_for.
+ * semantics.cc (struct fofb_data, finish_omp_for_block_walker): New.
+ (finish_omp_for_block): Allow variables to be bound in a BIND_EXPR
+ nested inside BIND instead of directly in BIND itself.
+
2023-06-12 Tobias Burnus <tobias@codesourcery.com>
Backported from mainline:
diff --git a/gcc/cp/cp-tree.h b/gcc/cp/cp-tree.h
index a14eb8d0b9a..b87039490dd 100644
--- a/gcc/cp/cp-tree.h
+++ b/gcc/cp/cp-tree.h
@@ -7279,7 +7279,7 @@ extern bool maybe_clone_body (tree);
/* In parser.cc */
extern tree cp_convert_range_for (tree, tree, tree, tree, unsigned int, bool,
unsigned short);
-extern void cp_convert_omp_range_for (tree &, vec<tree, va_gc> *, tree &,
+extern void cp_convert_omp_range_for (tree &, tree &, tree &,
tree &, tree &, tree &, tree &, tree &);
extern void cp_finish_omp_range_for (tree, tree);
extern bool parsing_nsdmi (void);
diff --git a/gcc/cp/parser.cc b/gcc/cp/parser.cc
index 06dbc77d5c2..e5fea44329a 100644
--- a/gcc/cp/parser.cc
+++ b/gcc/cp/parser.cc
@@ -2091,6 +2091,31 @@ struct cp_parser_expression_stack_entry
typedef struct cp_parser_expression_stack_entry
cp_parser_expression_stack[NUM_PREC_VALUES];
+/* Used for parsing OMP for loops. */
+struct omp_for_parse_data {
+ tree declv, condv, incrv, initv;
+ tree pre_body;
+ int count;
+ int depth;
+ location_t for_loc;
+ releasing_vec init_blockv;
+ releasing_vec body_blockv;
+ releasing_vec init_placeholderv;
+ releasing_vec body_placeholderv;
+ bool want_nested_loop : 1;
+ bool ordered : 1;
+ bool in_intervening_code : 1;
+ bool perfect_nesting_fail : 1;
+ bool fail : 1;
+ bool inscan : 1;
+ enum tree_code code;
+ tree orig_declv;
+ auto_vec<tree, 4> orig_inits;
+ tree clauses;
+ tree *cclauses;
+ tree ordered_cl;
+};
+
/* Prototypes. */
/* Constructors and destructors. */
@@ -2912,6 +2937,8 @@ static bool cp_parser_skip_up_to_closing_square_bracket
static bool cp_parser_skip_to_closing_square_bracket
(cp_parser *);
static size_t cp_parser_skip_balanced_tokens (cp_parser *, size_t);
+static bool cp_parser_see_omp_loop_nest (cp_parser *, enum tree_code, bool);
+static tree cp_parser_omp_loop_nest (cp_parser *, bool *);
// -------------------------------------------------------------------------- //
// Unevaluated Operand Guard
@@ -8013,12 +8040,22 @@ cp_parser_postfix_expression (cp_parser *parser, bool address_p, bool cast_p,
complain);
else
/* All other function calls. */
- postfix_expression
- = finish_call_expr (postfix_expression, &args,
- /*disallow_virtual=*/false,
- koenig_p,
- complain);
-
+ {
+ if (DECL_P (postfix_expression)
+ && parser->omp_for_parse_state
+ && parser->omp_for_parse_state->in_intervening_code
+ && omp_runtime_api_call (postfix_expression))
+ {
+ error_at (loc, "calls to the OpenMP runtime API are "
+ "not permitted in intervening code");
+ parser->omp_for_parse_state->fail = true;
+ }
+ postfix_expression
+ = finish_call_expr (postfix_expression, &args,
+ /*disallow_virtual=*/false,
+ koenig_p,
+ complain);
+ }
if (close_paren_loc != UNKNOWN_LOCATION)
postfix_expression.set_location (combined_loc);
@@ -12942,6 +12979,64 @@ cp_parser_compound_statement (cp_parser *parser, tree in_statement_expr,
return compound_stmt;
}
+/* Diagnose errors related to imperfectly nested loops in an OMP
+ loop construct. This function is called when such code is seen.
+ Only issue one such diagnostic no matter how much invalid
+ intervening code there is in the loop.
+ FIXME: maybe the location associated with the diagnostic should
+ be the current parser token instead of the location of the outer loop
+ nest. */
+
+static void
+check_omp_intervening_code (cp_parser *parser)
+{
+ struct omp_for_parse_data *omp_for_parse_state
+ = parser->omp_for_parse_state;
+ gcc_assert (omp_for_parse_state);
+
+ /* Only diagnose errors related to perfect nesting once. */
+ if (!omp_for_parse_state->perfect_nesting_fail)
+ {
+ if (omp_for_parse_state->code == OACC_LOOP)
+ {
+ error_at (omp_for_parse_state->for_loc,
+ "inner loops must be perfectly nested in "
+ "%<#pragma acc loop%>");
+ omp_for_parse_state->perfect_nesting_fail = true;
+ }
+ else if (omp_for_parse_state->ordered)
+ {
+ error_at (omp_for_parse_state->for_loc,
+ "inner loops must be perfectly nested with "
+ "%<ordered%> clause");
+ omp_for_parse_state->perfect_nesting_fail = true;
+ }
+ else if (omp_for_parse_state->inscan)
+ {
+ error_at (omp_for_parse_state->for_loc,
+ "inner loops must be perfectly nested with "
+ "%<reduction%> %<inscan%> clause");
+ omp_for_parse_state->perfect_nesting_fail = true;
+ }
+ else
+ {
+ tree c = omp_find_clause (omp_for_parse_state->clauses,
+ OMP_CLAUSE_TILE);
+ if (c &&
+ ((int) tree_to_uhwi (OMP_CLAUSE_TRANSFORM_LEVEL (c))
+ <= omp_for_parse_state->depth))
+ {
+ error_at (omp_for_parse_state->for_loc,
+ "inner loops must be perfectly nested "
+ "with %<tile%> directive");
+ omp_for_parse_state->perfect_nesting_fail = true;
+ }
+ }
+ if (omp_for_parse_state->perfect_nesting_fail)
+ omp_for_parse_state->fail = true;
+ }
+}
+
/* Parse an (optional) statement-seq.
statement-seq:
@@ -12951,6 +13046,9 @@ cp_parser_compound_statement (cp_parser *parser, tree in_statement_expr,
static void
cp_parser_statement_seq_opt (cp_parser* parser, tree in_statement_expr)
{
+ struct omp_for_parse_data *omp_for_parse_state
+ = parser->omp_for_parse_state;
+
/* Scan statements until there aren't any more. */
while (true)
{
@@ -12977,6 +13075,32 @@ cp_parser_statement_seq_opt (cp_parser* parser, tree in_statement_expr)
error_at (token->location, "%<else%> without a previous %<if%>");
}
}
+ else if (omp_for_parse_state
+ && cp_parser_see_omp_loop_nest (parser,
+ omp_for_parse_state->code,
+ false)
+ && omp_for_parse_state->want_nested_loop)
+ {
+ /* Special treatment for collapsed loop nests. */
+ omp_for_parse_state->depth++;
+ add_stmt (cp_parser_omp_loop_nest (parser, NULL));
+ omp_for_parse_state->depth--;
+ continue;
+ }
+ else if (omp_for_parse_state
+ && token->type != CPP_OPEN_BRACE)
+ {
+ /* Nested loops can only appear directly or nested in
+ compound statements. We have neither, so set the bit
+ to treat everything inside the subsequent statement
+ as intervening code instead. */
+ bool want_nested_loop = omp_for_parse_state->want_nested_loop;
+ omp_for_parse_state->want_nested_loop = false;
+ check_omp_intervening_code (parser);
+ cp_parser_statement (parser, in_statement_expr, true, NULL);
+ omp_for_parse_state->want_nested_loop = want_nested_loop;
+ continue;
+ }
/* Parse the statement. */
cp_parser_statement (parser, in_statement_expr, true, NULL);
@@ -14176,6 +14300,15 @@ cp_parser_iteration_statement (cp_parser* parser, bool *if_p, bool ivdep,
statement. */
in_statement = parser->in_statement;
+ /* Special case for OMP loop intervening code. Parsing of permitted
+ collapsed loop nests is handled elsewhere. */
+ if (parser->omp_for_parse_state)
+ {
+ error_at (token->location,
+ "loop not permitted in intervening code in OpenMP loop body");
+ parser->omp_for_parse_state->fail = true;
+ }
+
/* See what kind of keyword it is. */
keyword = token->keyword;
switch (keyword)
@@ -43327,7 +43460,19 @@ cp_parser_omp_for_incr (cp_parser *parser, tree decl)
return build2 (MODIFY_EXPR, TREE_TYPE (decl), decl, rhs);
}
-/* Parse the initialization statement of an OpenMP for loop.
+/* Parse the initialization statement of an OpenMP for loop. Range-for
+ is handled separately in cp_convert_omp_range_for.
+
+ On entry SL is the current statement list. Parsing of some forms
+ of initialization pops this list and stores its contents in either INIT
+ or THIS_PRE_BODY, and sets SL to null. Initialization for class
+ iterators is added directly to SL and it is not popped until later.
+
+ On return, DECL is set if the initialization is by binding the
+ iteration variable. If the initialization is by assignment, REAL_DECL
+ is set to point to a variable in an outer scope. ORIG_INIT is set
+ if the iteration variable is of class type; this is a copy saved for
+ error checking in finish_omp_for.
Return true if the resulting construct should have an
OMP_CLAUSE_PRIVATE added to it. */
@@ -43335,7 +43480,7 @@ cp_parser_omp_for_incr (cp_parser *parser, tree decl)
static tree
cp_parser_omp_for_loop_init (cp_parser *parser,
tree &this_pre_body,
- releasing_vec &for_block,
+ tree &sl,
tree &init,
tree &orig_init,
tree &decl,
@@ -43433,18 +43578,22 @@ cp_parser_omp_for_loop_init (cp_parser *parser,
asm_specification,
LOOKUP_ONLYCONVERTING);
orig_init = init;
+
+ /* In the case of a class iterator, do not pop sl here.
+ Both class initialization and finalization must happen in
+ the enclosing init block scope. For now set the init
+ expression to null; it'll be filled in properly in
+ finish_omp_for before stuffing it in the OMP_FOR. */
if (CLASS_TYPE_P (TREE_TYPE (decl)))
+ init = NULL_TREE;
+ else /* It is a parameterized type. */
{
- vec_safe_push (for_block, this_pre_body);
- init = NULL_TREE;
- }
- else
- {
- init = pop_stmt_list (this_pre_body);
+ init = pop_stmt_list (sl);
+ sl = NULL_TREE;
if (init && TREE_CODE (init) == STATEMENT_LIST)
{
tree_stmt_iterator i = tsi_start (init);
- /* Move lambda DECL_EXPRs to FOR_BLOCK. */
+ /* Move lambda DECL_EXPRs to the enclosing block. */
while (!tsi_end_p (i))
{
tree t = tsi_stmt (i);
@@ -43452,7 +43601,7 @@ cp_parser_omp_for_loop_init (cp_parser *parser,
&& TREE_CODE (DECL_EXPR_DECL (t)) == TYPE_DECL)
{
tsi_delink (&i);
- vec_safe_push (for_block, t);
+ add_stmt (t);
continue;
}
break;
@@ -43466,9 +43615,10 @@ cp_parser_omp_for_loop_init (cp_parser *parser,
}
}
}
- this_pre_body = NULL_TREE;
}
else
+ /* This is an initialized declaration of non-class,
+ non-parameterized type iteration variable. */
{
/* Consume '='. */
cp_lexer_consume_token (parser->lexer);
@@ -43482,6 +43632,8 @@ cp_parser_omp_for_loop_init (cp_parser *parser,
/*init_const_expr_p=*/false,
asm_specification,
LOOKUP_ONLYCONVERTING);
+ this_pre_body = pop_stmt_list (sl);
+ sl = NULL_TREE;
}
if (pushed_scope)
@@ -43553,14 +43705,21 @@ cp_parser_omp_for_loop_init (cp_parser *parser,
real_decl = TREE_OPERAND (init, 0);
}
}
+ this_pre_body = pop_stmt_list (sl);
+ sl = NULL_TREE;
}
return add_private_clause;
}
-/* Helper for cp_parser_omp_for_loop, handle one range-for loop. */
+/* Helper for cp_parser_omp_loop_nest, handle one range-for loop
+ including introducing new temporaries for the range start and end,
+ doing auto deduction, and processing decomposition variables.
+ This function is also called from pt.cc during template instantiation.
+ In that case SL is NULL_TREE, otherwise it is the current statement
+ list. */
void
-cp_convert_omp_range_for (tree &this_pre_body, vec<tree, va_gc> *for_block,
+cp_convert_omp_range_for (tree &this_pre_body, tree &sl,
tree &decl, tree &orig_decl, tree &init,
tree &orig_init, tree &cond, tree &incr)
{
@@ -43596,8 +43755,11 @@ cp_convert_omp_range_for (tree &this_pre_body, vec<tree, va_gc> *for_block,
cond = global_namespace;
incr = NULL_TREE;
orig_init = init;
- if (this_pre_body)
- this_pre_body = pop_stmt_list (this_pre_body);
+ if (sl)
+ {
+ this_pre_body = pop_stmt_list (sl);
+ sl = NULL_TREE;
+ }
return;
}
@@ -43677,11 +43839,7 @@ cp_convert_omp_range_for (tree &this_pre_body, vec<tree, va_gc> *for_block,
orig_decl = decl;
decl = begin;
- if (for_block)
- {
- vec_safe_push (for_block, this_pre_body);
- this_pre_body = NULL_TREE;
- }
+ /* Defer popping sl here. */
tree decomp_first_name = NULL_TREE;
unsigned decomp_cnt = 0;
@@ -43719,6 +43877,15 @@ cp_convert_omp_range_for (tree &this_pre_body, vec<tree, va_gc> *for_block,
}
}
+ /* The output ORIG_DECL is not a decl. Instead, it is a tree structure
+ that holds decls for variables implementing the iterator, represented
+ as a TREE_LIST whose TREE_CHAIN is a vector. The first two elements
+ of the vector are decls of scratch variables for the range start and
+ end that will eventually be bound in the implicit scope surrounding
+ the whole loop nest. The remaining elements are decls of derived
+ decomposition variables that are bound inside the loop body. This
+ structure is further mangled by finish_omp_for into the form required
+ for the OMP_FOR_ORIG_DECLS field of the OMP_FOR tree node. */
tree v = make_tree_vec (decomp_cnt + 3);
TREE_VEC_ELT (v, 0) = range_temp_decl;
TREE_VEC_ELT (v, 1) = end;
@@ -43977,22 +44144,608 @@ static int cp_parser_omp_nested_loop_transform_clauses (cp_parser *, tree &,
int, int,
const char *);
+/* Check that the next token starts a loop nest. Return true if yes,
+ otherwise diagnose an error if ERROR_P is true and return false. */
+static bool
+cp_parser_see_omp_loop_nest (cp_parser *parser, enum tree_code code,
+ bool error_p)
+{
+ if (code == OACC_LOOP)
+ {
+ if (cp_lexer_next_token_is_keyword (parser->lexer, RID_FOR))
+ return true;
+ if (error_p)
+ cp_parser_error (parser, "for statement expected");
+ }
+ else
+ {
+ if (cp_lexer_next_token_is_keyword (parser->lexer, RID_FOR)
+ || (cp_parser_pragma_kind (cp_lexer_peek_token (parser->lexer))
+ == PRAGMA_OMP_UNROLL)
+ || (cp_parser_pragma_kind (cp_lexer_peek_token (parser->lexer))
+ == PRAGMA_OMP_TILE))
+ return true;
+ if (error_p)
+ cp_parser_error (parser, "loop nest expected");
+ }
+ return false;
+}
+
+/* This function parses a single level of a loop nest, invoking itself
+ recursively if necessary.
+
+ loop-nest :: for (...) loop-body
+ | loop-transformation-construct
+ | generated-canonical-loop
+ loop-body :: loop-nest
+ | { [intervening-code] loop-body [intervening-code] }
+ | final-loop-body
+ intervening-code :: structured-block-sequence
+ final-loop-body :: structured-block
+
+ For a collapsed loop nest, only a single OMP_FOR is built, pulling out
+ all the iterator information from the inner loops into vectors in the
+ parser->omp_for_parse_state structure.
+
+ In the "range for" case, it is transformed into a regular "for" iterator
+ by introducing some temporary variables for the begin/end,
+ as well as bindings of the actual iteration variables which are
+ injected into the body of the loop.
+
+ Initialization code for iterator variables may end up either in the
+ init vector (simple assignments), in omp_for_parse_state->pre_body
+ (decl_exprs for iterators bound in the for statement), or in the
+ scope surrounding this level of loop initialization.
+
+ The scopes of class iterator variables and their finalizers need to
+ be adjusted after parsing so that all of the initialization happens
+ in a scope surrounding all of the intervening and body code. For
+ this reason we separately store the initialization and body blocks
+ for each level of loops in the omp_for_parse_state structure and
+ reassemble/reorder them in cp_parser_omp_for. See additional
+ comments there about the use of placeholders, etc. */
+
+static tree
+cp_parser_omp_loop_nest (cp_parser *parser, bool *if_p)
+{
+ tree decl, cond, incr, init;
+ tree orig_init, real_decl, orig_decl;
+ tree init_block, body_block;
+ tree init_placeholder, body_placeholder;
+ tree init_scope;
+ tree this_pre_body = NULL_TREE;
+ bool moreloops;
+ unsigned char save_in_statement;
+ tree add_private_clause = NULL_TREE;
+ location_t loc;
+ bool is_range_for = false;
+ tree sl = NULL_TREE;
+ struct omp_for_parse_data *omp_for_parse_state
+ = parser->omp_for_parse_state;
+ gcc_assert (omp_for_parse_state);
+ int depth = omp_for_parse_state->depth;
+
+ /* Handle loop transformations first. Note that when we get here
+ omp_for_parse_state->depth has already been incremented to indicate
+ the depth of the *next* loop, not the level of the loop body the
+ transformation directive appears in. */
+
+ if ((cp_parser_pragma_kind (cp_lexer_peek_token (parser->lexer))
+ == PRAGMA_OMP_UNROLL)
+ || (cp_parser_pragma_kind (cp_lexer_peek_token (parser->lexer))
+ == PRAGMA_OMP_TILE))
+ {
+ int count = omp_for_parse_state->count;
+ int more = cp_parser_omp_nested_loop_transform_clauses (
+ parser, omp_for_parse_state->clauses,
+ depth, count - depth, "loop collapse");
+ if (depth + more > count)
+ {
+ count = depth + more;
+ omp_for_parse_state->count = count;
+ omp_for_parse_state->declv
+ = grow_tree_vec (omp_for_parse_state->declv, count);
+ omp_for_parse_state->initv
+ = grow_tree_vec (omp_for_parse_state->initv, count);
+ omp_for_parse_state->condv
+ = grow_tree_vec (omp_for_parse_state->condv, count);
+ omp_for_parse_state->incrv
+ = grow_tree_vec (omp_for_parse_state->incrv, count);
+ if (omp_for_parse_state->orig_declv)
+ omp_for_parse_state->orig_declv
+ = grow_tree_vec (omp_for_parse_state->orig_declv, count);
+ }
+ if (cp_parser_see_omp_loop_nest (parser, omp_for_parse_state->code,
+ true))
+ return cp_parser_omp_loop_nest (parser, if_p);
+ else
+ {
+ /* FIXME: Better error recovery here? */
+ omp_for_parse_state->fail = true;
+ return NULL_TREE;
+ }
+ }
+
+ /* We have already matched the FOR token but not consumed it yet. */
+ gcc_assert (cp_lexer_next_token_is_keyword (parser->lexer, RID_FOR));
+ loc = cp_lexer_consume_token (parser->lexer)->location;
+
+ /* Forbid break/continue in the loop initializer, condition, and
+ increment expressions. */
+ save_in_statement = parser->in_statement;
+ parser->in_statement = IN_OMP_BLOCK;
+
+ /* We are not in intervening code now. */
+ omp_for_parse_state->in_intervening_code = false;
+
+ /* Don't create location wrapper nodes within an OpenMP "for"
+ statement. */
+ auto_suppress_location_wrappers sentinel;
+
+ matching_parens parens;
+ if (!parens.require_open (parser))
+ return NULL;
+
+ init = orig_init = decl = real_decl = orig_decl = NULL_TREE;
+
+ init_placeholder = build_stmt (input_location, EXPR_STMT,
+ integer_zero_node);
+ vec_safe_push (omp_for_parse_state->init_placeholderv, init_placeholder);
+
+ /* The init_block acts as a container for this level of loop goo. */
+ init_block = push_stmt_list ();
+ vec_safe_push (omp_for_parse_state->init_blockv, init_block);
+
+ /* Wrap a scope around this entire level of loop to hold bindings
+ of loop iteration variables. We can't insert them directly
+ in the containing scope because that would cause their visibility to
+ be incorrect with respect to intervening code after this loop.
+ We will combine the nested init_scopes in postprocessing after the
+ entire loop is parsed. */
+ init_scope = begin_compound_stmt (0);
+
+ /* Now we need another level of statement list container to capture the
+ initialization (and possible finalization) bits. In some cases this
+ container may be popped off during initializer parsing to store code in
+ INIT or THIS_PRE_BODY, depending on the form of initialization. If
+ we have a class iterator we will pop it at the end of parsing this
+ level, so the cleanups are handled correctly. */
+ sl = push_stmt_list ();
+
+ if (omp_for_parse_state->code != OACC_LOOP && cxx_dialect >= cxx11)
+ {
+ /* Save tokens so that we can put them back. */
+ cp_lexer_save_tokens (parser->lexer);
+
+ /* Look for ':' that is not nested in () or {}. */
+ is_range_for
+ = (cp_parser_skip_to_closing_parenthesis_1 (parser,
+ /*recovering=*/false,
+ CPP_COLON,
+ /*consume_paren=*/
+ false) == -1);
+
+ /* Roll back the tokens we skipped. */
+ cp_lexer_rollback_tokens (parser->lexer);
+
+ if (is_range_for)
+ {
+ bool saved_colon_corrects_to_scope_p
+ = parser->colon_corrects_to_scope_p;
+
+ /* A colon is used in range-based for. */
+ parser->colon_corrects_to_scope_p = false;
+
+ /* Parse the declaration. */
+ cp_parser_simple_declaration (parser,
+ /*function_definition_allowed_p=*/
+ false, &decl);
+ parser->colon_corrects_to_scope_p
+ = saved_colon_corrects_to_scope_p;
+
+ cp_parser_require (parser, CPP_COLON, RT_COLON);
+
+ init = cp_parser_range_for (parser, NULL_TREE, NULL_TREE, decl,
+ false, 0, true);
+
+ cp_convert_omp_range_for (this_pre_body, sl, decl,
+ orig_decl, init, orig_init,
+ cond, incr);
+
+ if (omp_for_parse_state->ordered_cl)
+ error_at (OMP_CLAUSE_LOCATION (omp_for_parse_state->ordered_cl),
+ "%<ordered%> clause with parameter on "
+ "range-based %<for%> loop");
+
+ goto parse_close_paren;
+ }
+ }
+
+ add_private_clause
+ = cp_parser_omp_for_loop_init (parser, this_pre_body, sl,
+ init, orig_init, decl, real_decl);
+
+ cp_parser_require (parser, CPP_SEMICOLON, RT_SEMICOLON);
+
+ /* If the iteration variable was introduced via a declaration in the
+ for statement, DECL points at it. Otherwise DECL is null and
+ REAL_DECL is a variable previously declared in an outer scope.
+ Make REAL_DECL point at the iteration variable no matter where it
+ was introduced. */
+ if (decl)
+ real_decl = decl;
+
+ /* Some clauses treat iterator variables specially. */
+ if (omp_for_parse_state->cclauses != NULL
+ && omp_for_parse_state->cclauses[C_OMP_CLAUSE_SPLIT_PARALLEL] != NULL
+ && real_decl != NULL_TREE
+ && omp_for_parse_state->code != OMP_LOOP)
+ {
+ tree *c;
+ for (c = &(omp_for_parse_state->cclauses[C_OMP_CLAUSE_SPLIT_PARALLEL]);
+ *c ; )
+ if (OMP_CLAUSE_CODE (*c) == OMP_CLAUSE_FIRSTPRIVATE
+ && OMP_CLAUSE_DECL (*c) == real_decl)
+ {
+ error_at (loc, "iteration variable %qD"
+ " should not be firstprivate", real_decl);
+ *c = OMP_CLAUSE_CHAIN (*c);
+ }
+ else if (OMP_CLAUSE_CODE (*c) == OMP_CLAUSE_LASTPRIVATE
+ && OMP_CLAUSE_DECL (*c) == real_decl)
+ {
+ /* Move lastprivate (decl) clause to OMP_FOR_CLAUSES. */
+ tree l = *c;
+ *c = OMP_CLAUSE_CHAIN (*c);
+ if (omp_for_parse_state->code == OMP_SIMD)
+ {
+ OMP_CLAUSE_CHAIN (l)
+ = omp_for_parse_state->cclauses[C_OMP_CLAUSE_SPLIT_FOR];
+ omp_for_parse_state->cclauses[C_OMP_CLAUSE_SPLIT_FOR] = l;
+ }
+ else
+ {
+ OMP_CLAUSE_CHAIN (l) = omp_for_parse_state->clauses;
+ omp_for_parse_state->clauses = l;
+ }
+ add_private_clause = NULL_TREE;
+ }
+ else
+ {
+ if (OMP_CLAUSE_CODE (*c) == OMP_CLAUSE_PRIVATE
+ && OMP_CLAUSE_DECL (*c) == real_decl)
+ add_private_clause = NULL_TREE;
+ c = &OMP_CLAUSE_CHAIN (*c);
+ }
+ }
+
+ if (add_private_clause)
+ {
+ tree c;
+ for (c = omp_for_parse_state->clauses; c ; c = OMP_CLAUSE_CHAIN (c))
+ {
+ if ((OMP_CLAUSE_CODE (c) == OMP_CLAUSE_PRIVATE
+ || OMP_CLAUSE_CODE (c) == OMP_CLAUSE_LASTPRIVATE)
+ && OMP_CLAUSE_DECL (c) == decl)
+ break;
+ else if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_FIRSTPRIVATE
+ && OMP_CLAUSE_DECL (c) == decl)
+ error_at (loc, "iteration variable %qD "
+ "should not be firstprivate",
+ decl);
+ else if ((OMP_CLAUSE_CODE (c) == OMP_CLAUSE_REDUCTION
+ || OMP_CLAUSE_CODE (c) == OMP_CLAUSE_IN_REDUCTION)
+ && OMP_CLAUSE_DECL (c) == decl)
+ error_at (loc, "iteration variable %qD should not be reduction",
+ decl);
+ }
+ if (c == NULL)
+ {
+ if ((omp_for_parse_state->code == OMP_SIMD
+ && omp_for_parse_state->count != 1)
+ || omp_for_parse_state->code == OMP_LOOP)
+ c = build_omp_clause (loc, OMP_CLAUSE_LASTPRIVATE);
+ else if (omp_for_parse_state->code != OMP_SIMD)
+ c = build_omp_clause (loc, OMP_CLAUSE_PRIVATE);
+ else
+ c = build_omp_clause (loc, OMP_CLAUSE_LINEAR);
+ OMP_CLAUSE_DECL (c) = add_private_clause;
+ c = finish_omp_clauses (c, C_ORT_OMP);
+ if (c)
+ {
+ OMP_CLAUSE_CHAIN (c) = omp_for_parse_state->clauses;
+ omp_for_parse_state->clauses = c;
+ /* For linear, signal that we need to fill up
+ the so far unknown linear step. */
+ if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_LINEAR)
+ OMP_CLAUSE_LINEAR_STEP (c) = NULL_TREE;
+ }
+ }
+ }
+
+ cond = NULL;
+ if (cp_lexer_next_token_is_not (parser->lexer, CPP_SEMICOLON))
+ cond = cp_parser_omp_for_cond (parser, decl, omp_for_parse_state->code);
+ cp_parser_require (parser, CPP_SEMICOLON, RT_SEMICOLON);
+
+ incr = NULL;
+ if (cp_lexer_next_token_is_not (parser->lexer, CPP_CLOSE_PAREN))
+ {
+ /* If decl is an iterator, preserve the operator on decl
+ until finish_omp_for. */
+ if (real_decl
+ && ((processing_template_decl
+ && (TREE_TYPE (real_decl) == NULL_TREE
+ || !INDIRECT_TYPE_P (TREE_TYPE (real_decl))))
+ || CLASS_TYPE_P (TREE_TYPE (real_decl))))
+ incr = cp_parser_omp_for_incr (parser, real_decl);
+ else
+ incr = cp_parser_expression (parser);
+ protected_set_expr_location_if_unset (incr, input_location);
+ }
+
+ parse_close_paren:
+ if (!parens.require_close (parser))
+ cp_parser_skip_to_closing_parenthesis (parser, /*recovering=*/true,
+ /*or_comma=*/false,
+ /*consume_paren=*/true);
+
+ /* We've parsed all the for (...) stuff now. Store the bits. */
+ TREE_VEC_ELT (omp_for_parse_state->declv, depth) = decl;
+ TREE_VEC_ELT (omp_for_parse_state->initv, depth) = init;
+ TREE_VEC_ELT (omp_for_parse_state->condv, depth) = cond;
+ TREE_VEC_ELT (omp_for_parse_state->incrv, depth) = incr;
+ if (orig_init)
+ {
+ omp_for_parse_state->orig_inits.safe_grow_cleared (depth + 1, true);
+ omp_for_parse_state->orig_inits[depth] = orig_init;
+ }
+ if (orig_decl)
+ {
+ if (!omp_for_parse_state->orig_declv)
+ omp_for_parse_state->orig_declv
+ = copy_node (omp_for_parse_state->declv);
+ TREE_VEC_ELT (omp_for_parse_state->orig_declv, depth) = orig_decl;
+ }
+ else if (omp_for_parse_state->orig_declv)
+ TREE_VEC_ELT (omp_for_parse_state->orig_declv, depth) = decl;
+ if (this_pre_body)
+ append_to_statement_list_force (this_pre_body,
+ &(omp_for_parse_state->pre_body));
+
+ /* Start a nested block for the loop body. */
+ body_placeholder = build_stmt (input_location, EXPR_STMT,
+ integer_zero_node);
+ vec_safe_push (omp_for_parse_state->body_placeholderv, body_placeholder);
+ body_block = push_stmt_list ();
+ vec_safe_push (omp_for_parse_state->body_blockv, body_block);
+
+ moreloops = depth < omp_for_parse_state->count - 1;
+ omp_for_parse_state->want_nested_loop = moreloops;
+ if (moreloops
+ && (cp_lexer_next_token_is_keyword (parser->lexer, RID_FOR)
+ || (cp_parser_pragma_kind (cp_lexer_peek_token (parser->lexer))
+ == PRAGMA_OMP_UNROLL)
+ || (cp_parser_pragma_kind (cp_lexer_peek_token (parser->lexer))
+ == PRAGMA_OMP_TILE)))
+ {
+ omp_for_parse_state->depth++;
+ add_stmt (cp_parser_omp_loop_nest (parser, if_p));
+ omp_for_parse_state->depth--;
+ }
+ else if (moreloops
+ && cp_lexer_next_token_is (parser->lexer, CPP_OPEN_BRACE))
+ {
+ /* This is the open brace in the loop-body grammar production. Rather
+ than trying to special-case braces, just parse it as a compound
+ statement and handle the nested loop-body case there. Note that
+ when we see a further open brace inside the compound statement
+ loop-body, we don't know whether it is the start of intervening
+ code that is a compound statement, or a level of braces
+ surrounding a nested loop-body. Use the WANT_NESTED_LOOP state
+ bit to ensure we have only one nested loop at each level. */
+
+ omp_for_parse_state->in_intervening_code = true;
+ cp_parser_compound_statement (parser, NULL, BCS_NORMAL, false);
+ omp_for_parse_state->in_intervening_code = false;
+
+ if (omp_for_parse_state->want_nested_loop)
+ {
+ /* We have already parsed the whole loop body and not found a
+ nested loop. */
+ error_at (omp_for_parse_state->for_loc,
+ "not enough nested loops");
+ omp_for_parse_state->fail = true;
+ }
+ if_p = NULL;
+ }
+ else
+ {
+ /* This is the final-loop-body case in the grammar: we have something
+ that is not a FOR and not an open brace. */
+ if (moreloops)
+ {
+ /* If we were expecting a nested loop, give an error and mark
+ that parsing has failed, and try to recover by parsing the
+ body as regular code without further collapsing. */
+ error_at (omp_for_parse_state->for_loc,
+ "not enough nested loops");
+ omp_for_parse_state->fail = true;
+ }
+ parser->in_statement = IN_OMP_FOR;
+
+ /* Generate the parts of range for that belong in the loop body,
+ to be executed on every iteration. This includes setting the
+ user-declared decomposition variables from the compiler-generated
+ temporaries that are the real iteration variables for OMP_FOR.
+ FIXME: Not sure if this is correct with respect to visibility
+ of the variables from intervening code. However, putting this
+ code in each level of loop instead of all around the innermost
+ body also makes the decomposition variables visible to the
+ inner for init/bound/step exressions, which is not supposed to
+ happen and causes test failures. */
+ if (omp_for_parse_state->orig_declv)
+ for (int i = 0; i < omp_for_parse_state->count; i++)
+ {
+ tree o = TREE_VEC_ELT (omp_for_parse_state->orig_declv, i);
+ tree d = TREE_VEC_ELT (omp_for_parse_state->declv, i);
+ if (o != d)
+ cp_finish_omp_range_for (o, d);
+ }
+
+ /* Now parse the final-loop-body for the innermost loop. */
+ parser->omp_for_parse_state = NULL;
+ if (omp_for_parse_state->inscan)
+ cp_parser_omp_scan_loop_body (parser);
+ else
+ cp_parser_statement (parser, NULL_TREE, false, if_p);
+ parser->omp_for_parse_state = omp_for_parse_state;
+ }
+ parser->in_statement = save_in_statement;
+ omp_for_parse_state->want_nested_loop = false;
+ omp_for_parse_state->in_intervening_code = true;
+
+ /* Pop and remember the body block. Add the body placeholder
+ to the surrounding statement list instead. This is just a unique
+ token that will be replaced when we reassemble the generated
+ code for the entire omp for statement. */
+ body_block = pop_stmt_list (body_block);
+ omp_for_parse_state->body_blockv[depth] = body_block;
+ add_stmt (body_placeholder);
+
+ /* Pop and remember the init block. */
+ if (sl)
+ add_stmt (pop_stmt_list (sl));
+ finish_compound_stmt (init_scope);
+ init_block = pop_stmt_list (init_block);
+ omp_for_parse_state->init_blockv[depth] = init_block;
+
+ /* Return the init placeholder rather than the remembered init block.
+ Again, this is just a unique cookie that will be used to reassemble
+ code pieces when the entire omp for statement has been parsed. */
+ return init_placeholder;
+}
+
+/* Helpers used for relinking tree structures: In tree rooted at
+ CONTEXT, replace ORIG with REPLACEMENT. If FLATTEN is true, try to combine
+ nested BIND_EXPRs. Gives an assertion if it fails to find ORIG. */
+
+struct sit_data {
+ tree orig;
+ tree repl;
+ bool flatten;
+};
+
+static tree
+substitute_in_tree_walker (tree *tp, int *walk_subtrees ATTRIBUTE_UNUSED, void *dp)
+{
+ struct sit_data *sit = (struct sit_data *)dp;
+ if (*tp == sit->orig)
+ {
+ *tp = sit->repl;
+ return *tp;
+ }
+ /* Remove redundant BIND_EXPRs with no bindings even when not specifically
+ trying to flatten. */
+ else if (TREE_CODE (*tp) == BIND_EXPR
+ && BIND_EXPR_BODY (*tp) == sit->orig
+ && !BIND_EXPR_VARS (*tp)
+ && (sit->flatten || TREE_CODE (sit->repl) == BIND_EXPR))
+ {
+ *tp = sit->repl;
+ return *tp;
+ }
+ else if (sit->flatten
+ && TREE_CODE (*tp) == BIND_EXPR
+ && TREE_CODE (sit->repl) == BIND_EXPR)
+ {
+ if (BIND_EXPR_BODY (*tp) == sit->orig)
+ {
+ /* Merge binding lists for two directly nested BIND_EXPRs,
+ keeping the outer one. */
+ BIND_EXPR_VARS (*tp) = chainon (BIND_EXPR_VARS (*tp),
+ BIND_EXPR_VARS (sit->repl));
+ BIND_EXPR_BODY (*tp) = BIND_EXPR_BODY (sit->repl);
+ return *tp;
+ }
+ else if (TREE_CODE (BIND_EXPR_BODY (*tp)) == STATEMENT_LIST)
+ /* There might be a statement list containing cleanup_points
+ etc between the two levels of BIND_EXPR. We can still merge
+ them, again keeping the outer BIND_EXPR. */
+ for (tree_stmt_iterator i = tsi_start (BIND_EXPR_BODY (*tp));
+ !tsi_end_p (i); ++i)
+ {
+ tree *p = tsi_stmt_ptr (i);
+ if (*p == sit->orig)
+ {
+ BIND_EXPR_VARS (*tp) = chainon (BIND_EXPR_VARS (*tp),
+ BIND_EXPR_VARS (sit->repl));
+ *p = BIND_EXPR_BODY (sit->repl);
+ return *tp;
+ }
+ }
+ }
+ return NULL;
+}
+
+static void
+substitute_in_tree (tree *context, tree orig, tree repl, bool flatten)
+{
+ struct sit_data data;
+
+ gcc_assert (*context && orig && repl);
+ if (TREE_CODE (repl) == BIND_EXPR && !BIND_EXPR_VARS (repl))
+ repl = BIND_EXPR_BODY (repl);
+ data.orig = orig;
+ data.repl = repl;
+ data.flatten = flatten;
+
+ tree result = cp_walk_tree (context, substitute_in_tree_walker,
+ (void *)&data, NULL);
+ gcc_assert (result != NULL_TREE);
+}
+
+/* Walker to patch up the BLOCK_NODE hierarchy after the above surgery.
+ *DP is is the parent block. */
+
+static tree
+fixup_blocks_walker (tree *tp, int *walk_subtrees, void *dp)
+{
+ tree superblock = *(tree *)dp;
+
+ if (TREE_CODE (*tp) == BIND_EXPR)
+ {
+ tree block = BIND_EXPR_BLOCK (*tp);
+ if (superblock)
+ {
+ BLOCK_SUPERCONTEXT (block) = superblock;
+ BLOCK_CHAIN (block) = BLOCK_SUBBLOCKS (superblock);
+ BLOCK_SUBBLOCKS (superblock) = block;
+ }
+ BLOCK_SUBBLOCKS (block) = NULL_TREE;
+ cp_walk_tree (&BIND_EXPR_BODY (*tp), fixup_blocks_walker,
+ (void *)&block, NULL);
+ *walk_subtrees = 0;
+ }
+
+ return NULL;
+}
+
/* Parse the restricted form of the for statement allowed by OpenMP. */
static tree
cp_parser_omp_for_loop (cp_parser *parser, enum tree_code code, tree clauses,
tree *cclauses, bool *if_p)
{
- tree init, orig_init, cond, incr, body, decl, pre_body = NULL_TREE, ret;
- tree orig_decl;
- tree real_decl, initv, condv, incrv, declv, orig_declv;
- tree this_pre_body, cl, ordered_cl = NULL_TREE;
- bool collapse_err = false;
- int i, collapse = 1, ordered = 0, count, nbraces = 0;
- releasing_vec for_block;
- auto_vec<tree, 4> orig_inits;
+ tree ret;
+ tree cl, ordered_cl = NULL_TREE;
+ int collapse = 1, ordered = 0;
+ unsigned int count;
bool oacc_tiling = false;
bool inscan = false;
+ struct omp_for_parse_data data;
+ struct omp_for_parse_data *save_data = parser->omp_for_parse_state;
+ tree result;
location_t loc_first = cp_lexer_peek_token (parser->lexer)->location;
for (cl = clauses; cl; cl = OMP_CLAUSE_CHAIN (cl))
@@ -44023,7 +44776,6 @@ cp_parser_omp_for_loop (cp_parser *parser, enum tree_code code, tree clauses,
ordered = collapse;
}
-
gcc_assert (oacc_tiling || (collapse >= 1 && ordered >= 0));
count = ordered ? ordered : collapse;
@@ -44034,7 +44786,7 @@ cp_parser_omp_for_loop (cp_parser *parser, enum tree_code code, tree clauses,
directives. There can be several such directives, but the tiling
depth of the outer ones may not be larger than the depth of the
innermost directive. */
- int omp_tile_depth = 0;
+ unsigned int omp_tile_depth = 0;
for (tree c = clauses; c; c = TREE_CHAIN (c))
{
if (OMP_CLAUSE_CODE (c) != OMP_CLAUSE_TILE)
@@ -44044,397 +44796,115 @@ cp_parser_omp_for_loop (cp_parser *parser, enum tree_code code, tree clauses,
}
count = MAX (count, omp_tile_depth);
- declv = make_tree_vec (count);
- initv = make_tree_vec (count);
- condv = make_tree_vec (count);
- incrv = make_tree_vec (count);
- orig_declv = NULL_TREE;
-
- for (i = 0; i < count; i++)
- {
- int bracecount = 0;
- tree add_private_clause = NULL_TREE;
- location_t loc;
-
- if (!cp_lexer_next_token_is_keyword (parser->lexer, RID_FOR))
- {
- if (!collapse_err)
- cp_parser_error (parser, "for statement expected");
- return NULL;
- }
- loc = cp_lexer_consume_token (parser->lexer)->location;
-
- /* Don't create location wrapper nodes within an OpenMP "for"
- statement. */
- auto_suppress_location_wrappers sentinel;
-
- matching_parens parens;
- if (!parens.require_open (parser))
- return NULL;
-
- init = orig_init = decl = real_decl = orig_decl = NULL_TREE;
- this_pre_body = push_stmt_list ();
-
- if (code != OACC_LOOP && cxx_dialect >= cxx11)
- {
- /* Save tokens so that we can put them back. */
- cp_lexer_save_tokens (parser->lexer);
-
- /* Look for ':' that is not nested in () or {}. */
- bool is_range_for
- = (cp_parser_skip_to_closing_parenthesis_1 (parser,
- /*recovering=*/false,
- CPP_COLON,
- /*consume_paren=*/
- false) == -1);
-
- /* Roll back the tokens we skipped. */
- cp_lexer_rollback_tokens (parser->lexer);
-
- if (is_range_for)
- {
- bool saved_colon_corrects_to_scope_p
- = parser->colon_corrects_to_scope_p;
-
- /* A colon is used in range-based for. */
- parser->colon_corrects_to_scope_p = false;
-
- /* Parse the declaration. */
- cp_parser_simple_declaration (parser,
- /*function_definition_allowed_p=*/
- false, &decl);
- parser->colon_corrects_to_scope_p
- = saved_colon_corrects_to_scope_p;
-
- cp_parser_require (parser, CPP_COLON, RT_COLON);
-
- init = cp_parser_range_for (parser, NULL_TREE, NULL_TREE, decl,
- false, 0, true);
-
- cp_convert_omp_range_for (this_pre_body, for_block, decl,
- orig_decl, init, orig_init,
- cond, incr);
- if (this_pre_body)
- {
- if (pre_body)
- {
- tree t = pre_body;
- pre_body = push_stmt_list ();
- add_stmt (t);
- add_stmt (this_pre_body);
- pre_body = pop_stmt_list (pre_body);
- }
- else
- pre_body = this_pre_body;
- }
-
- if (ordered_cl)
- error_at (OMP_CLAUSE_LOCATION (ordered_cl),
- "%<ordered%> clause with parameter on "
- "range-based %<for%> loop");
-
- goto parse_close_paren;
- }
- }
-
- add_private_clause
- = cp_parser_omp_for_loop_init (parser, this_pre_body, for_block,
- init, orig_init, decl, real_decl);
-
- cp_parser_require (parser, CPP_SEMICOLON, RT_SEMICOLON);
- if (this_pre_body)
- {
- this_pre_body = pop_stmt_list (this_pre_body);
- if (pre_body)
- {
- tree t = pre_body;
- pre_body = push_stmt_list ();
- add_stmt (t);
- add_stmt (this_pre_body);
- pre_body = pop_stmt_list (pre_body);
- }
- else
- pre_body = this_pre_body;
- }
-
- if (decl)
- real_decl = decl;
- if (cclauses != NULL
- && cclauses[C_OMP_CLAUSE_SPLIT_PARALLEL] != NULL
- && real_decl != NULL_TREE
- && code != OMP_LOOP)
- {
- tree *c;
- for (c = &cclauses[C_OMP_CLAUSE_SPLIT_PARALLEL]; *c ; )
- if (OMP_CLAUSE_CODE (*c) == OMP_CLAUSE_FIRSTPRIVATE
- && OMP_CLAUSE_DECL (*c) == real_decl)
- {
- error_at (loc, "iteration variable %qD"
- " should not be firstprivate", real_decl);
- *c = OMP_CLAUSE_CHAIN (*c);
- }
- else if (OMP_CLAUSE_CODE (*c) == OMP_CLAUSE_LASTPRIVATE
- && OMP_CLAUSE_DECL (*c) == real_decl)
- {
- /* Move lastprivate (decl) clause to OMP_FOR_CLAUSES. */
- tree l = *c;
- *c = OMP_CLAUSE_CHAIN (*c);
- if (code == OMP_SIMD)
- {
- OMP_CLAUSE_CHAIN (l) = cclauses[C_OMP_CLAUSE_SPLIT_FOR];
- cclauses[C_OMP_CLAUSE_SPLIT_FOR] = l;
- }
- else
- {
- OMP_CLAUSE_CHAIN (l) = clauses;
- clauses = l;
- }
- add_private_clause = NULL_TREE;
- }
- else
- {
- if (OMP_CLAUSE_CODE (*c) == OMP_CLAUSE_PRIVATE
- && OMP_CLAUSE_DECL (*c) == real_decl)
- add_private_clause = NULL_TREE;
- c = &OMP_CLAUSE_CHAIN (*c);
- }
- }
-
- if (add_private_clause)
- {
- tree c;
- for (c = clauses; c ; c = OMP_CLAUSE_CHAIN (c))
- {
- if ((OMP_CLAUSE_CODE (c) == OMP_CLAUSE_PRIVATE
- || OMP_CLAUSE_CODE (c) == OMP_CLAUSE_LASTPRIVATE)
- && OMP_CLAUSE_DECL (c) == decl)
- break;
- else if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_FIRSTPRIVATE
- && OMP_CLAUSE_DECL (c) == decl)
- error_at (loc, "iteration variable %qD "
- "should not be firstprivate",
- decl);
- else if ((OMP_CLAUSE_CODE (c) == OMP_CLAUSE_REDUCTION
- || OMP_CLAUSE_CODE (c) == OMP_CLAUSE_IN_REDUCTION)
- && OMP_CLAUSE_DECL (c) == decl)
- error_at (loc, "iteration variable %qD should not be reduction",
- decl);
- }
- if (c == NULL)
- {
- if ((code == OMP_SIMD && collapse != 1) || code == OMP_LOOP)
- c = build_omp_clause (loc, OMP_CLAUSE_LASTPRIVATE);
- else if (code != OMP_SIMD)
- c = build_omp_clause (loc, OMP_CLAUSE_PRIVATE);
- else
- c = build_omp_clause (loc, OMP_CLAUSE_LINEAR);
- OMP_CLAUSE_DECL (c) = add_private_clause;
- c = finish_omp_clauses (c, C_ORT_OMP);
- if (c)
- {
- OMP_CLAUSE_CHAIN (c) = clauses;
- clauses = c;
- /* For linear, signal that we need to fill up
- the so far unknown linear step. */
- if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_LINEAR)
- OMP_CLAUSE_LINEAR_STEP (c) = NULL_TREE;
- }
- }
- }
-
- cond = NULL;
- if (cp_lexer_next_token_is_not (parser->lexer, CPP_SEMICOLON))
- cond = cp_parser_omp_for_cond (parser, decl, code);
- cp_parser_require (parser, CPP_SEMICOLON, RT_SEMICOLON);
-
- incr = NULL;
- if (cp_lexer_next_token_is_not (parser->lexer, CPP_CLOSE_PAREN))
- {
- /* If decl is an iterator, preserve the operator on decl
- until finish_omp_for. */
- if (real_decl
- && ((processing_template_decl
- && (TREE_TYPE (real_decl) == NULL_TREE
- || !INDIRECT_TYPE_P (TREE_TYPE (real_decl))))
- || CLASS_TYPE_P (TREE_TYPE (real_decl))))
- incr = cp_parser_omp_for_incr (parser, real_decl);
- else
- incr = cp_parser_expression (parser);
- protected_set_expr_location_if_unset (incr, input_location);
- }
-
- parse_close_paren:
- if (!parens.require_close (parser))
- cp_parser_skip_to_closing_parenthesis (parser, /*recovering=*/true,
- /*or_comma=*/false,
- /*consume_paren=*/true);
-
- TREE_VEC_ELT (declv, i) = decl;
- TREE_VEC_ELT (initv, i) = init;
- TREE_VEC_ELT (condv, i) = cond;
- TREE_VEC_ELT (incrv, i) = incr;
- if (orig_init)
- {
- orig_inits.safe_grow_cleared (i + 1, true);
- orig_inits[i] = orig_init;
- }
- if (orig_decl)
- {
- if (!orig_declv)
- orig_declv = copy_node (declv);
- TREE_VEC_ELT (orig_declv, i) = orig_decl;
- }
- else if (orig_declv)
- TREE_VEC_ELT (orig_declv, i) = decl;
-
- if (i == count - 1)
- break;
-
- /* FIXME: OpenMP 3.0 draft isn't very clear on what exactly is allowed
- in between the collapsed for loops to be still considered perfectly
- nested. Hopefully the final version clarifies this.
- For now handle (multiple) {'s and empty statements. */
- cp_parser_parse_tentatively (parser);
- for (;;)
- {
- cp_token *tok = cp_lexer_peek_token (parser->lexer);
- if (cp_parser_is_keyword (tok, RID_FOR))
- break;
- else if (tok->type == CPP_OPEN_BRACE)
- {
- cp_lexer_consume_token (parser->lexer);
- bracecount++;
- }
- else if (bracecount && tok->type == CPP_SEMICOLON)
- cp_lexer_consume_token (parser->lexer);
- else if (cp_parser_pragma_kind (tok) == PRAGMA_OMP_UNROLL
- || cp_parser_pragma_kind (tok) == PRAGMA_OMP_TILE)
- {
- int depth = cp_parser_omp_nested_loop_transform_clauses (
- parser, clauses, i + 1, count - i - 1, "loop collapse");
-
- /* Adjust the loop nest depth to the requirements of the
- loop transformations. The collapse will be reduced
- to value requested by the "collapse" and "ordered"
- clauses after the execution of the loop transformations
- in the middle end. */
- if (i + 1 + depth > count)
- {
- count = i + 1 + depth;
- if (declv)
- declv = grow_tree_vec (declv, count);
- initv = grow_tree_vec (initv, count);
- condv = grow_tree_vec (condv, count);
- incrv = grow_tree_vec (incrv, count);
- if (orig_declv)
- declv = grow_tree_vec (orig_declv, count);
- }
- }
- else
- {
- loc = tok->location;
- error_at (loc, "not enough for loops to collapse");
- collapse_err = true;
- cp_parser_abort_tentative_parse (parser);
- declv = NULL_TREE;
- break;
- }
- }
+ if (!cp_parser_see_omp_loop_nest (parser, code, true))
+ return NULL;
- if (declv)
- {
- cp_parser_parse_definitely (parser);
- nbraces += bracecount;
- }
+ /* Initialize parse state for recursive descent. */
+ data.declv = make_tree_vec (count);
+ data.initv = make_tree_vec (count);
+ data.condv = make_tree_vec (count);
+ data.incrv = make_tree_vec (count);
+ data.pre_body = NULL_TREE;
+ data.for_loc = cp_lexer_peek_token (parser->lexer)->location;
+ data.count = count;
+ data.depth = 0;
+ data.want_nested_loop = true;
+ data.ordered = ordered > 0;
+ data.in_intervening_code = false;
+ data.perfect_nesting_fail = false;
+ data.fail = false;
+ data.inscan = inscan;
+ data.code = code;
+ data.orig_declv = NULL_TREE;
+ data.clauses = clauses;
+ data.cclauses = cclauses;
+ data.ordered_cl = ordered_cl;
+ parser->omp_for_parse_state = &data;
+
+ cp_parser_omp_loop_nest (parser, if_p);
+
+ /* Bomb out early if there was an error (not enough loops, etc). */
+ if (data.fail || data.declv == NULL_TREE)
+ {
+ parser->omp_for_parse_state = save_data;
+ return NULL_TREE;
}
- if (nbraces)
- if_p = NULL;
-
- /* Note that we saved the original contents of this flag when we entered
- the structured block, and so we don't need to re-save it here. */
- parser->in_statement = IN_OMP_FOR;
+ /* Relink the init and body blocks that were built during parsing. At
+ this point we have a structure nested like
+ init 0
+ body 0
+ init 1
+ body 1
+ init 2
+ body 2
+ and we want to turn it into
+ init 0
+ init 1
+ init 2
+ omp_for
+ body 0
+ body 1
+ body 2
+ We also need to flatten the init blocks, as some code for later
+ processing of combined directives gets confused otherwise. */
+
+ count = data.count;
+ gcc_assert (vec_safe_length (data.init_blockv) == count);
+ gcc_assert (vec_safe_length (data.body_blockv) == count);
+ gcc_assert (vec_safe_length (data.init_placeholderv) == count);
+ gcc_assert (vec_safe_length (data.body_placeholderv) == count);
+
+ /* Do the substitution from the inside out. */
+ for (unsigned int i = count - 1; i > 0; i--)
+ {
+ substitute_in_tree (&(data.body_blockv[i-1]),
+ data.init_placeholderv[i],
+ data.body_blockv[i], false);
+ substitute_in_tree (&(data.init_blockv[i-1]),
+ data.body_placeholderv[i-1],
+ data.init_blockv[i], true);
+ }
+
+ /* Generate the OMP_FOR. Note finish_omp_for adds the OMP_FOR
+ (and possibly other stuff) to the current statement list but
+ returns a pointer to the OMP_FOR itself, or null in case of error. */
+ result = push_stmt_list ();
+ ret = finish_omp_for (loc_first, code, data.declv, data.orig_declv,
+ data.initv, data.condv, data.incrv,
+ data.body_blockv[0],
+ data.pre_body, &data.orig_inits, data.clauses);
+ result = pop_stmt_list (result);
- /* Note that the grammar doesn't call for a structured block here,
- though the loop as a whole is a structured block. */
- if (orig_declv)
+ if (ret)
{
- body = begin_omp_structured_block ();
- for (i = 0; i < count; i++)
- if (TREE_VEC_ELT (orig_declv, i) != TREE_VEC_ELT (declv, i))
- cp_finish_omp_range_for (TREE_VEC_ELT (orig_declv, i),
- TREE_VEC_ELT (declv, i));
- }
- else
- body = push_stmt_list ();
- if (inscan)
- cp_parser_omp_scan_loop_body (parser);
- else
- cp_parser_statement (parser, NULL_TREE, false, if_p);
- if (orig_declv)
- body = finish_omp_structured_block (body);
- else
- body = pop_stmt_list (body);
+ /* Splice the omp_for into the nest of init blocks. */
+ substitute_in_tree (&(data.init_blockv[0]),
+ data.body_placeholderv[count - 1],
+ result, true);
- if (declv == NULL_TREE)
- ret = NULL_TREE;
- else
- ret = finish_omp_for (loc_first, code, declv, orig_declv, initv, condv,
- incrv, body, pre_body, &orig_inits, clauses);
+ /* Some later processing for combined directives assumes
+ that the BIND_EXPR containing range for variables appears
+ at top level in the OMP_FOR body. Fix that up if it's
+ not the case, e.g. because there is intervening code. */
+ if (code != OACC_LOOP)
+ finish_omp_for_block (data.init_blockv[0], ret);
- while (nbraces)
- {
- if (cp_lexer_next_token_is (parser->lexer, CPP_CLOSE_BRACE))
- {
- cp_lexer_consume_token (parser->lexer);
- nbraces--;
- }
- else if (cp_lexer_next_token_is (parser->lexer, CPP_SEMICOLON))
- cp_lexer_consume_token (parser->lexer);
- else if (cp_parser_pragma_kind (cp_lexer_peek_token (parser->lexer))
- == PRAGMA_OMP_UNROLL
- || cp_parser_pragma_kind (cp_lexer_peek_token (parser->lexer))
- == PRAGMA_OMP_TILE)
- {
- int depth =
- cp_parser_omp_nested_loop_transform_clauses (parser, clauses,
- i + 1, count - i -1,
- "loop collapse");
- if (i + 1 + depth > count)
- {
- count = i + 1 + depth;
- if (declv)
- declv = grow_tree_vec (declv, count);
- initv = grow_tree_vec (initv, count);
- condv = grow_tree_vec (condv, count);
- incrv = grow_tree_vec (incrv, count);
- if (orig_declv)
- declv = grow_tree_vec (orig_declv, count);
- }
- }
- else
+ /* Clean up the block subblock/superblock links. Per comment in
+ begin_compound_stmt, "we don't build BLOCK nodes when processing
+ templates", so skip this step in that case. */
+ if (!processing_template_decl)
{
- if (!collapse_err)
- {
- error_at (cp_lexer_peek_token (parser->lexer)->location,
- "collapsed loops not perfectly nested");
- }
- collapse_err = true;
- cp_parser_statement_seq_opt (parser, NULL);
- if (cp_lexer_next_token_is (parser->lexer, CPP_EOF))
- break;
+ tree superblock = NULL_TREE;
+ cp_walk_tree (&data.init_blockv[0], fixup_blocks_walker,
+ (void *)&superblock, NULL);
}
- }
- while (!for_block->is_empty ())
- {
- tree t = for_block->pop ();
- if (TREE_CODE (t) == STATEMENT_LIST)
- add_stmt (pop_stmt_list (t));
- else
- add_stmt (t);
+ /* Finally record the result. */
+ add_stmt (data.init_blockv[0]);
}
+ parser->omp_for_parse_state = save_data;
return ret;
}
@@ -44493,7 +44963,7 @@ cp_parser_omp_loop (cp_parser *parser, cp_token *pragma_tok,
ret = cp_parser_omp_for_loop (parser, OMP_LOOP, clauses, cclauses, if_p);
cp_parser_end_omp_structured_block (parser, save);
- add_stmt (finish_omp_for_block (finish_omp_structured_block (sb), ret));
+ add_stmt (finish_omp_structured_block (sb));
return ret;
}
@@ -44542,7 +45012,7 @@ cp_parser_omp_simd (cp_parser *parser, cp_token *pragma_tok,
ret = cp_parser_omp_for_loop (parser, OMP_SIMD, clauses, cclauses, if_p);
cp_parser_end_omp_structured_block (parser, save);
- add_stmt (finish_omp_for_block (finish_omp_structured_block (sb), ret));
+ add_stmt (finish_omp_structured_block (sb));
return ret;
}
@@ -44644,7 +45114,7 @@ cp_parser_omp_for (cp_parser *parser, cp_token *pragma_tok,
ret = cp_parser_omp_for_loop (parser, OMP_FOR, clauses, cclauses, if_p);
cp_parser_end_omp_structured_block (parser, save);
- add_stmt (finish_omp_for_block (finish_omp_structured_block (sb), ret));
+ add_stmt (finish_omp_structured_block (sb));
return ret;
}
@@ -45492,7 +45962,7 @@ cp_parser_omp_distribute (cp_parser *parser, cp_token *pragma_tok,
ret = cp_parser_omp_for_loop (parser, OMP_DISTRIBUTE, clauses, NULL, if_p);
cp_parser_end_omp_structured_block (parser, save);
- add_stmt (finish_omp_for_block (finish_omp_structured_block (sb), ret));
+ add_stmt (finish_omp_structured_block (sb));
return ret;
}
@@ -46792,7 +47262,15 @@ cp_parser_oacc_loop (cp_parser *parser, cp_token *pragma_tok, char *p_name,
if (stmt && stmt != error_mark_node)
OACC_LOOP_COMBINED (stmt) = is_combined;
cp_parser_end_omp_structured_block (parser, save);
- add_stmt (finish_omp_structured_block (block));
+
+ /* Later processing of combined acc loop constructs gets confused
+ by an extra level of empty nested BIND_EXPRs, so flatten them. */
+ block = finish_omp_structured_block (block);
+ if (TREE_CODE (block) == BIND_EXPR
+ && TREE_CODE (BIND_EXPR_BODY (block)) == BIND_EXPR
+ && !BIND_EXPR_VARS (block))
+ block = BIND_EXPR_BODY (block);
+ add_stmt (block);
return stmt;
}
@@ -49566,7 +50044,7 @@ cp_parser_omp_taskloop (cp_parser *parser, cp_token *pragma_tok,
if_p);
cp_parser_end_omp_structured_block (parser, save);
- add_stmt (finish_omp_for_block (finish_omp_structured_block (sb), ret));
+ add_stmt (finish_omp_structured_block (sb));
return ret;
}
@@ -50347,6 +50825,17 @@ cp_parser_pragma (cp_parser *parser, enum pragma_context context, bool *if_p)
parser->lexer->in_pragma = true;
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");
+ parser->omp_for_parse_state->fail = true;
+ cp_parser_skip_to_pragma_eol (parser, pragma_tok);
+ return false;
+ }
if (id != PRAGMA_OMP_DECLARE && id != PRAGMA_OACC_ROUTINE)
cp_ensure_no_omp_declare_simd (parser);
switch (id)
diff --git a/gcc/cp/parser.h b/gcc/cp/parser.h
index e261d7e16e4..6cbb9a8e031 100644
--- a/gcc/cp/parser.h
+++ b/gcc/cp/parser.h
@@ -435,6 +435,9 @@ struct GTY(()) cp_parser {
specification, if any, or UNKNOWN_LOCATION otherwise. */
location_t innermost_linkage_specification_location;
+ /* Pointer to state for parsing omp_loops. Managed by
+ cp_parser_omp_for_loop in parser.cc and not used outside that file. */
+ struct omp_for_parse_data * GTY((skip)) omp_for_parse_state;
};
/* In parser.cc */
diff --git a/gcc/cp/pt.cc b/gcc/cp/pt.cc
index 67d194092ea..b1ce6b0927f 100644
--- a/gcc/cp/pt.cc
+++ b/gcc/cp/pt.cc
@@ -18467,7 +18467,8 @@ tsubst_omp_for_iterator (tree t, int i, tree declv, tree &orig_declv,
tree this_pre_body = NULL_TREE;
tree orig_init = NULL_TREE;
tree orig_decl = NULL_TREE;
- cp_convert_omp_range_for (this_pre_body, NULL, decl, orig_decl, init,
+ tree init_sl = NULL_TREE;
+ cp_convert_omp_range_for (this_pre_body, init_sl, decl, orig_decl, init,
orig_init, cond, incr);
if (orig_decl)
{
diff --git a/gcc/cp/semantics.cc b/gcc/cp/semantics.cc
index b1c6b831bb4..e7bda6fa060 100644
--- a/gcc/cp/semantics.cc
+++ b/gcc/cp/semantics.cc
@@ -11084,47 +11084,71 @@ finish_omp_for (location_t locus, enum tree_code code, tree declv,
return omp_for;
}
-/* Fix up range for decls. Those decls were pushed into BIND's BIND_EXPR_VARS
- and need to be moved into the BIND_EXPR inside of the OMP_FOR's body. */
+/* Code walker for finish_omp_for_block: extract binding of DP->var
+ from its current block and move it to a new BIND_EXPR DP->b
+ surrounding the body of DP->omp_for. */
+struct fofb_data {
+ tree var;
+ tree b;
+ tree omp_for;
+};
+
+static tree
+finish_omp_for_block_walker (tree *tp, int *walk_subtrees, void *dp)
+{
+ struct fofb_data *fofb = (struct fofb_data *)dp;
+ if (TREE_CODE (*tp) == BIND_EXPR)
+ for (tree *p = &BIND_EXPR_VARS (*tp); *p; p = &DECL_CHAIN (*p))
+ {
+ if (*p == fofb->var)
+ {
+ *p = DECL_CHAIN (*p);
+ if (fofb->b == NULL_TREE)
+ {
+ fofb->b = make_node (BLOCK);
+ fofb->b = build3 (BIND_EXPR, void_type_node, NULL_TREE,
+ OMP_FOR_BODY (fofb->omp_for), fofb->b);
+ TREE_SIDE_EFFECTS (fofb->b) = 1;
+ OMP_FOR_BODY (fofb->omp_for) = fofb->b;
+ }
+ DECL_CHAIN (fofb->var) = BIND_EXPR_VARS (fofb->b);
+ BIND_EXPR_VARS (fofb->b) = fofb->var;
+ BLOCK_VARS (BIND_EXPR_BLOCK (fofb->b)) = fofb->var;
+ BLOCK_VARS (BIND_EXPR_BLOCK (*tp)) = BIND_EXPR_VARS (*tp);
+ return *tp;
+ }
+ }
+ if (TREE_CODE (*tp) != BIND_EXPR && TREE_CODE (*tp) != STATEMENT_LIST)
+ *walk_subtrees = false;
+ return NULL_TREE;
+}
+
+/* Fix up range for decls. Those decls were pushed into BIND's
+ BIND_EXPR_VARS, or that of a nested BIND_EXPR inside its body,
+ and need to be moved into a new BIND_EXPR surrounding OMP_FOR's body
+ so that processing of combined loop directives can find them. */
tree
finish_omp_for_block (tree bind, tree omp_for)
{
if (omp_for == NULL_TREE
|| !OMP_FOR_ORIG_DECLS (omp_for)
- || bind == NULL_TREE
- || TREE_CODE (bind) != BIND_EXPR)
+ || bind == NULL_TREE)
return bind;
- tree b = NULL_TREE;
+ struct fofb_data fofb;
+ fofb.b = NULL_TREE;
+ fofb.omp_for = omp_for;
for (int i = 0; i < TREE_VEC_LENGTH (OMP_FOR_INIT (omp_for)); i++)
if (TREE_CODE (TREE_VEC_ELT (OMP_FOR_ORIG_DECLS (omp_for), i)) == TREE_LIST
&& TREE_CHAIN (TREE_VEC_ELT (OMP_FOR_ORIG_DECLS (omp_for), i)))
{
tree v = TREE_CHAIN (TREE_VEC_ELT (OMP_FOR_ORIG_DECLS (omp_for), i));
- gcc_assert (BIND_EXPR_BLOCK (bind)
- && (BIND_EXPR_VARS (bind)
- == BLOCK_VARS (BIND_EXPR_BLOCK (bind))));
for (int j = 2; j < TREE_VEC_LENGTH (v); j++)
- for (tree *p = &BIND_EXPR_VARS (bind); *p; p = &DECL_CHAIN (*p))
- {
- if (*p == TREE_VEC_ELT (v, j))
- {
- tree var = *p;
- *p = DECL_CHAIN (*p);
- if (b == NULL_TREE)
- {
- b = make_node (BLOCK);
- b = build3 (BIND_EXPR, void_type_node, NULL_TREE,
- OMP_FOR_BODY (omp_for), b);
- TREE_SIDE_EFFECTS (b) = 1;
- OMP_FOR_BODY (omp_for) = b;
- }
- DECL_CHAIN (var) = BIND_EXPR_VARS (b);
- BIND_EXPR_VARS (b) = var;
- BLOCK_VARS (BIND_EXPR_BLOCK (b)) = var;
- }
- }
- BLOCK_VARS (BIND_EXPR_BLOCK (bind)) = BIND_EXPR_VARS (bind);
+ {
+ fofb.var = TREE_VEC_ELT (v, j);
+ cp_walk_tree (&bind, finish_omp_for_block_walker,
+ (void *)&fofb, NULL);
+ }
}
return bind;
}
diff --git a/gcc/testsuite/ChangeLog.omp b/gcc/testsuite/ChangeLog.omp
index 408fdf4d164..d42813684e2 100644
--- a/gcc/testsuite/ChangeLog.omp
+++ b/gcc/testsuite/ChangeLog.omp
@@ -1,3 +1,16 @@
+2023-06-13 Sandra Loosemore <sandra@codesourcery.com>
+
+ * c-c++-common/goacc/tile-2.c: Adjust expected error patterns.
+ * c-c++-common/gomp/loop-transforms/imperfect-loop-nest: Likewise.
+ * c-c++-common/gomp/loop-transforms/tile-1.c: Likewise.
+ * c-c++-common/gomp/loop-transforms/tile-2.c: Likewise.
+ * c-c++-common/gomp/loop-transforms/tile-3.c: Likewise.
+ * c-c++-common/gomp/loop-transforms/unroll-inner-2.c: Likewise.
+ * g++.dg/gomp/attrs-4.C: Likewise.
+ * g++.dg/gomp/for-1.C: Likewise.
+ * g++.dg/gomp/pr41967.C: Likewise.
+ * g++.dg/gomp/pr94512.C: Likewise.
+
2023-06-13 Sandra Loosemore <sandra@codesourcery.com>
* c-c++-common/goacc/collapse-1.c: Update for new C error behavior.
diff --git a/gcc/testsuite/c-c++-common/goacc/tile-2.c b/gcc/testsuite/c-c++-common/goacc/tile-2.c
index 98abc903bdc..dc306703260 100644
--- a/gcc/testsuite/c-c++-common/goacc/tile-2.c
+++ b/gcc/testsuite/c-c++-common/goacc/tile-2.c
@@ -3,8 +3,8 @@ int main ()
#pragma acc parallel
{
#pragma acc loop tile (*,*)
- for (int ix = 0; ix < 30; ix++) /* { dg-error "not enough" "" { target c } } */
- ; /* { dg-error "not enough" "" { target c++ } } */
+ for (int ix = 0; ix < 30; ix++) /* { dg-error "not enough" } */
+ ;
#pragma acc loop tile (*,*)
for (int ix = 0; ix < 30; ix++)
diff --git a/gcc/testsuite/c-c++-common/gomp/loop-transforms/imperfect-loop-nest.c b/gcc/testsuite/c-c++-common/gomp/loop-transforms/imperfect-loop-nest.c
index 3679755d03d..22a1250ed6c 100644
--- a/gcc/testsuite/c-c++-common/gomp/loop-transforms/imperfect-loop-nest.c
+++ b/gcc/testsuite/c-c++-common/gomp/loop-transforms/imperfect-loop-nest.c
@@ -1,11 +1,10 @@
void test ()
{
#pragma omp tile sizes (2,4,6)
- for (unsigned i = 0; i < 10; i++) /* { dg-error "inner loops must be perfectly nested" { target c } } */
+ for (unsigned i = 0; i < 10; i++) /* { dg-error "inner loops must be perfectly nested" } */
for (unsigned j = 0; j < 10; j++)
{
- float intervening_decl = 0; /* { dg-bogus "not enough for loops to collapse" "TODO C/C++ imperfect loop nest handling" { xfail c++ } } */
-
+ float intervening_decl = 0;
#pragma omp unroll partial(2)
for (unsigned k = 0; k < 10; k++);
}
diff --git a/gcc/testsuite/c-c++-common/gomp/loop-transforms/tile-1.c b/gcc/testsuite/c-c++-common/gomp/loop-transforms/tile-1.c
index 70e58d6fc56..f10aea4c27f 100644
--- a/gcc/testsuite/c-c++-common/gomp/loop-transforms/tile-1.c
+++ b/gcc/testsuite/c-c++-common/gomp/loop-transforms/tile-1.c
@@ -110,11 +110,9 @@ test ()
dummy (i);
#pragma omp tile sizes(1, 2, 3)
- for (int i = 0; i < 100; ++i) /* { dg-error {not enough nested loops} "" { target c } } */
+ for (int i = 0; i < 100; ++i) /* { dg-error {not enough nested loops} } */
for (int j = 0; j < 100; ++j)
dummy (i);
- /* { dg-error {not enough for loops to collapse} "" { target c++ } .-1 } */
- /* { dg-error {'i' was not declared in this scope} "" { target c++ } .-2 } */
#pragma omp tile sizes(1)
for (int i = 0; i < 100; ++i)
@@ -133,21 +131,19 @@ test ()
}
#pragma omp tile sizes(1, 2)
- for (int i = 0; i < 100; ++i) /* { dg-error {inner loops must be perfectly nested} "" { target c } } */
+ for (int i = 0; i < 100; ++i) /* { dg-error {inner loops must be perfectly nested} } */
{
dummy (i);
- /* { dg-error {not enough for loops to collapse} "" { target c++ } .-1 } */
for (int j = 0; j < 100; ++j)
dummy (j);
}
#pragma omp tile sizes(1, 2)
- for (int i = 0; i < 100; ++i) /* { dg-error {inner loops must be perfectly nested} "" { target c } } */
+ for (int i = 0; i < 100; ++i) /* { dg-error {inner loops must be perfectly nested} } */
{
for (int j = 0; j < 100; ++j)
dummy (j);
dummy (i);
- /* { dg-error {collapsed loops not perfectly nested} "" { target c++ } .-1 } */
}
int s;
diff --git a/gcc/testsuite/c-c++-common/gomp/loop-transforms/tile-2.c b/gcc/testsuite/c-c++-common/gomp/loop-transforms/tile-2.c
index 6b27f9630e2..45b9bb1a3ed 100644
--- a/gcc/testsuite/c-c++-common/gomp/loop-transforms/tile-2.c
+++ b/gcc/testsuite/c-c++-common/gomp/loop-transforms/tile-2.c
@@ -132,11 +132,9 @@ test ()
#pragma omp parallel for
#pragma omp tile sizes(1, 2, 3)
- for (int i = 0; i < 100; ++i) /* { dg-error {not enough nested loops} "" { target c } } */
+ for (int i = 0; i < 100; ++i) /* { dg-error {not enough nested loops} } */
for (int j = 0; j < 100; ++j)
dummy (i);
- /* { dg-error {not enough for loops to collapse} "" { target c++ } .-1 } */
- /* { dg-error {'i' was not declared in this scope} "" { target c++ } .-2 } */
#pragma omp parallel for
#pragma omp tile sizes(1)
@@ -158,22 +156,20 @@ test ()
#pragma omp parallel for
#pragma omp tile sizes(1, 2)
- for (int i = 0; i < 100; ++i) /* { dg-error {inner loops must be perfectly nested} "" { target c } } */
+ for (int i = 0; i < 100; ++i) /* { dg-error {inner loops must be perfectly nested} } */
{
dummy (i);
- /* { dg-error {not enough for loops to collapse} "" { target c++ } .-1 } */
for (int j = 0; j < 100; ++j)
dummy (j);
}
#pragma omp parallel for
#pragma omp tile sizes(1, 2)
- for (int i = 0; i < 100; ++i) /* { dg-error {inner loops must be perfectly nested} "" { target c } } */
+ for (int i = 0; i < 100; ++i) /* { dg-error {inner loops must be perfectly nested} } */
{
for (int j = 0; j < 100; ++j)
dummy (j);
dummy (i);
- /* { dg-error {collapsed loops not perfectly nested} "" { target c++ } .-1 } */
}
#pragma omp parallel for
diff --git a/gcc/testsuite/c-c++-common/gomp/loop-transforms/tile-3.c b/gcc/testsuite/c-c++-common/gomp/loop-transforms/tile-3.c
index db913e26d10..d46ea750f00 100644
--- a/gcc/testsuite/c-c++-common/gomp/loop-transforms/tile-3.c
+++ b/gcc/testsuite/c-c++-common/gomp/loop-transforms/tile-3.c
@@ -36,11 +36,9 @@ test ()
#pragma omp for collapse(3)
#pragma omp tile sizes(1, 2) /* { dg-error {nesting depth left after this transformation too low for loop collapse} } */
- for (int i = 0; i < 100; ++i) /* { dg-error {not enough nested loops} "" { target c } } */
+ for (int i = 0; i < 100; ++i) /* { dg-error {not enough nested loops} } */
for (int j = 0; j < 100; ++j)
dummy (i);
- /* { dg-error {not enough for loops to collapse} "" { target c++ } .-1 } */
- /* { dg-error {'i' was not declared in this scope} "" { target c++ } .-2 } */
#pragma omp for collapse(1)
#pragma omp tile sizes(1)
@@ -51,23 +49,20 @@ test ()
#pragma omp for collapse(2)
#pragma omp tile sizes(1, 2)
#pragma omp tile sizes(1) /* { dg-error {nesting depth left after this transformation too low for outer transformation} } */
- for (int i = 0; i < 100; ++i) /* { dg-error {not enough nested loops} "" { target c } } */
+ for (int i = 0; i < 100; ++i) /* { dg-error {not enough nested loops} } */
dummy (i);
- /* { dg-error {not enough for loops to collapse} "" { target c++ } .-1 } */
#pragma omp for collapse(2)
#pragma omp tile sizes(1, 2)
#pragma omp tile sizes(1, 2)
- for (int i = 0; i < 100; ++i) /* { dg-error {not enough nested loops} "" { target c } } */
+ for (int i = 0; i < 100; ++i) /* { dg-error {not enough nested loops} } */
dummy (i);
- /* { dg-error {not enough for loops to collapse} "" { target c++ } .-1 } */
#pragma omp for collapse(2)
#pragma omp tile sizes(5, 6)
#pragma omp tile sizes(1, 2, 3)
- for (int i = 0; i < 100; ++i) /* { dg-error {not enough nested loops} "" { target c } } */
+ for (int i = 0; i < 100; ++i) /* { dg-error {not enough nested loops} } */
dummy (i);
- /* { dg-error {not enough for loops to collapse} "" { target c++ } .-1 } */
#pragma omp for collapse(1)
#pragma omp tile sizes(1)
@@ -100,10 +95,9 @@ test ()
#pragma omp for collapse(3)
#pragma omp tile sizes(1, 2) /* { dg-error {nesting depth left after this transformation too low for loop collapse} } */
#pragma omp tile sizes(1, 2)
- for (int i = 0; i < 100; ++i) /* { dg-error {not enough nested loops} "" { target c } } */
+ for (int i = 0; i < 100; ++i) /* { dg-error {not enough nested loops} } */
for (int j = 0; j < 100; ++j)
dummy (i);
- /* { dg-error {not enough for loops to collapse} "" { target c++ } .-1 } */
#pragma omp for collapse(3)
#pragma omp tile sizes(5, 6) /* { dg-error {nesting depth left after this transformation too low for loop collapse} } */
diff --git a/gcc/testsuite/c-c++-common/gomp/loop-transforms/unroll-inner-2.c b/gcc/testsuite/c-c++-common/gomp/loop-transforms/unroll-inner-2.c
index d3ba7282a9f..2082009a385 100644
--- a/gcc/testsuite/c-c++-common/gomp/loop-transforms/unroll-inner-2.c
+++ b/gcc/testsuite/c-c++-common/gomp/loop-transforms/unroll-inner-2.c
@@ -13,11 +13,10 @@ test ()
dummy (i);
#pragma omp target parallel for collapse(2)
- for (int i = -300; i != 100; ++i) /* { dg-error {not enough nested loops} "" { target c } } */
+ for (int i = -300; i != 100; ++i) /* { dg-error {not enough nested loops} } */
#pragma omp tile sizes(2, 3)
for (int j = 0; j != 100; ++j)
- dummy (i); /* { dg-error {not enough for loops to collapse} "" { target c++ } } */
-/* { dg-error {'i' was not declared in this scope} "" { target c++ } .-1 } */
+ dummy (i);
#pragma omp target parallel for collapse(2)
for (int i = -300; i != 100; ++i)
diff --git a/gcc/testsuite/g++.dg/gomp/attrs-4.C b/gcc/testsuite/g++.dg/gomp/attrs-4.C
index 005add826ba..a730ad7db50 100644
--- a/gcc/testsuite/g++.dg/gomp/attrs-4.C
+++ b/gcc/testsuite/g++.dg/gomp/attrs-4.C
@@ -49,7 +49,7 @@ foo (int x)
for (int i = 0; i < 16; i++)
;
#pragma omp for
- [[omp::directive (master)]] // { dg-error "for statement expected before '\\\[' token" }
+ [[omp::directive (master)]] // { dg-error "loop nest expected before '\\\[' token" }
;
#pragma omp target teams
[[omp::directive (parallel)]] // { dg-error "mixing OpenMP directives with attribute and pragma syntax on the same statement" }
diff --git a/gcc/testsuite/g++.dg/gomp/for-1.C b/gcc/testsuite/g++.dg/gomp/for-1.C
index f8bb9d54727..0e042fd1381 100644
--- a/gcc/testsuite/g++.dg/gomp/for-1.C
+++ b/gcc/testsuite/g++.dg/gomp/for-1.C
@@ -24,7 +24,7 @@ void foo (int j, int k)
// Malformed parallel loops.
#pragma omp for
- i = 0; // { dg-error "for statement expected" }
+ i = 0; // { dg-error "loop nest expected" }
for ( ; i < 10; )
{
baz (i);
diff --git a/gcc/testsuite/g++.dg/gomp/pr41967.C b/gcc/testsuite/g++.dg/gomp/pr41967.C
index 0eb489e8bee..7b59f831fe0 100644
--- a/gcc/testsuite/g++.dg/gomp/pr41967.C
+++ b/gcc/testsuite/g++.dg/gomp/pr41967.C
@@ -11,7 +11,7 @@ foo ()
{
for (int j = 0; j < 5; ++j)
++sum;
- ++sum; // { dg-error "collapsed loops not perfectly nested" }
+ ++sum;
}
return sum;
}
diff --git a/gcc/testsuite/g++.dg/gomp/pr94512.C b/gcc/testsuite/g++.dg/gomp/pr94512.C
index 8ba0e65795f..1d5cf150987 100644
--- a/gcc/testsuite/g++.dg/gomp/pr94512.C
+++ b/gcc/testsuite/g++.dg/gomp/pr94512.C
@@ -8,7 +8,7 @@ void
bar ()
{
#pragma omp parallel master taskloop
- foo (); // { dg-error "for statement expected before" }
+ foo (); // { dg-error "loop nest expected before" }
}
void
diff --git a/libgomp/ChangeLog.omp b/libgomp/ChangeLog.omp
index 5ce5052a8dc..29ef68843bc 100644
--- a/libgomp/ChangeLog.omp
+++ b/libgomp/ChangeLog.omp
@@ -1,3 +1,13 @@
+2023-06-13 Sandra Loosemore <sandra@codesourcery.com>
+
+ * testsuite/libgomp.c++/imperfect-class-1.C: New.
+ * testsuite/libgomp.c++/imperfect-class-2.C: New.
+ * testsuite/libgomp.c++/imperfect-class-3.C: New.
+ * testsuite/libgomp.c++/imperfect-destructor.C: New.
+ * testsuite/libgomp.c++/imperfect-template-1.C: New.
+ * testsuite/libgomp.c++/imperfect-template-2.C: New.
+ * testsuite/libgomp.c++/imperfect-template-3.C: New.
+
2023-06-13 Sandra Loosemore <sandra@codesourcery.com>
Frederik Harwath <frederik@codesourcery.com>
diff --git a/libgomp/testsuite/libgomp.c++/imperfect-class-1.C b/libgomp/testsuite/libgomp.c++/imperfect-class-1.C
new file mode 100644
index 00000000000..3c39c42c107
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c++/imperfect-class-1.C
@@ -0,0 +1,169 @@
+// { dg-do run }
+// Test that class iterators and imperfectly-nested loops work together.
+// This variant tests initialization by assignment.
+
+typedef __PTRDIFF_TYPE__ ptrdiff_t;
+typedef int T;
+typedef int S;
+
+class I
+{
+public:
+ typedef ptrdiff_t difference_type;
+ I ();
+ ~I ();
+ I (T *);
+ I (const I &);
+ T &operator * ();
+ T *operator -> ();
+ T &operator [] (const difference_type &) const;
+ I &operator = (const I &);
+ I &operator ++ ();
+ I operator ++ (int);
+ I &operator -- ();
+ I operator -- (int);
+ I &operator += (const difference_type &);
+ I &operator -= (const difference_type &);
+ I operator + (const difference_type &) const;
+ I operator - (const difference_type &) const;
+ friend bool operator == (I &, I &);
+ friend bool operator == (const I &, const I &);
+ friend bool operator < (I &, I &);
+ friend bool operator < (const I &, const I &);
+ friend bool operator <= (I &, I &);
+ friend bool operator <= (const I &, const I &);
+ friend bool operator > (I &, I &);
+ friend bool operator > (const I &, const I &);
+ friend bool operator >= (I &, I &);
+ friend bool operator >= (const I &, const I &);
+ friend typename I::difference_type operator - (I &, I &);
+ friend typename I::difference_type operator - (const I &, const I &);
+ friend I operator + (typename I::difference_type , const I &);
+private:
+ T *p;
+};
+ I::I () : p (0) {}
+ I::~I () { p = (T *) 0; }
+ I::I (T *x) : p (x) {}
+ I::I (const I &x) : p (x.p) {}
+ T &I::operator * () { return *p; }
+ T *I::operator -> () { return p; }
+ T &I::operator [] (const difference_type &x) const { return p[x]; }
+ I &I::operator = (const I &x) { p = x.p; return *this; }
+ I &I::operator ++ () { ++p; return *this; }
+ I I::operator ++ (int) { return I (p++); }
+ I &I::operator -- () { --p; return *this; }
+ I I::operator -- (int) { return I (p--); }
+ I &I::operator += (const difference_type &x) { p += x; return *this; }
+ I &I::operator -= (const difference_type &x) { p -= x; return *this; }
+ I I::operator + (const difference_type &x) const { return I (p + x); }
+ I I::operator - (const difference_type &x) const { return I (p - x); }
+ bool operator == (I &x, I &y) { return x.p == y.p; }
+ bool operator == (const I &x, const I &y) { return x.p == y.p; }
+ bool operator != (I &x, I &y) { return !(x == y); }
+ bool operator != (const I &x, const I &y) { return !(x == y); }
+ bool operator < (I &x, I &y) { return x.p < y.p; }
+ bool operator < (const I &x, const I &y) { return x.p < y.p; }
+ bool operator <= (I &x, I &y) { return x.p <= y.p; }
+ bool operator <= (const I &x, const I &y) { return x.p <= y.p; }
+ bool operator > (I &x, I &y) { return x.p > y.p; }
+ bool operator > (const I &x, const I &y) { return x.p > y.p; }
+ bool operator >= (I &x, I &y) { return x.p >= y.p; }
+ bool operator >= (const I &x, const I &y) { return x.p >= y.p; }
+ typename I::difference_type operator - (I &x, I &y) { return x.p - y.p; }
+ typename I::difference_type operator - (const I &x, const I &y) { return x.p - y.p; }
+ I operator + (typename I::difference_type x, const I &y) { return I (x + y.p); }
+
+class J
+{
+ public:
+ J(const I &x, const I &y) : b (x), e (y) {}
+ const I &begin ();
+ const I &end ();
+ private:
+ I b, e;
+};
+
+const I &J::begin () { return b; }
+const I &J::end () { return e; }
+
+static int f1count[3], f2count[3];
+
+#ifndef __cplusplus
+extern void abort (void);
+#else
+extern "C" void abort (void);
+#endif
+
+void f1 (int depth)
+{
+ f1count[depth]++;
+}
+
+void f2 (int depth)
+{
+ f2count[depth]++;
+}
+
+void s1 (J a1, J a2, J a3)
+{
+ I i, j, k;
+
+#pragma omp for collapse(3)
+ for (i = a1.begin (); i < a1.end (); i++)
+ {
+ f1 (0);
+ for (j = a2.begin (); j < a2.end (); j++)
+ {
+ f1 (1);
+ for (k = a3.begin (); k < a3.end (); k++)
+ {
+ f1 (2);
+ f2 (2);
+ }
+ f2 (1);
+ }
+ f2 (0);
+ }
+}
+
+
+int
+main (void)
+{
+
+ int index[] = {0, 1, 2, 3, 4, 5};
+
+ J x (&index[0], &index[3]);
+ J y (&index[0], &index[4]);
+ J z (&index[0], &index[5]);
+
+ f1count[0] = 0;
+ f1count[1] = 0;
+ f1count[2] = 0;
+ f2count[0] = 0;
+ f2count[1] = 0;
+ f2count[2] = 0;
+
+ s1 (x, y, z);
+
+ /* All intervening code at the same depth must be executed the same
+ number of times. */
+ if (f1count[0] != f2count[0]) abort ();
+ if (f1count[1] != f2count[1]) abort ();
+ if (f1count[2] != f2count[2]) abort ();
+
+ /* Intervening code must be executed at least as many times as the loop
+ that encloses it. */
+ if (f1count[0] < 3) abort ();
+ if (f1count[1] < 3 * 4) abort ();
+
+ /* Intervening code must not be executed more times than the number
+ of logical iterations. */
+ if (f1count[0] > 3 * 4 * 5) abort ();
+ if (f1count[1] > 3 * 4 * 5) abort ();
+
+ /* Check that the innermost loop body is executed exactly the number
+ of logical iterations expected. */
+ if (f1count[2] != 3 * 4 * 5) abort ();
+}
diff --git a/libgomp/testsuite/libgomp.c++/imperfect-class-2.C b/libgomp/testsuite/libgomp.c++/imperfect-class-2.C
new file mode 100644
index 00000000000..c6b657cabba
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c++/imperfect-class-2.C
@@ -0,0 +1,167 @@
+// { dg-do run }
+// Test that class iterators and imperfectly-nested loops work together.
+// This variant tests loop initialization by declaration.
+
+typedef __PTRDIFF_TYPE__ ptrdiff_t;
+typedef int T;
+typedef int S;
+
+class I
+{
+public:
+ typedef ptrdiff_t difference_type;
+ I ();
+ ~I ();
+ I (T *);
+ I (const I &);
+ T &operator * ();
+ T *operator -> ();
+ T &operator [] (const difference_type &) const;
+ I &operator = (const I &);
+ I &operator ++ ();
+ I operator ++ (int);
+ I &operator -- ();
+ I operator -- (int);
+ I &operator += (const difference_type &);
+ I &operator -= (const difference_type &);
+ I operator + (const difference_type &) const;
+ I operator - (const difference_type &) const;
+ friend bool operator == (I &, I &);
+ friend bool operator == (const I &, const I &);
+ friend bool operator < (I &, I &);
+ friend bool operator < (const I &, const I &);
+ friend bool operator <= (I &, I &);
+ friend bool operator <= (const I &, const I &);
+ friend bool operator > (I &, I &);
+ friend bool operator > (const I &, const I &);
+ friend bool operator >= (I &, I &);
+ friend bool operator >= (const I &, const I &);
+ friend typename I::difference_type operator - (I &, I &);
+ friend typename I::difference_type operator - (const I &, const I &);
+ friend I operator + (typename I::difference_type , const I &);
+private:
+ T *p;
+};
+ I::I () : p (0) {}
+ I::~I () { p = (T *) 0; }
+ I::I (T *x) : p (x) {}
+ I::I (const I &x) : p (x.p) {}
+ T &I::operator * () { return *p; }
+ T *I::operator -> () { return p; }
+ T &I::operator [] (const difference_type &x) const { return p[x]; }
+ I &I::operator = (const I &x) { p = x.p; return *this; }
+ I &I::operator ++ () { ++p; return *this; }
+ I I::operator ++ (int) { return I (p++); }
+ I &I::operator -- () { --p; return *this; }
+ I I::operator -- (int) { return I (p--); }
+ I &I::operator += (const difference_type &x) { p += x; return *this; }
+ I &I::operator -= (const difference_type &x) { p -= x; return *this; }
+ I I::operator + (const difference_type &x) const { return I (p + x); }
+ I I::operator - (const difference_type &x) const { return I (p - x); }
+ bool operator == (I &x, I &y) { return x.p == y.p; }
+ bool operator == (const I &x, const I &y) { return x.p == y.p; }
+ bool operator != (I &x, I &y) { return !(x == y); }
+ bool operator != (const I &x, const I &y) { return !(x == y); }
+ bool operator < (I &x, I &y) { return x.p < y.p; }
+ bool operator < (const I &x, const I &y) { return x.p < y.p; }
+ bool operator <= (I &x, I &y) { return x.p <= y.p; }
+ bool operator <= (const I &x, const I &y) { return x.p <= y.p; }
+ bool operator > (I &x, I &y) { return x.p > y.p; }
+ bool operator > (const I &x, const I &y) { return x.p > y.p; }
+ bool operator >= (I &x, I &y) { return x.p >= y.p; }
+ bool operator >= (const I &x, const I &y) { return x.p >= y.p; }
+ typename I::difference_type operator - (I &x, I &y) { return x.p - y.p; }
+ typename I::difference_type operator - (const I &x, const I &y) { return x.p - y.p; }
+ I operator + (typename I::difference_type x, const I &y) { return I (x + y.p); }
+
+class J
+{
+ public:
+ J(const I &x, const I &y) : b (x), e (y) {}
+ const I &begin ();
+ const I &end ();
+ private:
+ I b, e;
+};
+
+const I &J::begin () { return b; }
+const I &J::end () { return e; }
+
+static int f1count[3], f2count[3];
+
+#ifndef __cplusplus
+extern void abort (void);
+#else
+extern "C" void abort (void);
+#endif
+
+void f1 (int depth)
+{
+ f1count[depth]++;
+}
+
+void f2 (int depth)
+{
+ f2count[depth]++;
+}
+
+void s1 (J a1, J a2, J a3)
+{
+#pragma omp for collapse(3)
+ for (I i = a1.begin (); i < a1.end (); i++)
+ {
+ f1 (0);
+ for (I j = a2.begin (); j < a2.end (); j++)
+ {
+ f1 (1);
+ for (I k = a3.begin (); k < a3.end (); k++)
+ {
+ f1 (2);
+ f2 (2);
+ }
+ f2 (1);
+ }
+ f2 (0);
+ }
+}
+
+
+int
+main (void)
+{
+
+ int index[] = {0, 1, 2, 3, 4, 5};
+
+ J x (&index[0], &index[3]);
+ J y (&index[0], &index[4]);
+ J z (&index[0], &index[5]);
+
+ f1count[0] = 0;
+ f1count[1] = 0;
+ f1count[2] = 0;
+ f2count[0] = 0;
+ f2count[1] = 0;
+ f2count[2] = 0;
+
+ s1 (x, y, z);
+
+ /* All intervening code at the same depth must be executed the same
+ number of times. */
+ if (f1count[0] != f2count[0]) abort ();
+ if (f1count[1] != f2count[1]) abort ();
+ if (f1count[2] != f2count[2]) abort ();
+
+ /* Intervening code must be executed at least as many times as the loop
+ that encloses it. */
+ if (f1count[0] < 3) abort ();
+ if (f1count[1] < 3 * 4) abort ();
+
+ /* Intervening code must not be executed more times than the number
+ of logical iterations. */
+ if (f1count[0] > 3 * 4 * 5) abort ();
+ if (f1count[1] > 3 * 4 * 5) abort ();
+
+ /* Check that the innermost loop body is executed exactly the number
+ of logical iterations expected. */
+ if (f1count[2] != 3 * 4 * 5) abort ();
+}
diff --git a/libgomp/testsuite/libgomp.c++/imperfect-class-3.C b/libgomp/testsuite/libgomp.c++/imperfect-class-3.C
new file mode 100644
index 00000000000..c33826a6b36
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c++/imperfect-class-3.C
@@ -0,0 +1,167 @@
+// { dg-do run }
+// Test that class iterators and imperfectly-nested loops work together.
+// This variant tests range for.
+
+typedef __PTRDIFF_TYPE__ ptrdiff_t;
+typedef int T;
+typedef int S;
+
+class I
+{
+public:
+ typedef ptrdiff_t difference_type;
+ I ();
+ ~I ();
+ I (T *);
+ I (const I &);
+ T &operator * ();
+ T *operator -> ();
+ T &operator [] (const difference_type &) const;
+ I &operator = (const I &);
+ I &operator ++ ();
+ I operator ++ (int);
+ I &operator -- ();
+ I operator -- (int);
+ I &operator += (const difference_type &);
+ I &operator -= (const difference_type &);
+ I operator + (const difference_type &) const;
+ I operator - (const difference_type &) const;
+ friend bool operator == (I &, I &);
+ friend bool operator == (const I &, const I &);
+ friend bool operator < (I &, I &);
+ friend bool operator < (const I &, const I &);
+ friend bool operator <= (I &, I &);
+ friend bool operator <= (const I &, const I &);
+ friend bool operator > (I &, I &);
+ friend bool operator > (const I &, const I &);
+ friend bool operator >= (I &, I &);
+ friend bool operator >= (const I &, const I &);
+ friend typename I::difference_type operator - (I &, I &);
+ friend typename I::difference_type operator - (const I &, const I &);
+ friend I operator + (typename I::difference_type , const I &);
+private:
+ T *p;
+};
+ I::I () : p (0) {}
+ I::~I () { p = (T *) 0; }
+ I::I (T *x) : p (x) {}
+ I::I (const I &x) : p (x.p) {}
+ T &I::operator * () { return *p; }
+ T *I::operator -> () { return p; }
+ T &I::operator [] (const difference_type &x) const { return p[x]; }
+ I &I::operator = (const I &x) { p = x.p; return *this; }
+ I &I::operator ++ () { ++p; return *this; }
+ I I::operator ++ (int) { return I (p++); }
+ I &I::operator -- () { --p; return *this; }
+ I I::operator -- (int) { return I (p--); }
+ I &I::operator += (const difference_type &x) { p += x; return *this; }
+ I &I::operator -= (const difference_type &x) { p -= x; return *this; }
+ I I::operator + (const difference_type &x) const { return I (p + x); }
+ I I::operator - (const difference_type &x) const { return I (p - x); }
+ bool operator == (I &x, I &y) { return x.p == y.p; }
+ bool operator == (const I &x, const I &y) { return x.p == y.p; }
+ bool operator != (I &x, I &y) { return !(x == y); }
+ bool operator != (const I &x, const I &y) { return !(x == y); }
+ bool operator < (I &x, I &y) { return x.p < y.p; }
+ bool operator < (const I &x, const I &y) { return x.p < y.p; }
+ bool operator <= (I &x, I &y) { return x.p <= y.p; }
+ bool operator <= (const I &x, const I &y) { return x.p <= y.p; }
+ bool operator > (I &x, I &y) { return x.p > y.p; }
+ bool operator > (const I &x, const I &y) { return x.p > y.p; }
+ bool operator >= (I &x, I &y) { return x.p >= y.p; }
+ bool operator >= (const I &x, const I &y) { return x.p >= y.p; }
+ typename I::difference_type operator - (I &x, I &y) { return x.p - y.p; }
+ typename I::difference_type operator - (const I &x, const I &y) { return x.p - y.p; }
+ I operator + (typename I::difference_type x, const I &y) { return I (x + y.p); }
+
+class J
+{
+ public:
+ J(const I &x, const I &y) : b (x), e (y) {}
+ const I &begin ();
+ const I &end ();
+ private:
+ I b, e;
+};
+
+const I &J::begin () { return b; }
+const I &J::end () { return e; }
+
+static int f1count[3], f2count[3];
+
+#ifndef __cplusplus
+extern void abort (void);
+#else
+extern "C" void abort (void);
+#endif
+
+void f1 (int depth)
+{
+ f1count[depth]++;
+}
+
+void f2 (int depth)
+{
+ f2count[depth]++;
+}
+
+void s1 (J a1, J a2, J a3)
+{
+#pragma omp for collapse(3)
+ for (auto i : a1)
+ {
+ f1 (0);
+ for (auto j : a2)
+ {
+ f1 (1);
+ for (auto k : a3)
+ {
+ f1 (2);
+ f2 (2);
+ }
+ f2 (1);
+ }
+ f2 (0);
+ }
+}
+
+
+int
+main (void)
+{
+
+ int index[] = {0, 1, 2, 3, 4, 5};
+
+ J x (&index[0], &index[3]);
+ J y (&index[0], &index[4]);
+ J z (&index[0], &index[5]);
+
+ f1count[0] = 0;
+ f1count[1] = 0;
+ f1count[2] = 0;
+ f2count[0] = 0;
+ f2count[1] = 0;
+ f2count[2] = 0;
+
+ s1 (x, y, z);
+
+ /* All intervening code at the same depth must be executed the same
+ number of times. */
+ if (f1count[0] != f2count[0]) abort ();
+ if (f1count[1] != f2count[1]) abort ();
+ if (f1count[2] != f2count[2]) abort ();
+
+ /* Intervening code must be executed at least as many times as the loop
+ that encloses it. */
+ if (f1count[0] < 3) abort ();
+ if (f1count[1] < 3 * 4) abort ();
+
+ /* Intervening code must not be executed more times than the number
+ of logical iterations. */
+ if (f1count[0] > 3 * 4 * 5) abort ();
+ if (f1count[1] > 3 * 4 * 5) abort ();
+
+ /* Check that the innermost loop body is executed exactly the number
+ of logical iterations expected. */
+ if (f1count[2] != 3 * 4 * 5) abort ();
+}
diff --git a/libgomp/testsuite/libgomp.c++/imperfect-destructor.C b/libgomp/testsuite/libgomp.c++/imperfect-destructor.C
new file mode 100644
index 00000000000..bd87760e076
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c++/imperfect-destructor.C
@@ -0,0 +1,135 @@
+/* { dg-do run } */
+
+/* Make sure destructors are called for class variables bound
+ in intervening code. */
+
+static int f1count[3], f2count[3];
+static int g1count[3], g2count[3];
+
+static int ccount[3], dcount[3];
+
+class C {
+ public:
+ int n;
+ C (int nn) { n = nn; ccount[n]++; }
+ ~C () { dcount[n]++; n = 0; }
+};
+
+#ifndef __cplusplus
+extern void abort (void);
+#else
+extern "C" void abort (void);
+#endif
+
+int f1 (int depth, int iter)
+{
+ f1count[depth]++;
+ return iter;
+}
+
+int f2 (int depth, int iter)
+{
+ f2count[depth]++;
+ return iter;
+}
+
+int g1 (int depth, int iter)
+{
+ g1count[depth]++;
+ return iter;
+}
+
+int g2 (int depth, int iter)
+{
+ g2count[depth]++;
+ return iter;
+}
+
+void s1 (int a1, int a2, int a3)
+{
+ int i, j, k;
+
+#pragma omp for collapse(3)
+ for (i = 0; i < a1; i++)
+ {
+ C local0(0);
+ f1 (local0.n, i);
+ {
+ g1 (local0.n, i);
+ for (j = 0; j < a2; j++)
+ {
+ C local1(1);
+ f1 (local1.n, j);
+ {
+ g1 (local1.n, j);
+ for (k = 0; k < a3; k++)
+ {
+ C local2(2);
+ f1 (local2.n, k);
+ {
+ g1 (local2.n, k);
+ g2 (local2.n, k);
+ }
+ f2 (local2.n, k);
+ }
+ g2 (local1.n, j);
+ }
+ f2 (local1.n, j);
+ }
+ g2 (local0.n, i);
+ }
+ f2 (local0.n, i);
+ }
+}
+
+int
+main (void)
+{
+ f1count[0] = 0;
+ f1count[1] = 0;
+ f1count[2] = 0;
+ f2count[0] = 0;
+ f2count[1] = 0;
+ f2count[2] = 0;
+
+ g1count[0] = 0;
+ g1count[1] = 0;
+ g1count[2] = 0;
+ g2count[0] = 0;
+ g2count[1] = 0;
+ g2count[2] = 0;
+
+ s1 (3, 4, 5);
+
+ /* All intervening code at the same depth must be executed the same
+ number of times. */
+ if (f1count[0] != f2count[0]) abort ();
+ if (f1count[1] != f2count[1]) abort ();
+ if (f1count[2] != f2count[2]) abort ();
+ if (g1count[0] != f1count[0]) abort ();
+ if (g2count[0] != f1count[0]) abort ();
+ if (g1count[1] != f1count[1]) abort ();
+ if (g2count[1] != f1count[1]) abort ();
+ if (g1count[2] != f1count[2]) abort ();
+ if (g2count[2] != f1count[2]) abort ();
+
+ /* Intervening code must be executed at least as many times as the loop
+ that encloses it. */
+ if (f1count[0] < 3) abort ();
+ if (f1count[1] < 3 * 4) abort ();
+
+ /* Intervening code must not be executed more times than the number
+ of logical iterations. */
+ if (f1count[0] > 3 * 4 * 5) abort ();
+ if (f1count[1] > 3 * 4 * 5) abort ();
+
+ /* Check that the innermost loop body is executed exactly the number
+ of logical iterations expected. */
+ if (f1count[2] != 3 * 4 * 5) abort ();
+
+ /* Check that each class object declared in intervening code was
+ constructed and destructed an equal number of times. */
+ if (ccount[0] != dcount[0]) abort ();
+ if (ccount[1] != dcount[1]) abort ();
+ if (ccount[2] != dcount[2]) abort ();
+}
diff --git a/libgomp/testsuite/libgomp.c++/imperfect-template-1.C b/libgomp/testsuite/libgomp.c++/imperfect-template-1.C
new file mode 100644
index 00000000000..4ed96c8319b
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c++/imperfect-template-1.C
@@ -0,0 +1,172 @@
+// { dg-do run }
+// Test that template class iterators and imperfectly-nested loops
+// work together.
+// This variant tests initialization by assignment.
+
+typedef __PTRDIFF_TYPE__ ptrdiff_t;
+extern "C" void abort ();
+
+template <typename T>
+class I
+{
+public:
+ typedef ptrdiff_t difference_type;
+ I ();
+ ~I ();
+ I (T *);
+ I (const I &);
+ T &operator * ();
+ T *operator -> ();
+ T &operator [] (const difference_type &) const;
+ I &operator = (const I &);
+ I &operator ++ ();
+ I operator ++ (int);
+ I &operator -- ();
+ I operator -- (int);
+ I &operator += (const difference_type &);
+ I &operator -= (const difference_type &);
+ I operator + (const difference_type &) const;
+ I operator - (const difference_type &) const;
+ template <typename S> friend bool operator == (I<S> &, I<S> &);
+ template <typename S> friend bool operator == (const I<S> &, const I<S> &);
+ template <typename S> friend bool operator < (I<S> &, I<S> &);
+ template <typename S> friend bool operator < (const I<S> &, const I<S> &);
+ template <typename S> friend bool operator <= (I<S> &, I<S> &);
+ template <typename S> friend bool operator <= (const I<S> &, const I<S> &);
+ template <typename S> friend bool operator > (I<S> &, I<S> &);
+ template <typename S> friend bool operator > (const I<S> &, const I<S> &);
+ template <typename S> friend bool operator >= (I<S> &, I<S> &);
+ template <typename S> friend bool operator >= (const I<S> &, const I<S> &);
+ template <typename S> friend typename I<S>::difference_type operator - (I<S> &, I<S> &);
+ template <typename S> friend typename I<S>::difference_type operator - (const I<S> &, const I<S> &);
+ template <typename S> friend I<S> operator + (typename I<S>::difference_type , const I<S> &);
+private:
+ T *p;
+};
+template <typename T> I<T>::I () : p (0) {}
+template <typename T> I<T>::~I () { p = (T *) 0; }
+template <typename T> I<T>::I (T *x) : p (x) {}
+template <typename T> I<T>::I (const I &x) : p (x.p) {}
+template <typename T> T &I<T>::operator * () { return *p; }
+template <typename T> T *I<T>::operator -> () { return p; }
+template <typename T> T &I<T>::operator [] (const difference_type &x) const { return p[x]; }
+template <typename T> I<T> &I<T>::operator = (const I &x) { p = x.p; return *this; }
+template <typename T> I<T> &I<T>::operator ++ () { ++p; return *this; }
+template <typename T> I<T> I<T>::operator ++ (int) { return I (p++); }
+template <typename T> I<T> &I<T>::operator -- () { --p; return *this; }
+template <typename T> I<T> I<T>::operator -- (int) { return I (p--); }
+template <typename T> I<T> &I<T>::operator += (const difference_type &x) { p += x; return *this; }
+template <typename T> I<T> &I<T>::operator -= (const difference_type &x) { p -= x; return *this; }
+template <typename T> I<T> I<T>::operator + (const difference_type &x) const { return I (p + x); }
+template <typename T> I<T> I<T>::operator - (const difference_type &x) const { return I (p - x); }
+template <typename T> bool operator == (I<T> &x, I<T> &y) { return x.p == y.p; }
+template <typename T> bool operator == (const I<T> &x, const I<T> &y) { return x.p == y.p; }
+template <typename T> bool operator != (I<T> &x, I<T> &y) { return !(x == y); }
+template <typename T> bool operator != (const I<T> &x, const I<T> &y) { return !(x == y); }
+template <typename T> bool operator < (I<T> &x, I<T> &y) { return x.p < y.p; }
+template <typename T> bool operator < (const I<T> &x, const I<T> &y) { return x.p < y.p; }
+template <typename T> bool operator <= (I<T> &x, I<T> &y) { return x.p <= y.p; }
+template <typename T> bool operator <= (const I<T> &x, const I<T> &y) { return x.p <= y.p; }
+template <typename T> bool operator > (I<T> &x, I<T> &y) { return x.p > y.p; }
+template <typename T> bool operator > (const I<T> &x, const I<T> &y) { return x.p > y.p; }
+template <typename T> bool operator >= (I<T> &x, I<T> &y) { return x.p >= y.p; }
+template <typename T> bool operator >= (const I<T> &x, const I<T> &y) { return x.p >= y.p; }
+template <typename T> typename I<T>::difference_type operator - (I<T> &x, I<T> &y) { return x.p - y.p; }
+template <typename T> typename I<T>::difference_type operator - (const I<T> &x, const I<T> &y) { return x.p - y.p; }
+template <typename T> I<T> operator + (typename I<T>::difference_type x, const I<T> &y) { return I<T> (x + y.p); }
+
+template <typename T>
+class J
+{
+public:
+ J(const I<T> &x, const I<T> &y) : b (x), e (y) {}
+ const I<T> &begin ();
+ const I<T> &end ();
+private:
+ I<T> b, e;
+};
+
+template <typename T> const I<T> &J<T>::begin () { return b; }
+template <typename T> const I<T> &J<T>::end () { return e; }
+
+static int f1count[3], f2count[3];
+
+#ifndef __cplusplus
+extern void abort (void);
+#else
+extern "C" void abort (void);
+#endif
+
+void f1 (int depth)
+{
+ f1count[depth]++;
+}
+
+void f2 (int depth)
+{
+ f2count[depth]++;
+}
+
+template <typename T>
+void s1 (J<T> a1, J<T> a2, J<T> a3)
+{
+ I<T> i, j, k;
+
+#pragma omp for collapse(3)
+ for (i = a1.begin (); i < a1.end (); i++)
+ {
+ f1 (0);
+ for (j = a2.begin (); j < a2.end (); j++)
+ {
+ f1 (1);
+ for (k = a3.begin (); k < a3.end (); k++)
+ {
+ f1 (2);
+ f2 (2);
+ }
+ f2 (1);
+ }
+ f2 (0);
+ }
+}
+
+
+int
+main (void)
+{
+
+ int index[] = {0, 1, 2, 3, 4, 5};
+
+ J<int> x (&index[0], &index[3]);
+ J<int> y (&index[0], &index[4]);
+ J<int> z (&index[0], &index[5]);
+
+ f1count[0] = 0;
+ f1count[1] = 0;
+ f1count[2] = 0;
+ f2count[0] = 0;
+ f2count[1] = 0;
+ f2count[2] = 0;
+
+ s1<int> (x, y, z);
+
+ /* All intervening code at the same depth must be executed the same
+ number of times. */
+ if (f1count[0] != f2count[0]) abort ();
+ if (f1count[1] != f2count[1]) abort ();
+ if (f1count[2] != f2count[2]) abort ();
+
+ /* Intervening code must be executed at least as many times as the loop
+ that encloses it. */
+ if (f1count[0] < 3) abort ();
+ if (f1count[1] < 3 * 4) abort ();
+
+ /* Intervening code must not be executed more times than the number
+ of logical iterations. */
+ if (f1count[0] > 3 * 4 * 5) abort ();
+ if (f1count[1] > 3 * 4 * 5) abort ();
+
+ /* Check that the innermost loop body is executed exactly the number
+ of logical iterations expected. */
+ if (f1count[2] != 3 * 4 * 5) abort ();
+}
diff --git a/libgomp/testsuite/libgomp.c++/imperfect-template-2.C b/libgomp/testsuite/libgomp.c++/imperfect-template-2.C
new file mode 100644
index 00000000000..a41c87c481f
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c++/imperfect-template-2.C
@@ -0,0 +1,170 @@
+// { dg-do run }
+// Test that template class iterators and imperfectly-nested loops
+// work together.
+// This variant tests initialization by declaration.
+
+typedef __PTRDIFF_TYPE__ ptrdiff_t;
+extern "C" void abort ();
+
+template <typename T>
+class I
+{
+public:
+ typedef ptrdiff_t difference_type;
+ I ();
+ ~I ();
+ I (T *);
+ I (const I &);
+ T &operator * ();
+ T *operator -> ();
+ T &operator [] (const difference_type &) const;
+ I &operator = (const I &);
+ I &operator ++ ();
+ I operator ++ (int);
+ I &operator -- ();
+ I operator -- (int);
+ I &operator += (const difference_type &);
+ I &operator -= (const difference_type &);
+ I operator + (const difference_type &) const;
+ I operator - (const difference_type &) const;
+ template <typename S> friend bool operator == (I<S> &, I<S> &);
+ template <typename S> friend bool operator == (const I<S> &, const I<S> &);
+ template <typename S> friend bool operator < (I<S> &, I<S> &);
+ template <typename S> friend bool operator < (const I<S> &, const I<S> &);
+ template <typename S> friend bool operator <= (I<S> &, I<S> &);
+ template <typename S> friend bool operator <= (const I<S> &, const I<S> &);
+ template <typename S> friend bool operator > (I<S> &, I<S> &);
+ template <typename S> friend bool operator > (const I<S> &, const I<S> &);
+ template <typename S> friend bool operator >= (I<S> &, I<S> &);
+ template <typename S> friend bool operator >= (const I<S> &, const I<S> &);
+ template <typename S> friend typename I<S>::difference_type operator - (I<S> &, I<S> &);
+ template <typename S> friend typename I<S>::difference_type operator - (const I<S> &, const I<S> &);
+ template <typename S> friend I<S> operator + (typename I<S>::difference_type , const I<S> &);
+private:
+ T *p;
+};
+template <typename T> I<T>::I () : p (0) {}
+template <typename T> I<T>::~I () { p = (T *) 0; }
+template <typename T> I<T>::I (T *x) : p (x) {}
+template <typename T> I<T>::I (const I &x) : p (x.p) {}
+template <typename T> T &I<T>::operator * () { return *p; }
+template <typename T> T *I<T>::operator -> () { return p; }
+template <typename T> T &I<T>::operator [] (const difference_type &x) const { return p[x]; }
+template <typename T> I<T> &I<T>::operator = (const I &x) { p = x.p; return *this; }
+template <typename T> I<T> &I<T>::operator ++ () { ++p; return *this; }
+template <typename T> I<T> I<T>::operator ++ (int) { return I (p++); }
+template <typename T> I<T> &I<T>::operator -- () { --p; return *this; }
+template <typename T> I<T> I<T>::operator -- (int) { return I (p--); }
+template <typename T> I<T> &I<T>::operator += (const difference_type &x) { p += x; return *this; }
+template <typename T> I<T> &I<T>::operator -= (const difference_type &x) { p -= x; return *this; }
+template <typename T> I<T> I<T>::operator + (const difference_type &x) const { return I (p + x); }
+template <typename T> I<T> I<T>::operator - (const difference_type &x) const { return I (p - x); }
+template <typename T> bool operator == (I<T> &x, I<T> &y) { return x.p == y.p; }
+template <typename T> bool operator == (const I<T> &x, const I<T> &y) { return x.p == y.p; }
+template <typename T> bool operator != (I<T> &x, I<T> &y) { return !(x == y); }
+template <typename T> bool operator != (const I<T> &x, const I<T> &y) { return !(x == y); }
+template <typename T> bool operator < (I<T> &x, I<T> &y) { return x.p < y.p; }
+template <typename T> bool operator < (const I<T> &x, const I<T> &y) { return x.p < y.p; }
+template <typename T> bool operator <= (I<T> &x, I<T> &y) { return x.p <= y.p; }
+template <typename T> bool operator <= (const I<T> &x, const I<T> &y) { return x.p <= y.p; }
+template <typename T> bool operator > (I<T> &x, I<T> &y) { return x.p > y.p; }
+template <typename T> bool operator > (const I<T> &x, const I<T> &y) { return x.p > y.p; }
+template <typename T> bool operator >= (I<T> &x, I<T> &y) { return x.p >= y.p; }
+template <typename T> bool operator >= (const I<T> &x, const I<T> &y) { return x.p >= y.p; }
+template <typename T> typename I<T>::difference_type operator - (I<T> &x, I<T> &y) { return x.p - y.p; }
+template <typename T> typename I<T>::difference_type operator - (const I<T> &x, const I<T> &y) { return x.p - y.p; }
+template <typename T> I<T> operator + (typename I<T>::difference_type x, const I<T> &y) { return I<T> (x + y.p); }
+
+template <typename T>
+class J
+{
+public:
+ J(const I<T> &x, const I<T> &y) : b (x), e (y) {}
+ const I<T> &begin ();
+ const I<T> &end ();
+private:
+ I<T> b, e;
+};
+
+template <typename T> const I<T> &J<T>::begin () { return b; }
+template <typename T> const I<T> &J<T>::end () { return e; }
+
+static int f1count[3], f2count[3];
+
+#ifndef __cplusplus
+extern void abort (void);
+#else
+extern "C" void abort (void);
+#endif
+
+void f1 (int depth)
+{
+ f1count[depth]++;
+}
+
+void f2 (int depth)
+{
+ f2count[depth]++;
+}
+
+template <typename T>
+void s1 (J<T> a1, J<T> a2, J<T> a3)
+{
+#pragma omp for collapse(3)
+ for (I<T> i = a1.begin (); i < a1.end (); i++)
+ {
+ f1 (0);
+ for (I<T> j = a2.begin (); j < a2.end (); j++)
+ {
+ f1 (1);
+ for (I<T> k = a3.begin (); k < a3.end (); k++)
+ {
+ f1 (2);
+ f2 (2);
+ }
+ f2 (1);
+ }
+ f2 (0);
+ }
+}
+
+
+int
+main (void)
+{
+
+ int index[] = {0, 1, 2, 3, 4, 5};
+
+ J<int> x (&index[0], &index[3]);
+ J<int> y (&index[0], &index[4]);
+ J<int> z (&index[0], &index[5]);
+
+ f1count[0] = 0;
+ f1count[1] = 0;
+ f1count[2] = 0;
+ f2count[0] = 0;
+ f2count[1] = 0;
+ f2count[2] = 0;
+
+ s1<int> (x, y, z);
+
+ /* All intervening code at the same depth must be executed the same
+ number of times. */
+ if (f1count[0] != f2count[0]) abort ();
+ if (f1count[1] != f2count[1]) abort ();
+ if (f1count[2] != f2count[2]) abort ();
+
+ /* Intervening code must be executed at least as many times as the loop
+ that encloses it. */
+ if (f1count[0] < 3) abort ();
+ if (f1count[1] < 3 * 4) abort ();
+
+ /* Intervening code must not be executed more times than the number
+ of logical iterations. */
+ if (f1count[0] > 3 * 4 * 5) abort ();
+ if (f1count[1] > 3 * 4 * 5) abort ();
+
+ /* Check that the innermost loop body is executed exactly the number
+ of logical iterations expected. */
+ if (f1count[2] != 3 * 4 * 5) abort ();
+}
diff --git a/libgomp/testsuite/libgomp.c++/imperfect-template-3.C b/libgomp/testsuite/libgomp.c++/imperfect-template-3.C
new file mode 100644
index 00000000000..2e464ed5510
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c++/imperfect-template-3.C
@@ -0,0 +1,170 @@
+// { dg-do run }
+// Test that template class iterators and imperfectly-nested loops
+// work together.
+// This variant tests range for syntax.
+
+typedef __PTRDIFF_TYPE__ ptrdiff_t;
+extern "C" void abort ();
+
+template <typename T>
+class I
+{
+public:
+ typedef ptrdiff_t difference_type;
+ I ();
+ ~I ();
+ I (T *);
+ I (const I &);
+ T &operator * ();
+ T *operator -> ();
+ T &operator [] (const difference_type &) const;
+ I &operator = (const I &);
+ I &operator ++ ();
+ I operator ++ (int);
+ I &operator -- ();
+ I operator -- (int);
+ I &operator += (const difference_type &);
+ I &operator -= (const difference_type &);
+ I operator + (const difference_type &) const;
+ I operator - (const difference_type &) const;
+ template <typename S> friend bool operator == (I<S> &, I<S> &);
+ template <typename S> friend bool operator == (const I<S> &, const I<S> &);
+ template <typename S> friend bool operator < (I<S> &, I<S> &);
+ template <typename S> friend bool operator < (const I<S> &, const I<S> &);
+ template <typename S> friend bool operator <= (I<S> &, I<S> &);
+ template <typename S> friend bool operator <= (const I<S> &, const I<S> &);
+ template <typename S> friend bool operator > (I<S> &, I<S> &);
+ template <typename S> friend bool operator > (const I<S> &, const I<S> &);
+ template <typename S> friend bool operator >= (I<S> &, I<S> &);
+ template <typename S> friend bool operator >= (const I<S> &, const I<S> &);
+ template <typename S> friend typename I<S>::difference_type operator - (I<S> &, I<S> &);
+ template <typename S> friend typename I<S>::difference_type operator - (const I<S> &, const I<S> &);
+ template <typename S> friend I<S> operator + (typename I<S>::difference_type , const I<S> &);
+private:
+ T *p;
+};
+template <typename T> I<T>::I () : p (0) {}
+template <typename T> I<T>::~I () { p = (T *) 0; }
+template <typename T> I<T>::I (T *x) : p (x) {}
+template <typename T> I<T>::I (const I &x) : p (x.p) {}
+template <typename T> T &I<T>::operator * () { return *p; }
+template <typename T> T *I<T>::operator -> () { return p; }
+template <typename T> T &I<T>::operator [] (const difference_type &x) const { return p[x]; }
+template <typename T> I<T> &I<T>::operator = (const I &x) { p = x.p; return *this; }
+template <typename T> I<T> &I<T>::operator ++ () { ++p; return *this; }
+template <typename T> I<T> I<T>::operator ++ (int) { return I (p++); }
+template <typename T> I<T> &I<T>::operator -- () { --p; return *this; }
+template <typename T> I<T> I<T>::operator -- (int) { return I (p--); }
+template <typename T> I<T> &I<T>::operator += (const difference_type &x) { p += x; return *this; }
+template <typename T> I<T> &I<T>::operator -= (const difference_type &x) { p -= x; return *this; }
+template <typename T> I<T> I<T>::operator + (const difference_type &x) const { return I (p + x); }
+template <typename T> I<T> I<T>::operator - (const difference_type &x) const { return I (p - x); }
+template <typename T> bool operator == (I<T> &x, I<T> &y) { return x.p == y.p; }
+template <typename T> bool operator == (const I<T> &x, const I<T> &y) { return x.p == y.p; }
+template <typename T> bool operator != (I<T> &x, I<T> &y) { return !(x == y); }
+template <typename T> bool operator != (const I<T> &x, const I<T> &y) { return !(x == y); }
+template <typename T> bool operator < (I<T> &x, I<T> &y) { return x.p < y.p; }
+template <typename T> bool operator < (const I<T> &x, const I<T> &y) { return x.p < y.p; }
+template <typename T> bool operator <= (I<T> &x, I<T> &y) { return x.p <= y.p; }
+template <typename T> bool operator <= (const I<T> &x, const I<T> &y) { return x.p <= y.p; }
+template <typename T> bool operator > (I<T> &x, I<T> &y) { return x.p > y.p; }
+template <typename T> bool operator > (const I<T> &x, const I<T> &y) { return x.p > y.p; }
+template <typename T> bool operator >= (I<T> &x, I<T> &y) { return x.p >= y.p; }
+template <typename T> bool operator >= (const I<T> &x, const I<T> &y) { return x.p >= y.p; }
+template <typename T> typename I<T>::difference_type operator - (I<T> &x, I<T> &y) { return x.p - y.p; }
+template <typename T> typename I<T>::difference_type operator - (const I<T> &x, const I<T> &y) { return x.p - y.p; }
+template <typename T> I<T> operator + (typename I<T>::difference_type x, const I<T> &y) { return I<T> (x + y.p); }
+
+template <typename T>
+class J
+{
+public:
+ J(const I<T> &x, const I<T> &y) : b (x), e (y) {}
+ const I<T> &begin ();
+ const I<T> &end ();
+private:
+ I<T> b, e;
+};
+
+template <typename T> const I<T> &J<T>::begin () { return b; }
+template <typename T> const I<T> &J<T>::end () { return e; }
+
+static int f1count[3], f2count[3];
+
+#ifndef __cplusplus
+extern void abort (void);
+#else
+extern "C" void abort (void);
+#endif
+
+void f1 (int depth)
+{
+ f1count[depth]++;
+}
+
+void f2 (int depth)
+{
+ f2count[depth]++;
+}
+
+template <typename T>
+void s1 (J<T> a1, J<T> a2, J<T> a3)
+{
+#pragma omp for collapse(3)
+ for (auto i : a1)
+ {
+ f1 (0);
+ for (auto j : a2)
+ {
+ f1 (1);
+ for (auto k : a3)
+ {
+ f1 (2);
+ f2 (2);
+ }
+ f2 (1);
+ }
+ f2 (0);
+ }
+}
+
+
+int
+main (void)
+{
+
+ int index[] = {0, 1, 2, 3, 4, 5};
+
+ J<int> x (&index[0], &index[3]);
+ J<int> y (&index[0], &index[4]);
+ J<int> z (&index[0], &index[5]);
+
+ f1count[0] = 0;
+ f1count[1] = 0;
+ f1count[2] = 0;
+ f2count[0] = 0;
+ f2count[1] = 0;
+ f2count[2] = 0;
+
+ s1<int> (x, y, z);
+
+ /* All intervening code at the same depth must be executed the same
+ number of times. */
+ if (f1count[0] != f2count[0]) abort ();
+ if (f1count[1] != f2count[1]) abort ();
+ if (f1count[2] != f2count[2]) abort ();
+
+ /* Intervening code must be executed at least as many times as the loop
+ that encloses it. */
+ if (f1count[0] < 3) abort ();
+ if (f1count[1] < 3 * 4) abort ();
+
+ /* Intervening code must not be executed more times than the number
+ of logical iterations. */
+ if (f1count[0] > 3 * 4 * 5) abort ();
+ if (f1count[1] > 3 * 4 * 5) abort ();
+
+ /* Check that the innermost loop body is executed exactly the number
+ of logical iterations expected. */
+ if (f1count[2] != 3 * 4 * 5) abort ();
+}
--
2.31.1
^ permalink raw reply [flat|nested] 7+ messages in thread* [OG13 4/6] OpenMP: New c/c++ testcases for imperfectly-nested loops
2023-06-14 22:07 [OG13 0/6] OpenMP: Support for imperfectly-nested loops Sandra Loosemore
` (2 preceding siblings ...)
2023-06-14 22:08 ` [OG13 3/6] OpenMP: C++ " Sandra Loosemore
@ 2023-06-14 22:08 ` Sandra Loosemore
2023-06-14 22:08 ` [OG13 5/6] OpenMP: Refactor and tidy Fortran front-end code for loop transformations Sandra Loosemore
2023-06-14 22:08 ` [OG13 6/6] OpenMP: Fortran support for imperfectly nested loops Sandra Loosemore
5 siblings, 0 replies; 7+ messages in thread
From: Sandra Loosemore @ 2023-06-14 22:08 UTC (permalink / raw)
To: gcc-patches
gcc/testsuite/ChangeLog
* c-c++-common/gomp/imperfect1.c: New.
* c-c++-common/gomp/imperfect2.c: New.
* c-c++-common/gomp/imperfect3.c: New.
* c-c++-common/gomp/imperfect4.c: New.
* c-c++-common/gomp/imperfect5.c: New.
libgomp/ChangeLog
* testsuite/libgomp.c-c++-common/imperfect-transform-1.c: New.
* testsuite/libgomp.c-c++-common/imperfect-transform-2.c: New.
* testsuite/libgomp.c-c++-common/imperfect1.c: New.
* testsuite/libgomp.c-c++-common/imperfect2.c: New.
* testsuite/libgomp.c-c++-common/imperfect3.c: New.
* testsuite/libgomp.c-c++-common/imperfect4.c: New.
* testsuite/libgomp.c-c++-common/imperfect5.c: New.
* testsuite/libgomp.c-c++-common/imperfect6.c: New.
* testsuite/libgomp.c-c++-common/target-imperfect-transform-1.c: New.
* testsuite/libgomp.c-c++-common/target-imperfect-transform-2.c: New.
* testsuite/libgomp.c-c++-common/target-imperfect1.c: New.
* testsuite/libgomp.c-c++-common/target-imperfect2.c: New.
* testsuite/libgomp.c-c++-common/target-imperfect3.c: New.
* testsuite/libgomp.c-c++-common/target-imperfect4.c: New.
---
gcc/testsuite/ChangeLog.omp | 8 ++
gcc/testsuite/c-c++-common/gomp/imperfect1.c | 38 ++++++
gcc/testsuite/c-c++-common/gomp/imperfect2.c | 34 +++++
gcc/testsuite/c-c++-common/gomp/imperfect3.c | 33 +++++
gcc/testsuite/c-c++-common/gomp/imperfect4.c | 33 +++++
gcc/testsuite/c-c++-common/gomp/imperfect5.c | 57 ++++++++
libgomp/ChangeLog.omp | 17 +++
.../imperfect-transform-1.c | 79 +++++++++++
.../imperfect-transform-2.c | 79 +++++++++++
.../libgomp.c-c++-common/imperfect1.c | 76 +++++++++++
.../libgomp.c-c++-common/imperfect2.c | 114 ++++++++++++++++
.../libgomp.c-c++-common/imperfect3.c | 119 +++++++++++++++++
.../libgomp.c-c++-common/imperfect4.c | 117 ++++++++++++++++
.../libgomp.c-c++-common/imperfect5.c | 49 +++++++
.../libgomp.c-c++-common/imperfect6.c | 115 ++++++++++++++++
.../target-imperfect-transform-1.c | 82 ++++++++++++
.../target-imperfect-transform-2.c | 82 ++++++++++++
.../libgomp.c-c++-common/target-imperfect1.c | 81 ++++++++++++
.../libgomp.c-c++-common/target-imperfect2.c | 122 +++++++++++++++++
.../libgomp.c-c++-common/target-imperfect3.c | 125 ++++++++++++++++++
.../libgomp.c-c++-common/target-imperfect4.c | 122 +++++++++++++++++
21 files changed, 1582 insertions(+)
create mode 100644 gcc/testsuite/c-c++-common/gomp/imperfect1.c
create mode 100644 gcc/testsuite/c-c++-common/gomp/imperfect2.c
create mode 100644 gcc/testsuite/c-c++-common/gomp/imperfect3.c
create mode 100644 gcc/testsuite/c-c++-common/gomp/imperfect4.c
create mode 100644 gcc/testsuite/c-c++-common/gomp/imperfect5.c
create mode 100644 libgomp/testsuite/libgomp.c-c++-common/imperfect-transform-1.c
create mode 100644 libgomp/testsuite/libgomp.c-c++-common/imperfect-transform-2.c
create mode 100644 libgomp/testsuite/libgomp.c-c++-common/imperfect1.c
create mode 100644 libgomp/testsuite/libgomp.c-c++-common/imperfect2.c
create mode 100644 libgomp/testsuite/libgomp.c-c++-common/imperfect3.c
create mode 100644 libgomp/testsuite/libgomp.c-c++-common/imperfect4.c
create mode 100644 libgomp/testsuite/libgomp.c-c++-common/imperfect5.c
create mode 100644 libgomp/testsuite/libgomp.c-c++-common/imperfect6.c
create mode 100644 libgomp/testsuite/libgomp.c-c++-common/target-imperfect-transform-1.c
create mode 100644 libgomp/testsuite/libgomp.c-c++-common/target-imperfect-transform-2.c
create mode 100644 libgomp/testsuite/libgomp.c-c++-common/target-imperfect1.c
create mode 100644 libgomp/testsuite/libgomp.c-c++-common/target-imperfect2.c
create mode 100644 libgomp/testsuite/libgomp.c-c++-common/target-imperfect3.c
create mode 100644 libgomp/testsuite/libgomp.c-c++-common/target-imperfect4.c
diff --git a/gcc/testsuite/ChangeLog.omp b/gcc/testsuite/ChangeLog.omp
index d42813684e2..72d7b52256a 100644
--- a/gcc/testsuite/ChangeLog.omp
+++ b/gcc/testsuite/ChangeLog.omp
@@ -1,3 +1,11 @@
+2023-06-13 Sandra Loosemore <sandra@codesourcery.com>
+
+ * c-c++-common/gomp/imperfect1.c: New.
+ * c-c++-common/gomp/imperfect2.c: New.
+ * c-c++-common/gomp/imperfect3.c: New.
+ * c-c++-common/gomp/imperfect4.c: New.
+ * c-c++-common/gomp/imperfect5.c: New.
+
2023-06-13 Sandra Loosemore <sandra@codesourcery.com>
* c-c++-common/goacc/tile-2.c: Adjust expected error patterns.
diff --git a/gcc/testsuite/c-c++-common/gomp/imperfect1.c b/gcc/testsuite/c-c++-common/gomp/imperfect1.c
new file mode 100644
index 00000000000..705626ad169
--- /dev/null
+++ b/gcc/testsuite/c-c++-common/gomp/imperfect1.c
@@ -0,0 +1,38 @@
+/* { dg-do compile } */
+
+/* This test case is expected to fail due to errors. */
+
+int f1 (int depth, int iter);
+int f2 (int depth, int iter);
+
+void s1 (int a1, int a2, int a3)
+{
+ int i, j, k;
+
+#pragma omp for collapse(3)
+ for (i = 0; i < a1; i++)
+ {
+ f1 (0, i);
+ for (j = 0; j < a2; j++)
+ {
+#pragma omp barrier /* { dg-error "intervening code must not contain OpenMP directives" } */
+ f1 (1, j);
+ if (i == 2)
+ continue; /* { dg-error "invalid exit" } */
+ else
+ break; /* { dg-error "invalid exit" } */
+ for (k = 0; k < a3; k++)
+ {
+ f1 (2, k);
+ f2 (2, k);
+ }
+ f2 (1, j);
+ }
+ for (k = 0; k < a3; k++) /* { dg-error "loop not permitted in intervening code " } */
+ {
+ f1 (2, k);
+ f2 (2, k);
+ }
+ f2 (0, i);
+ }
+}
diff --git a/gcc/testsuite/c-c++-common/gomp/imperfect2.c b/gcc/testsuite/c-c++-common/gomp/imperfect2.c
new file mode 100644
index 00000000000..dff17dd3ca5
--- /dev/null
+++ b/gcc/testsuite/c-c++-common/gomp/imperfect2.c
@@ -0,0 +1,34 @@
+/* { dg-do compile } */
+
+/* This test case is expected to fail due to errors. */
+
+/* These functions that are part of the OpenMP runtime API would ordinarily
+ be declared in omp.h, but we don't have that here. */
+extern int omp_get_num_threads(void);
+extern int omp_get_max_threads(void);
+
+int f1 (int depth, int iter);
+int f2 (int depth, int iter);
+
+void s1 (int a1, int a2, int a3)
+{
+ int i, j, k;
+#pragma omp for collapse(3)
+ for (i = 0; i < a1; i++)
+ {
+ f1 (0, i);
+ for (j = 0; j < omp_get_num_threads (); j++) /* This is OK */
+ {
+ f1 (1, omp_get_num_threads ()); /* { dg-error "not permitted in intervening code" } */
+ for (k = omp_get_num_threads (); k < a3; k++) /* This is OK */
+ {
+ f1 (2, omp_get_num_threads ());
+ f2 (2, omp_get_max_threads ());
+ }
+ f2 (1, omp_get_max_threads ()); /* { dg-error "not permitted in intervening code" } */
+ }
+ f2 (0, i);
+ }
+}
+
+
diff --git a/gcc/testsuite/c-c++-common/gomp/imperfect3.c b/gcc/testsuite/c-c++-common/gomp/imperfect3.c
new file mode 100644
index 00000000000..ad727ed3170
--- /dev/null
+++ b/gcc/testsuite/c-c++-common/gomp/imperfect3.c
@@ -0,0 +1,33 @@
+/* { dg-do compile } */
+
+/* This test case is expected to fail due to errors. */
+
+/* Test that the imperfectly-nested loops with the ordered clause gives
+ an error, and that there is only one error (and not one on every
+ intervening statement). */
+
+int f1 (int depth, int iter);
+int f2 (int depth, int iter);
+
+void s1 (int a1, int a2, int a3)
+{
+ int i, j, k;
+
+#pragma omp for ordered(3)
+ for (i = 0; i < a1; i++) /* { dg-error "inner loops must be perfectly nested" } */
+ {
+ f1 (0, i);
+ for (j = 0; j < a2; j++)
+ {
+ f1 (1, j);
+ for (k = 0; k < a3; k++)
+ {
+ f1 (2, k);
+ f2 (2, k);
+ }
+ f2 (1, j);
+ }
+ f2 (0, i);
+ }
+}
+
diff --git a/gcc/testsuite/c-c++-common/gomp/imperfect4.c b/gcc/testsuite/c-c++-common/gomp/imperfect4.c
new file mode 100644
index 00000000000..1a0c07cd48e
--- /dev/null
+++ b/gcc/testsuite/c-c++-common/gomp/imperfect4.c
@@ -0,0 +1,33 @@
+/* { dg-do compile } */
+
+/* This test case is expected to fail due to errors. */
+
+int f1 (int depth, int iter);
+int f2 (int depth, int iter);
+
+void s1 (int a1, int a2, int a3)
+{
+ int i, j, k;
+
+#pragma omp for collapse(4)
+ for (i = 0; i < a1; i++) /* { dg-error "not enough nested loops" } */
+ {
+ f1 (0, i);
+ for (j = 0; j < a2; j++)
+ {
+ f1 (1, j);
+ for (k = 0; k < a3; k++)
+ {
+ /* 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" } */
+ f1 (2, k);
+ f2 (2, k);
+ }
+ f2 (1, j);
+ }
+ f2 (0, i);
+ }
+}
+
diff --git a/gcc/testsuite/c-c++-common/gomp/imperfect5.c b/gcc/testsuite/c-c++-common/gomp/imperfect5.c
new file mode 100644
index 00000000000..585d89ff789
--- /dev/null
+++ b/gcc/testsuite/c-c++-common/gomp/imperfect5.c
@@ -0,0 +1,57 @@
+/* { dg-do compile } */
+
+/* This test case is expected to fail due to errors. */
+
+int f1 (int depth, int iter);
+int f2 (int depth, int iter);
+int ijk (int x, int y, int z);
+void f3 (int sum);
+
+/* This function isn't particularly meaningful, but it should compile without
+ error. */
+int s1 (int a1, int a2, int a3)
+{
+ int i, j, k;
+ int r = 0;
+
+#pragma omp simd collapse(3) reduction (inscan, +:r)
+ for (i = 0; i < a1; i++)
+ {
+ for (j = 0; j < a2; j++)
+ {
+ for (k = 0; k < a3; k++)
+ {
+ r = r + ijk (i, j, k);
+#pragma omp scan exclusive (r)
+ f3 (r);
+ }
+ }
+ }
+ return r;
+}
+
+/* Adding intervening code should trigger an error. */
+int s2 (int a1, int a2, int a3)
+{
+ int i, j, k;
+ int r = 0;
+
+#pragma omp simd collapse(3) reduction (inscan, +:r)
+ for (i = 0; i < a1; i++) /* { dg-error "inner loops must be perfectly nested" } */
+ {
+ f1 (0, i);
+ for (j = 0; j < a2; j++)
+ {
+ f1 (1, j);
+ for (k = 0; k < a3; k++)
+ {
+ r = r + ijk (i, j, k);
+#pragma omp scan exclusive (r)
+ f3 (r);
+ }
+ f2 (1, j);
+ }
+ f2 (0, i);
+ }
+ return r;
+}
diff --git a/libgomp/ChangeLog.omp b/libgomp/ChangeLog.omp
index 29ef68843bc..cd6dfa6af2d 100644
--- a/libgomp/ChangeLog.omp
+++ b/libgomp/ChangeLog.omp
@@ -1,3 +1,20 @@
+2023-06-13 Sandra Loosemore <sandra@codesourcery.com>
+
+ * testsuite/libgomp.c-c++-common/imperfect-transform-1.c: New.
+ * testsuite/libgomp.c-c++-common/imperfect-transform-2.c: New.
+ * testsuite/libgomp.c-c++-common/imperfect1.c: New.
+ * testsuite/libgomp.c-c++-common/imperfect2.c: New.
+ * testsuite/libgomp.c-c++-common/imperfect3.c: New.
+ * testsuite/libgomp.c-c++-common/imperfect4.c: New.
+ * testsuite/libgomp.c-c++-common/imperfect5.c: New.
+ * testsuite/libgomp.c-c++-common/imperfect6.c: New.
+ * testsuite/libgomp.c-c++-common/target-imperfect-transform-1.c: New.
+ * testsuite/libgomp.c-c++-common/target-imperfect-transform-2.c: New.
+ * testsuite/libgomp.c-c++-common/target-imperfect1.c: New.
+ * testsuite/libgomp.c-c++-common/target-imperfect2.c: New.
+ * testsuite/libgomp.c-c++-common/target-imperfect3.c: New.
+ * testsuite/libgomp.c-c++-common/target-imperfect4.c: New.
+
2023-06-13 Sandra Loosemore <sandra@codesourcery.com>
* testsuite/libgomp.c++/imperfect-class-1.C: New.
diff --git a/libgomp/testsuite/libgomp.c-c++-common/imperfect-transform-1.c b/libgomp/testsuite/libgomp.c-c++-common/imperfect-transform-1.c
new file mode 100644
index 00000000000..6743594b2eb
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c-c++-common/imperfect-transform-1.c
@@ -0,0 +1,79 @@
+/* { dg-do run } */
+
+/* Like imperfect1.c, but also includes loop transforms. */
+
+static int f1count[3], f2count[3];
+
+#ifndef __cplusplus
+extern void abort (void);
+#else
+extern "C" void abort (void);
+#endif
+
+int f1 (int depth, int iter)
+{
+ f1count[depth]++;
+ return iter;
+}
+
+int f2 (int depth, int iter)
+{
+ f2count[depth]++;
+ return iter;
+}
+
+void s1 (int a1, int a2, int a3)
+{
+ int i, j, k;
+
+#pragma omp for collapse(2)
+ for (i = 0; i < a1; i++)
+ {
+ f1 (0, i);
+ for (j = 0; j < a2; j++)
+ {
+ f1 (1, j);
+#pragma omp unroll partial
+ for (k = 0; k < a3; k++)
+ {
+ f1 (2, k);
+ f2 (2, k);
+ }
+ f2 (1, j);
+ }
+ f2 (0, i);
+ }
+}
+
+int
+main (void)
+{
+ f1count[0] = 0;
+ f1count[1] = 0;
+ f1count[2] = 0;
+ f2count[0] = 0;
+ f2count[1] = 0;
+ f2count[2] = 0;
+
+ s1 (3, 4, 5);
+
+ /* All intervening code at the same depth must be executed the same
+ number of times. */
+ if (f1count[0] != f2count[0]) abort ();
+ if (f1count[1] != f2count[1]) abort ();
+ if (f1count[2] != f2count[2]) abort ();
+
+ /* Intervening code must be executed at least as many times as the loop
+ that encloses it. */
+ if (f1count[0] < 3) abort ();
+ if (f1count[1] < 3 * 4) abort ();
+
+ /* Intervening code must not be executed more times than the number
+ of logical iterations. */
+ if (f1count[0] > 3 * 4 * 5) abort ();
+ if (f1count[1] > 3 * 4 * 5) abort ();
+
+ /* Check that the innermost loop body is executed exactly the number
+ of logical iterations expected. */
+ if (f1count[2] != 3 * 4 * 5) abort ();
+}
diff --git a/libgomp/testsuite/libgomp.c-c++-common/imperfect-transform-2.c b/libgomp/testsuite/libgomp.c-c++-common/imperfect-transform-2.c
new file mode 100644
index 00000000000..e7d6a9941b4
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c-c++-common/imperfect-transform-2.c
@@ -0,0 +1,79 @@
+/* { dg-do run } */
+
+/* Like imperfect1.c, but also includes loop transforms. */
+
+static int f1count[3], f2count[3];
+
+#ifndef __cplusplus
+extern void abort (void);
+#else
+extern "C" void abort (void);
+#endif
+
+int f1 (int depth, int iter)
+{
+ f1count[depth]++;
+ return iter;
+}
+
+int f2 (int depth, int iter)
+{
+ f2count[depth]++;
+ return iter;
+}
+
+void s1 (int a1, int a2, int a3)
+{
+ int i, j, k;
+
+#pragma omp for collapse(2)
+ for (i = 0; i < a1; i++)
+ {
+ f1 (0, i);
+ for (j = 0; j < a2; j++)
+ {
+ f1 (1, j);
+#pragma omp tile sizes(5)
+ for (k = 0; k < a3; k++)
+ {
+ f1 (2, k);
+ f2 (2, k);
+ }
+ f2 (1, j);
+ }
+ f2 (0, i);
+ }
+}
+
+int
+main (void)
+{
+ f1count[0] = 0;
+ f1count[1] = 0;
+ f1count[2] = 0;
+ f2count[0] = 0;
+ f2count[1] = 0;
+ f2count[2] = 0;
+
+ s1 (3, 4, 5);
+
+ /* All intervening code at the same depth must be executed the same
+ number of times. */
+ if (f1count[0] != f2count[0]) abort ();
+ if (f1count[1] != f2count[1]) abort ();
+ if (f1count[2] != f2count[2]) abort ();
+
+ /* Intervening code must be executed at least as many times as the loop
+ that encloses it. */
+ if (f1count[0] < 3) abort ();
+ if (f1count[1] < 3 * 4) abort ();
+
+ /* Intervening code must not be executed more times than the number
+ of logical iterations. */
+ if (f1count[0] > 3 * 4 * 5) abort ();
+ if (f1count[1] > 3 * 4 * 5) abort ();
+
+ /* Check that the innermost loop body is executed exactly the number
+ of logical iterations expected. */
+ if (f1count[2] != 3 * 4 * 5) abort ();
+}
diff --git a/libgomp/testsuite/libgomp.c-c++-common/imperfect1.c b/libgomp/testsuite/libgomp.c-c++-common/imperfect1.c
new file mode 100644
index 00000000000..cafdcaf25b0
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c-c++-common/imperfect1.c
@@ -0,0 +1,76 @@
+/* { dg-do run } */
+
+static int f1count[3], f2count[3];
+
+#ifndef __cplusplus
+extern void abort (void);
+#else
+extern "C" void abort (void);
+#endif
+
+int f1 (int depth, int iter)
+{
+ f1count[depth]++;
+ return iter;
+}
+
+int f2 (int depth, int iter)
+{
+ f2count[depth]++;
+ return iter;
+}
+
+void s1 (int a1, int a2, int a3)
+{
+ int i, j, k;
+
+#pragma omp for collapse(3)
+ for (i = 0; i < a1; i++)
+ {
+ f1 (0, i);
+ for (j = 0; j < a2; j++)
+ {
+ f1 (1, j);
+ for (k = 0; k < a3; k++)
+ {
+ f1 (2, k);
+ f2 (2, k);
+ }
+ f2 (1, j);
+ }
+ f2 (0, i);
+ }
+}
+
+int
+main (void)
+{
+ f1count[0] = 0;
+ f1count[1] = 0;
+ f1count[2] = 0;
+ f2count[0] = 0;
+ f2count[1] = 0;
+ f2count[2] = 0;
+
+ s1 (3, 4, 5);
+
+ /* All intervening code at the same depth must be executed the same
+ number of times. */
+ if (f1count[0] != f2count[0]) abort ();
+ if (f1count[1] != f2count[1]) abort ();
+ if (f1count[2] != f2count[2]) abort ();
+
+ /* Intervening code must be executed at least as many times as the loop
+ that encloses it. */
+ if (f1count[0] < 3) abort ();
+ if (f1count[1] < 3 * 4) abort ();
+
+ /* Intervening code must not be executed more times than the number
+ of logical iterations. */
+ if (f1count[0] > 3 * 4 * 5) abort ();
+ if (f1count[1] > 3 * 4 * 5) abort ();
+
+ /* Check that the innermost loop body is executed exactly the number
+ of logical iterations expected. */
+ if (f1count[2] != 3 * 4 * 5) abort ();
+}
diff --git a/libgomp/testsuite/libgomp.c-c++-common/imperfect2.c b/libgomp/testsuite/libgomp.c-c++-common/imperfect2.c
new file mode 100644
index 00000000000..e2098006eab
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c-c++-common/imperfect2.c
@@ -0,0 +1,114 @@
+/* { dg-do run } */
+
+static int f1count[3], f2count[3];
+static int g1count[3], g2count[3];
+
+#ifndef __cplusplus
+extern void abort (void);
+#else
+extern "C" void abort (void);
+#endif
+
+int f1 (int depth, int iter)
+{
+ f1count[depth]++;
+ return iter;
+}
+
+int f2 (int depth, int iter)
+{
+ f2count[depth]++;
+ return iter;
+}
+
+int g1 (int depth, int iter)
+{
+ g1count[depth]++;
+ return iter;
+}
+
+int g2 (int depth, int iter)
+{
+ g2count[depth]++;
+ return iter;
+}
+
+void s1 (int a1, int a2, int a3)
+{
+ int i, j, k;
+
+#pragma omp for collapse(3)
+ for (i = 0; i < a1; i++)
+ {
+ f1 (0, i);
+ {
+ g1 (0, i);
+ for (j = 0; j < a2; j++)
+ {
+ f1 (1, j);
+ {
+ g1 (1, j);
+ for (k = 0; k < a3; k++)
+ {
+ f1 (2, k);
+ {
+ g1 (2, k);
+ g2 (2, k);
+ }
+ f2 (2, k);
+ }
+ g2 (1, j);
+ }
+ f2 (1, j);
+ }
+ g2 (0, i);
+ }
+ f2 (0, i);
+ }
+}
+
+int
+main (void)
+{
+ f1count[0] = 0;
+ f1count[1] = 0;
+ f1count[2] = 0;
+ f2count[0] = 0;
+ f2count[1] = 0;
+ f2count[2] = 0;
+
+ g1count[0] = 0;
+ g1count[1] = 0;
+ g1count[2] = 0;
+ g2count[0] = 0;
+ g2count[1] = 0;
+ g2count[2] = 0;
+
+ s1 (3, 4, 5);
+
+ /* All intervening code at the same depth must be executed the same
+ number of times. */
+ if (f1count[0] != f2count[0]) abort ();
+ if (f1count[1] != f2count[1]) abort ();
+ if (f1count[2] != f2count[2]) abort ();
+ if (g1count[0] != f1count[0]) abort ();
+ if (g2count[0] != f1count[0]) abort ();
+ if (g1count[1] != f1count[1]) abort ();
+ if (g2count[1] != f1count[1]) abort ();
+ if (g1count[2] != f1count[2]) abort ();
+ if (g2count[2] != f1count[2]) abort ();
+
+ /* Intervening code must be executed at least as many times as the loop
+ that encloses it. */
+ if (f1count[0] < 3) abort ();
+ if (f1count[1] < 3 * 4) abort ();
+
+ /* Intervening code must not be executed more times than the number
+ of logical iterations. */
+ if (f1count[0] > 3 * 4 * 5) abort ();
+ if (f1count[1] > 3 * 4 * 5) abort ();
+
+ /* Check that the innermost loop body is executed exactly the number
+ of logical iterations expected. */
+ if (f1count[2] != 3 * 4 * 5) abort ();
+}
diff --git a/libgomp/testsuite/libgomp.c-c++-common/imperfect3.c b/libgomp/testsuite/libgomp.c-c++-common/imperfect3.c
new file mode 100644
index 00000000000..feb5e32d1d6
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c-c++-common/imperfect3.c
@@ -0,0 +1,119 @@
+/* { dg-do run } */
+
+/* Like imperfect2.c, but includes bindings in the blocks. */
+
+static int f1count[3], f2count[3];
+static int g1count[3], g2count[3];
+
+#ifndef __cplusplus
+extern void abort (void);
+#else
+extern "C" void abort (void);
+#endif
+
+int f1 (int depth, int iter)
+{
+ f1count[depth]++;
+ return iter;
+}
+
+int f2 (int depth, int iter)
+{
+ f2count[depth]++;
+ return iter;
+}
+
+int g1 (int depth, int iter)
+{
+ g1count[depth]++;
+ return iter;
+}
+
+int g2 (int depth, int iter)
+{
+ g2count[depth]++;
+ return iter;
+}
+
+void s1 (int a1, int a2, int a3)
+{
+ int i, j, k;
+
+#pragma omp for collapse(3)
+ for (i = 0; i < a1; i++)
+ {
+ int local0 = 0;
+ f1 (local0, i);
+ {
+ g1 (local0, i);
+ for (j = 0; j < a2; j++)
+ {
+ int local1 = 1;
+ f1 (local1, j);
+ {
+ g1 (local1, j);
+ for (k = 0; k < a3; k++)
+ {
+ int local2 = 2;
+ f1 (local2, k);
+ {
+ g1 (local2, k);
+ g2 (local2, k);
+ }
+ f2 (local2, k);
+ }
+ g2 (local1, j);
+ }
+ f2 (local1, j);
+ }
+ g2 (local0, i);
+ }
+ f2 (local0, i);
+ }
+}
+
+int
+main (void)
+{
+ f1count[0] = 0;
+ f1count[1] = 0;
+ f1count[2] = 0;
+ f2count[0] = 0;
+ f2count[1] = 0;
+ f2count[2] = 0;
+
+ g1count[0] = 0;
+ g1count[1] = 0;
+ g1count[2] = 0;
+ g2count[0] = 0;
+ g2count[1] = 0;
+ g2count[2] = 0;
+
+ s1 (3, 4, 5);
+
+ /* All intervening code at the same depth must be executed the same
+ number of times. */
+ if (f1count[0] != f2count[0]) abort ();
+ if (f1count[1] != f2count[1]) abort ();
+ if (f1count[2] != f2count[2]) abort ();
+ if (g1count[0] != f1count[0]) abort ();
+ if (g2count[0] != f1count[0]) abort ();
+ if (g1count[1] != f1count[1]) abort ();
+ if (g2count[1] != f1count[1]) abort ();
+ if (g1count[2] != f1count[2]) abort ();
+ if (g2count[2] != f1count[2]) abort ();
+
+ /* Intervening code must be executed at least as many times as the loop
+ that encloses it. */
+ if (f1count[0] < 3) abort ();
+ if (f1count[1] < 3 * 4) abort ();
+
+ /* Intervening code must not be executed more times than the number
+ of logical iterations. */
+ if (f1count[0] > 3 * 4 * 5) abort ();
+ if (f1count[1] > 3 * 4 * 5) abort ();
+
+ /* Check that the innermost loop body is executed exactly the number
+ of logical iterations expected. */
+ if (f1count[2] != 3 * 4 * 5) abort ();
+}
diff --git a/libgomp/testsuite/libgomp.c-c++-common/imperfect4.c b/libgomp/testsuite/libgomp.c-c++-common/imperfect4.c
new file mode 100644
index 00000000000..e29301bfbad
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c-c++-common/imperfect4.c
@@ -0,0 +1,117 @@
+/* { dg-do run } */
+
+/* Like imperfect2.c, but includes blocks that are themselves intervening
+ code. */
+
+static int f1count[3], f2count[3];
+static int g1count[3], g2count[3];
+
+#ifndef __cplusplus
+extern void abort (void);
+#else
+extern "C" void abort (void);
+#endif
+
+int f1 (int depth, int iter)
+{
+ f1count[depth]++;
+ return iter;
+}
+
+int f2 (int depth, int iter)
+{
+ f2count[depth]++;
+ return iter;
+}
+
+int g1 (int depth, int iter)
+{
+ g1count[depth]++;
+ return iter;
+}
+
+int g2 (int depth, int iter)
+{
+ g2count[depth]++;
+ return iter;
+}
+
+void s1 (int a1, int a2, int a3)
+{
+ int i, j, k;
+
+#pragma omp for collapse(3)
+ for (i = 0; i < a1; i++)
+ {
+ { f1 (0, i); }
+ {
+ g1 (0, i);
+ for (j = 0; j < a2; j++)
+ {
+ { f1 (1, j); }
+ {
+ { g1 (1, j); }
+ for (k = 0; k < a3; k++)
+ {
+ f1 (2, k);
+ {
+ g1 (2, k);
+ g2 (2, k);
+ }
+ f2 (2, k);
+ }
+ { g2 (1, j); }
+ }
+ { f2 (1, j); }
+ }
+ { g2 (0, i); }
+ }
+ { f2 (0, i); }
+ }
+}
+
+int
+main (void)
+{
+ f1count[0] = 0;
+ f1count[1] = 0;
+ f1count[2] = 0;
+ f2count[0] = 0;
+ f2count[1] = 0;
+ f2count[2] = 0;
+
+ g1count[0] = 0;
+ g1count[1] = 0;
+ g1count[2] = 0;
+ g2count[0] = 0;
+ g2count[1] = 0;
+ g2count[2] = 0;
+
+ s1 (3, 4, 5);
+
+ /* All intervening code at the same depth must be executed the same
+ number of times. */
+ if (f1count[0] != f2count[0]) abort ();
+ if (f1count[1] != f2count[1]) abort ();
+ if (f1count[2] != f2count[2]) abort ();
+ if (g1count[0] != f1count[0]) abort ();
+ if (g2count[0] != f1count[0]) abort ();
+ if (g1count[1] != f1count[1]) abort ();
+ if (g2count[1] != f1count[1]) abort ();
+ if (g1count[2] != f1count[2]) abort ();
+ if (g2count[2] != f1count[2]) abort ();
+
+ /* Intervening code must be executed at least as many times as the loop
+ that encloses it. */
+ if (f1count[0] < 3) abort ();
+ if (f1count[1] < 3 * 4) abort ();
+
+ /* Intervening code must not be executed more times than the number
+ of logical iterations. */
+ if (f1count[0] > 3 * 4 * 5) abort ();
+ if (f1count[1] > 3 * 4 * 5) abort ();
+
+ /* Check that the innermost loop body is executed exactly the number
+ of logical iterations expected. */
+ if (f1count[2] != 3 * 4 * 5) abort ();
+}
diff --git a/libgomp/testsuite/libgomp.c-c++-common/imperfect5.c b/libgomp/testsuite/libgomp.c-c++-common/imperfect5.c
new file mode 100644
index 00000000000..7bd4f12d472
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c-c++-common/imperfect5.c
@@ -0,0 +1,49 @@
+/* { dg-do run } */
+
+#ifndef __cplusplus
+extern void abort (void);
+#else
+extern "C" void abort (void);
+#endif
+
+static int inner_loop_count = 0;
+static int intervening_code_count = 0;
+
+void
+g (int x, int y)
+{
+ inner_loop_count++;
+}
+
+int
+foo (int imax, int jmax)
+{
+ int j = 0;
+
+#pragma omp for collapse(2)
+ for (int i = 0; i < imax; ++i)
+ {
+ /* All the intervening code at the same level must be executed
+ the same number of times. */
+ ++intervening_code_count;
+ for (int j = 0; j < jmax; ++j)
+ {
+ g (i, j);
+ }
+ /* This is the outer j, not the one from the inner collapsed loop. */
+ ++j;
+ }
+ return j;
+}
+
+int
+main (void)
+{
+ int j = foo (5, 3);
+ if (j != intervening_code_count)
+ abort ();
+ if (inner_loop_count != 5 * 3)
+ abort ();
+ if (intervening_code_count < 5 || intervening_code_count > 5 * 3)
+ abort ();
+}
diff --git a/libgomp/testsuite/libgomp.c-c++-common/imperfect6.c b/libgomp/testsuite/libgomp.c-c++-common/imperfect6.c
new file mode 100644
index 00000000000..808c6540890
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c-c++-common/imperfect6.c
@@ -0,0 +1,115 @@
+/* { dg-do run } */
+
+/* Like imperfect4.c, but bind the iteration variables in the loops. */
+
+static int f1count[3], f2count[3];
+static int g1count[3], g2count[3];
+
+#ifndef __cplusplus
+extern void abort (void);
+#else
+extern "C" void abort (void);
+#endif
+
+int f1 (int depth, int iter)
+{
+ f1count[depth]++;
+ return iter;
+}
+
+int f2 (int depth, int iter)
+{
+ f2count[depth]++;
+ return iter;
+}
+
+int g1 (int depth, int iter)
+{
+ g1count[depth]++;
+ return iter;
+}
+
+int g2 (int depth, int iter)
+{
+ g2count[depth]++;
+ return iter;
+}
+
+void s1 (int a1, int a2, int a3)
+{
+
+#pragma omp for collapse(3)
+ for (int i = 0; i < a1; i++)
+ {
+ { f1 (0, i); }
+ {
+ g1 (0, i);
+ for (int j = 0; j < a2; j++)
+ {
+ { f1 (1, j); }
+ {
+ { g1 (1, j); }
+ for (int k = 0; k < a3; k++)
+ {
+ f1 (2, k);
+ {
+ g1 (2, k);
+ g2 (2, k);
+ }
+ f2 (2, k);
+ }
+ { g2 (1, j); }
+ }
+ { f2 (1, j); }
+ }
+ { g2 (0, i); }
+ }
+ { f2 (0, i); }
+ }
+}
+
+int
+main (void)
+{
+ f1count[0] = 0;
+ f1count[1] = 0;
+ f1count[2] = 0;
+ f2count[0] = 0;
+ f2count[1] = 0;
+ f2count[2] = 0;
+
+ g1count[0] = 0;
+ g1count[1] = 0;
+ g1count[2] = 0;
+ g2count[0] = 0;
+ g2count[1] = 0;
+ g2count[2] = 0;
+
+ s1 (3, 4, 5);
+
+ /* All intervening code at the same depth must be executed the same
+ number of times. */
+ if (f1count[0] != f2count[0]) abort ();
+ if (f1count[1] != f2count[1]) abort ();
+ if (f1count[2] != f2count[2]) abort ();
+ if (g1count[0] != f1count[0]) abort ();
+ if (g2count[0] != f1count[0]) abort ();
+ if (g1count[1] != f1count[1]) abort ();
+ if (g2count[1] != f1count[1]) abort ();
+ if (g1count[2] != f1count[2]) abort ();
+ if (g2count[2] != f1count[2]) abort ();
+
+ /* Intervening code must be executed at least as many times as the loop
+ that encloses it. */
+ if (f1count[0] < 3) abort ();
+ if (f1count[1] < 3 * 4) abort ();
+
+ /* Intervening code must not be executed more times than the number
+ of logical iterations. */
+ if (f1count[0] > 3 * 4 * 5) abort ();
+ if (f1count[1] > 3 * 4 * 5) abort ();
+
+ /* Check that the innermost loop body is executed exactly the number
+ of logical iterations expected. */
+ if (f1count[2] != 3 * 4 * 5) abort ();
+}
diff --git a/libgomp/testsuite/libgomp.c-c++-common/target-imperfect-transform-1.c b/libgomp/testsuite/libgomp.c-c++-common/target-imperfect-transform-1.c
new file mode 100644
index 00000000000..0e33e028ac2
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c-c++-common/target-imperfect-transform-1.c
@@ -0,0 +1,82 @@
+/* { dg-do run } */
+
+/* Like imperfect-transform.c, but enables offloading. */
+
+static int f1count[3], f2count[3];
+#pragma omp declare target enter (f1count, f2count)
+
+#ifndef __cplusplus
+extern void abort (void);
+#else
+extern "C" void abort (void);
+#endif
+
+int f1 (int depth, int iter)
+{
+ #pragma omp atomic
+ f1count[depth]++;
+ return iter;
+}
+
+int f2 (int depth, int iter)
+{
+ #pragma omp atomic
+ f2count[depth]++;
+ return iter;
+}
+
+void s1 (int a1, int a2, int a3)
+{
+ int i, j, k;
+
+#pragma omp target parallel for collapse(2) map(always, tofrom:f1count, f2count)
+ for (i = 0; i < a1; i++)
+ {
+ f1 (0, i);
+ for (j = 0; j < a2; j++)
+ {
+ f1 (1, j);
+#pragma omp unroll partial
+ for (k = 0; k < a3; k++)
+ {
+ f1 (2, k);
+ f2 (2, k);
+ }
+ f2 (1, j);
+ }
+ f2 (0, i);
+ }
+}
+
+int
+main (void)
+{
+ f1count[0] = 0;
+ f1count[1] = 0;
+ f1count[2] = 0;
+ f2count[0] = 0;
+ f2count[1] = 0;
+ f2count[2] = 0;
+
+ s1 (3, 4, 5);
+
+ /* All intervening code at the same depth must be executed the same
+ number of times. */
+ if (f1count[0] != f2count[0]) abort ();
+ if (f1count[1] != f2count[1]) abort ();
+ if (f1count[2] != f2count[2]) abort ();
+
+ /* Intervening code must be executed at least as many times as the loop
+ that encloses it. */
+ if (f1count[0] < 3) abort ();
+ if (f1count[1] < 3 * 4) abort ();
+
+ /* Intervening code must not be executed more times than the number
+ of logical iterations. */
+ if (f1count[0] > 3 * 4 * 5) abort ();
+ if (f1count[1] > 3 * 4 * 5) abort ();
+
+ /* Check that the innermost loop body is executed exactly the number
+ of logical iterations expected. */
+ if (f1count[2] != 3 * 4 * 5) abort ();
+}
diff --git a/libgomp/testsuite/libgomp.c-c++-common/target-imperfect-transform-2.c b/libgomp/testsuite/libgomp.c-c++-common/target-imperfect-transform-2.c
new file mode 100644
index 00000000000..78986e8d3ae
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c-c++-common/target-imperfect-transform-2.c
@@ -0,0 +1,82 @@
+/* { dg-do run } */
+
+/* Like imperfect-transform.c, but enables offloading. */
+
+static int f1count[3], f2count[3];
+#pragma omp declare target enter (f1count, f2count)
+
+#ifndef __cplusplus
+extern void abort (void);
+#else
+extern "C" void abort (void);
+#endif
+
+int f1 (int depth, int iter)
+{
+ #pragma omp atomic
+ f1count[depth]++;
+ return iter;
+}
+
+int f2 (int depth, int iter)
+{
+ #pragma omp atomic
+ f2count[depth]++;
+ return iter;
+}
+
+void s1 (int a1, int a2, int a3)
+{
+ int i, j, k;
+
+#pragma omp target parallel for collapse(2) map(always, tofrom:f1count, f2count)
+ for (i = 0; i < a1; i++)
+ {
+ f1 (0, i);
+ for (j = 0; j < a2; j++)
+ {
+ f1 (1, j);
+#pragma omp tile sizes(5)
+ for (k = 0; k < a3; k++)
+ {
+ f1 (2, k);
+ f2 (2, k);
+ }
+ f2 (1, j);
+ }
+ f2 (0, i);
+ }
+}
+
+int
+main (void)
+{
+ f1count[0] = 0;
+ f1count[1] = 0;
+ f1count[2] = 0;
+ f2count[0] = 0;
+ f2count[1] = 0;
+ f2count[2] = 0;
+
+ s1 (3, 4, 5);
+
+ /* All intervening code at the same depth must be executed the same
+ number of times. */
+ if (f1count[0] != f2count[0]) abort ();
+ if (f1count[1] != f2count[1]) abort ();
+ if (f1count[2] != f2count[2]) abort ();
+
+ /* Intervening code must be executed at least as many times as the loop
+ that encloses it. */
+ if (f1count[0] < 3) abort ();
+ if (f1count[1] < 3 * 4) abort ();
+
+ /* Intervening code must not be executed more times than the number
+ of logical iterations. */
+ if (f1count[0] > 3 * 4 * 5) abort ();
+ if (f1count[1] > 3 * 4 * 5) abort ();
+
+ /* Check that the innermost loop body is executed exactly the number
+ of logical iterations expected. */
+ if (f1count[2] != 3 * 4 * 5) abort ();
+}
diff --git a/libgomp/testsuite/libgomp.c-c++-common/target-imperfect1.c b/libgomp/testsuite/libgomp.c-c++-common/target-imperfect1.c
new file mode 100644
index 00000000000..53bc611ace3
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c-c++-common/target-imperfect1.c
@@ -0,0 +1,81 @@
+/* { dg-do run } */
+
+/* Like imperfect1.c, but enables offloading. */
+
+static int f1count[3], f2count[3];
+#pragma omp declare target enter (f1count, f2count)
+
+#ifndef __cplusplus
+extern void abort (void);
+#else
+extern "C" void abort (void);
+#endif
+
+int f1 (int depth, int iter)
+{
+ #pragma omp atomic
+ f1count[depth]++;
+ return iter;
+}
+
+int f2 (int depth, int iter)
+{
+ #pragma omp atomic
+ f2count[depth]++;
+ return iter;
+}
+
+void s1 (int a1, int a2, int a3)
+{
+ int i, j, k;
+
+#pragma omp target parallel for collapse(3) map(always, tofrom:f1count, f2count)
+ for (i = 0; i < a1; i++)
+ {
+ f1 (0, i);
+ for (j = 0; j < a2; j++)
+ {
+ f1 (1, j);
+ for (k = 0; k < a3; k++)
+ {
+ f1 (2, k);
+ f2 (2, k);
+ }
+ f2 (1, j);
+ }
+ f2 (0, i);
+ }
+}
+
+int
+main (void)
+{
+ f1count[0] = 0;
+ f1count[1] = 0;
+ f1count[2] = 0;
+ f2count[0] = 0;
+ f2count[1] = 0;
+ f2count[2] = 0;
+
+ s1 (3, 4, 5);
+
+ /* All intervening code at the same depth must be executed the same
+ number of times. */
+ if (f1count[0] != f2count[0]) abort ();
+ if (f1count[1] != f2count[1]) abort ();
+ if (f1count[2] != f2count[2]) abort ();
+
+ /* Intervening code must be executed at least as many times as the loop
+ that encloses it. */
+ if (f1count[0] < 3) abort ();
+ if (f1count[1] < 3 * 4) abort ();
+
+ /* Intervening code must not be executed more times than the number
+ of logical iterations. */
+ if (f1count[0] > 3 * 4 * 5) abort ();
+ if (f1count[1] > 3 * 4 * 5) abort ();
+
+ /* Check that the innermost loop body is executed exactly the number
+ of logical iterations expected. */
+ if (f1count[2] != 3 * 4 * 5) abort ();
+}
diff --git a/libgomp/testsuite/libgomp.c-c++-common/target-imperfect2.c b/libgomp/testsuite/libgomp.c-c++-common/target-imperfect2.c
new file mode 100644
index 00000000000..bc2901a517e
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c-c++-common/target-imperfect2.c
@@ -0,0 +1,122 @@
+/* { dg-do run } */
+
+/* Like imperfect2.c, but enables offloading. */
+
+static int f1count[3], f2count[3];
+static int g1count[3], g2count[3];
+#pragma omp declare target enter (f1count, f2count)
+#pragma omp declare target enter (g1count, g2count)
+
+#ifndef __cplusplus
+extern void abort (void);
+#else
+extern "C" void abort (void);
+#endif
+
+int f1 (int depth, int iter)
+{
+ #pragma omp atomic
+ f1count[depth]++;
+ return iter;
+}
+
+int f2 (int depth, int iter)
+{
+ #pragma omp atomic
+ f2count[depth]++;
+ return iter;
+}
+
+int g1 (int depth, int iter)
+{
+ #pragma omp atomic
+ g1count[depth]++;
+ return iter;
+}
+
+int g2 (int depth, int iter)
+{
+ #pragma omp atomic
+ g2count[depth]++;
+ return iter;
+}
+
+void s1 (int a1, int a2, int a3)
+{
+ int i, j, k;
+
+#pragma omp target parallel for collapse(3) map(always, tofrom:f1count, f2count, g1count, g2count)
+ for (i = 0; i < a1; i++)
+ {
+ f1 (0, i);
+ {
+ g1 (0, i);
+ for (j = 0; j < a2; j++)
+ {
+ f1 (1, j);
+ {
+ g1 (1, j);
+ for (k = 0; k < a3; k++)
+ {
+ f1 (2, k);
+ {
+ g1 (2, k);
+ g2 (2, k);
+ }
+ f2 (2, k);
+ }
+ g2 (1, j);
+ }
+ f2 (1, j);
+ }
+ g2 (0, i);
+ }
+ f2 (0, i);
+ }
+}
+
+int
+main (void)
+{
+ f1count[0] = 0;
+ f1count[1] = 0;
+ f1count[2] = 0;
+ f2count[0] = 0;
+ f2count[1] = 0;
+ f2count[2] = 0;
+
+ g1count[0] = 0;
+ g1count[1] = 0;
+ g1count[2] = 0;
+ g2count[0] = 0;
+ g2count[1] = 0;
+ g2count[2] = 0;
+
+ s1 (3, 4, 5);
+
+ /* All intervening code at the same depth must be executed the same
+ number of times. */
+ if (f1count[0] != f2count[0]) abort ();
+ if (f1count[1] != f2count[1]) abort ();
+ if (f1count[2] != f2count[2]) abort ();
+ if (g1count[0] != f1count[0]) abort ();
+ if (g2count[0] != f1count[0]) abort ();
+ if (g1count[1] != f1count[1]) abort ();
+ if (g2count[1] != f1count[1]) abort ();
+ if (g1count[2] != f1count[2]) abort ();
+ if (g2count[2] != f1count[2]) abort ();
+
+ /* Intervening code must be executed at least as many times as the loop
+ that encloses it. */
+ if (f1count[0] < 3) abort ();
+ if (f1count[1] < 3 * 4) abort ();
+
+ /* Intervening code must not be executed more times than the number
+ of logical iterations. */
+ if (f1count[0] > 3 * 4 * 5) abort ();
+ if (f1count[1] > 3 * 4 * 5) abort ();
+
+ /* Check that the innermost loop body is executed exactly the number
+ of logical iterations expected. */
+ if (f1count[2] != 3 * 4 * 5) abort ();
+}
diff --git a/libgomp/testsuite/libgomp.c-c++-common/target-imperfect3.c b/libgomp/testsuite/libgomp.c-c++-common/target-imperfect3.c
new file mode 100644
index 00000000000..ddcfcf4b7eb
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c-c++-common/target-imperfect3.c
@@ -0,0 +1,125 @@
+/* { dg-do run } */
+
+/* Like imperfect3.c, but enables offloading. */
+
+static int f1count[3], f2count[3];
+static int g1count[3], g2count[3];
+#pragma omp declare target enter (f1count, f2count)
+#pragma omp declare target enter (g1count, g2count)
+
+#ifndef __cplusplus
+extern void abort (void);
+#else
+extern "C" void abort (void);
+#endif
+
+int f1 (int depth, int iter)
+{
+ #pragma omp atomic
+ f1count[depth]++;
+ return iter;
+}
+
+int f2 (int depth, int iter)
+{
+ #pragma omp atomic
+ f2count[depth]++;
+ return iter;
+}
+
+int g1 (int depth, int iter)
+{
+ #pragma omp atomic
+ g1count[depth]++;
+ return iter;
+}
+
+int g2 (int depth, int iter)
+{
+ #pragma omp atomic
+ g2count[depth]++;
+ return iter;
+}
+
+void s1 (int a1, int a2, int a3)
+{
+ int i, j, k;
+
+#pragma omp target parallel for collapse(3) map(always, tofrom:f1count, f2count, g1count, g2count)
+ for (i = 0; i < a1; i++)
+ {
+ int local0 = 0;
+ f1 (local0, i);
+ {
+ g1 (local0, i);
+ for (j = 0; j < a2; j++)
+ {
+ int local1 = 1;
+ f1 (local1, j);
+ {
+ g1 (local1, j);
+ for (k = 0; k < a3; k++)
+ {
+ int local2 = 2;
+ f1 (local2, k);
+ {
+ g1 (local2, k);
+ g2 (local2, k);
+ }
+ f2 (local2, k);
+ }
+ g2 (local1, j);
+ }
+ f2 (local1, j);
+ }
+ g2 (local0, i);
+ }
+ f2 (local0, i);
+ }
+}
+
+int
+main (void)
+{
+ f1count[0] = 0;
+ f1count[1] = 0;
+ f1count[2] = 0;
+ f2count[0] = 0;
+ f2count[1] = 0;
+ f2count[2] = 0;
+
+ g1count[0] = 0;
+ g1count[1] = 0;
+ g1count[2] = 0;
+ g2count[0] = 0;
+ g2count[1] = 0;
+ g2count[2] = 0;
+
+ s1 (3, 4, 5);
+
+ /* All intervening code at the same depth must be executed the same
+ number of times. */
+ if (f1count[0] != f2count[0]) abort ();
+ if (f1count[1] != f2count[1]) abort ();
+ if (f1count[2] != f2count[2]) abort ();
+ if (g1count[0] != f1count[0]) abort ();
+ if (g2count[0] != f1count[0]) abort ();
+ if (g1count[1] != f1count[1]) abort ();
+ if (g2count[1] != f1count[1]) abort ();
+ if (g1count[2] != f1count[2]) abort ();
+ if (g2count[2] != f1count[2]) abort ();
+
+ /* Intervening code must be executed at least as many times as the loop
+ that encloses it. */
+ if (f1count[0] < 3) abort ();
+ if (f1count[1] < 3 * 4) abort ();
+
+ /* Intervening code must not be executed more times than the number
+ of logical iterations. */
+ if (f1count[0] > 3 * 4 * 5) abort ();
+ if (f1count[1] > 3 * 4 * 5) abort ();
+
+ /* Check that the innermost loop body is executed exactly the number
+ of logical iterations expected. */
+ if (f1count[2] != 3 * 4 * 5) abort ();
+}
diff --git a/libgomp/testsuite/libgomp.c-c++-common/target-imperfect4.c b/libgomp/testsuite/libgomp.c-c++-common/target-imperfect4.c
new file mode 100644
index 00000000000..ede488977b8
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c-c++-common/target-imperfect4.c
@@ -0,0 +1,122 @@
+/* { dg-do run } */
+
+/* Like imperfect4.c, but enables offloading. */
+
+static int f1count[3], f2count[3];
+static int g1count[3], g2count[3];
+#pragma omp declare target enter (f1count, f2count)
+#pragma omp declare target enter (g1count, g2count)
+
+#ifndef __cplusplus
+extern void abort (void);
+#else
+extern "C" void abort (void);
+#endif
+
+int f1 (int depth, int iter)
+{
+ #pragma omp atomic
+ f1count[depth]++;
+ return iter;
+}
+
+int f2 (int depth, int iter)
+{
+ #pragma omp atomic
+ f2count[depth]++;
+ return iter;
+}
+
+int g1 (int depth, int iter)
+{
+ #pragma omp atomic
+ g1count[depth]++;
+ return iter;
+}
+
+int g2 (int depth, int iter)
+{
+ #pragma omp atomic
+ g2count[depth]++;
+ return iter;
+}
+
+void s1 (int a1, int a2, int a3)
+{
+ int i, j, k;
+
+#pragma omp target parallel for collapse(3) map(always, tofrom:f1count, f2count, g1count, g2count)
+ for (i = 0; i < a1; i++)
+ {
+ { f1 (0, i); }
+ {
+ g1 (0, i);
+ for (j = 0; j < a2; j++)
+ {
+ { f1 (1, j); }
+ {
+ { g1 (1, j); }
+ for (k = 0; k < a3; k++)
+ {
+ f1 (2, k);
+ {
+ g1 (2, k);
+ g2 (2, k);
+ }
+ f2 (2, k);
+ }
+ { g2 (1, j); }
+ }
+ { f2 (1, j); }
+ }
+ { g2 (0, i); }
+ }
+ { f2 (0, i); }
+ }
+}
+
+int
+main (void)
+{
+ f1count[0] = 0;
+ f1count[1] = 0;
+ f1count[2] = 0;
+ f2count[0] = 0;
+ f2count[1] = 0;
+ f2count[2] = 0;
+
+ g1count[0] = 0;
+ g1count[1] = 0;
+ g1count[2] = 0;
+ g2count[0] = 0;
+ g2count[1] = 0;
+ g2count[2] = 0;
+
+ s1 (3, 4, 5);
+
+ /* All intervening code at the same depth must be executed the same
+ number of times. */
+ if (f1count[0] != f2count[0]) abort ();
+ if (f1count[1] != f2count[1]) abort ();
+ if (f1count[2] != f2count[2]) abort ();
+ if (g1count[0] != f1count[0]) abort ();
+ if (g2count[0] != f1count[0]) abort ();
+ if (g1count[1] != f1count[1]) abort ();
+ if (g2count[1] != f1count[1]) abort ();
+ if (g1count[2] != f1count[2]) abort ();
+ if (g2count[2] != f1count[2]) abort ();
+
+ /* Intervening code must be executed at least as many times as the loop
+ that encloses it. */
+ if (f1count[0] < 3) abort ();
+ if (f1count[1] < 3 * 4) abort ();
+
+ /* Intervening code must not be executed more times than the number
+ of logical iterations. */
+ if (f1count[0] > 3 * 4 * 5) abort ();
+ if (f1count[1] > 3 * 4 * 5) abort ();
+
+ /* Check that the innermost loop body is executed exactly the number
+ of logical iterations expected. */
+ if (f1count[2] != 3 * 4 * 5) abort ();
+}
--
2.31.1
^ permalink raw reply [flat|nested] 7+ messages in thread* [OG13 5/6] OpenMP: Refactor and tidy Fortran front-end code for loop transformations
2023-06-14 22:07 [OG13 0/6] OpenMP: Support for imperfectly-nested loops Sandra Loosemore
` (3 preceding siblings ...)
2023-06-14 22:08 ` [OG13 4/6] OpenMP: New c/c++ testcases " Sandra Loosemore
@ 2023-06-14 22:08 ` Sandra Loosemore
2023-06-14 22:08 ` [OG13 6/6] OpenMP: Fortran support for imperfectly nested loops Sandra Loosemore
5 siblings, 0 replies; 7+ messages in thread
From: Sandra Loosemore @ 2023-06-14 22:08 UTC (permalink / raw)
To: gcc-patches
This patch rearranges some code previously added to support loop
transformations to simplify merging support for imperfectly-nested loops
in a subsequent patch. There is no new functionality added here.
gcc/fortran/ChangeLog
* openmp.cc (find_nested_loop_in_chain): Move up in file.
(find_nested_loop_in_block): Likewise.
(resolve_nested_loops): New helper function to consolidate code
from...
(resolve_omp_do, resolve_omp_tile): ...these functions. Also,
remove the redundant call to resolve_nested_loop_transforms, and
use uniform error message wording.
gcc/testsuite/ChangeLog
* gfortran.dg/gomp/collapse1.f90: Adjust expected error message.
* gfortran.dg/gomp/collapse2.f90: Likewise.
* gfortran.dg/gomp/loop-transforms/tile-2.f90: Likewise.
---
gcc/fortran/ChangeLog.omp | 10 +
gcc/fortran/openmp.cc | 447 +++++++-----------
gcc/testsuite/ChangeLog.omp | 6 +
gcc/testsuite/gfortran.dg/gomp/collapse1.f90 | 2 +-
gcc/testsuite/gfortran.dg/gomp/collapse2.f90 | 4 +-
.../gomp/loop-transforms/tile-2.f90 | 2 +-
6 files changed, 204 insertions(+), 267 deletions(-)
diff --git a/gcc/fortran/ChangeLog.omp b/gcc/fortran/ChangeLog.omp
index 3791eddc6c5..04ed7f88175 100644
--- a/gcc/fortran/ChangeLog.omp
+++ b/gcc/fortran/ChangeLog.omp
@@ -1,3 +1,13 @@
+2023-06-13 Sandra Loosemore <sandra@codesourcery.com>
+
+ * openmp.cc (find_nested_loop_in_chain): Move up in file.
+ (find_nested_loop_in_block): Likewise.
+ (resolve_nested_loops): New helper function to consolidate code
+ from...
+ (resolve_omp_do, resolve_omp_tile): ...these functions. Also,
+ remove the redundant call to resolve_nested_loop_transforms, and
+ use uniform error message wording.
+
2023-06-12 Tobias Burnus <tobias@codesourcery.com>
* trans-openmp.cc (gfc_omp_deep_map_kind_p): Fix conditions for
diff --git a/gcc/fortran/openmp.cc b/gcc/fortran/openmp.cc
index ca9a8e665d1..5ab64b5231f 100644
--- a/gcc/fortran/openmp.cc
+++ b/gcc/fortran/openmp.cc
@@ -10045,6 +10045,52 @@ static struct fortran_omp_context
static gfc_code *omp_current_do_code;
static int omp_current_do_collapse;
+/* Forward declaration for mutually recursive functions. */
+static gfc_code *
+find_nested_loop_in_block (gfc_code *block);
+
+/* Return the first nested DO loop in CHAIN, or NULL if there
+ isn't one. Does no error checking on intervening code. */
+
+static gfc_code *
+find_nested_loop_in_chain (gfc_code *chain)
+{
+ gfc_code *code;
+
+ if (!chain)
+ return NULL;
+
+ for (code = chain; code; code = code->next)
+ {
+ if (code->op == EXEC_DO)
+ return code;
+ else if (loop_transform_p (code->op) && code->block)
+ {
+ code = code->block;
+ continue;
+ }
+ else if (code->op == EXEC_BLOCK)
+ {
+ gfc_code *c = find_nested_loop_in_block (code);
+ if (c)
+ return c;
+ }
+ }
+ return NULL;
+}
+
+/* Return the first nested DO loop in BLOCK, or NULL if there
+ isn't one. Does no error checking on intervening code. */
+static gfc_code *
+find_nested_loop_in_block (gfc_code *block)
+{
+ gfc_namespace *ns;
+ gcc_assert (block->op == EXEC_BLOCK);
+ ns = block->ext.block.ns;
+ gcc_assert (ns);
+ return find_nested_loop_in_chain (ns->code);
+}
+
void
gfc_resolve_omp_do_blocks (gfc_code *code, gfc_namespace *ns)
{
@@ -10282,51 +10328,6 @@ gfc_resolve_omp_local_vars (gfc_namespace *ns)
}
-/* Forward declaration for mutually recursive functions. */
-static gfc_code *
-find_nested_loop_in_block (gfc_code *block);
-
-/* Return the first nested DO loop in CHAIN, or NULL if there
- isn't one. Does no error checking on intervening code. */
-
-static gfc_code *
-find_nested_loop_in_chain (gfc_code *chain)
-{
- gfc_code *code;
-
- if (!chain)
- return NULL;
-
- for (code = chain; code; code = code->next)
- {
- if (code->op == EXEC_DO)
- return code;
- else if (loop_transform_p (code->op) && code->block)
- {
- code = code->block;
- continue;
- }
- else if (code->op == EXEC_BLOCK)
- {
- gfc_code *c = find_nested_loop_in_block (code);
- if (c)
- return c;
- }
- }
- return NULL;
-}
-
-/* Return the first nested DO loop in BLOCK, or NULL if there
- isn't one. Does no error checking on intervening code. */
-static gfc_code *
-find_nested_loop_in_block (gfc_code *block)
-{
- gfc_namespace *ns;
- gcc_assert (block->op == EXEC_BLOCK);
- ns = block->ext.block.ns;
- gcc_assert (ns);
- return find_nested_loop_in_chain (ns->code);
-}
/* CODE is an OMP loop construct. Return true if VAR matches an iteration
variable outer to level DEPTH. */
static bool
@@ -10547,13 +10548,140 @@ resolve_omp_unroll (gfc_code *code)
descr, loc);
}
+/* Shared helper function for resolve_omp_do and resolve_omp_tile:
+ check that we have NUM_LOOPS nested loops at DO_CODE. CODE and NAME
+ are for the outer OMP construct, used for error checking. */
+
+static void
+resolve_nested_loops (gfc_code *code, const char *name, gfc_code *do_code,
+ int num_loops, bool is_simd, bool is_tile)
+{
+ for (int i = 1; i <= num_loops; i++)
+ {
+ gfc_symbol *dovar;
+ gfc_symbol *start_var = NULL, *end_var = NULL;
+ gfc_code *c;
+
+ if (do_code->op == EXEC_DO_WHILE)
+ {
+ gfc_error ("%s cannot be a DO WHILE or DO without loop control "
+ "at %L", name, &do_code->loc);
+ break;
+ }
+ if (do_code->op == EXEC_DO_CONCURRENT)
+ {
+ gfc_error ("%s cannot be a DO CONCURRENT loop at %L", name,
+ &do_code->loc);
+ break;
+ }
+ if (do_code->op != EXEC_DO)
+ {
+ gfc_error ("%s must be DO loop at %L", name,
+ &do_code->loc);
+ break;
+ }
+ dovar = do_code->ext.iterator->var->symtree->n.sym;
+ if (!is_tile)
+ {
+ int list;
+ gfc_omp_namelist *n;
+
+ if (do_code->ext.iterator->var->ts.type != BT_INTEGER)
+ gfc_error ("%s iteration variable must be of type integer at %L",
+ name, &do_code->loc);
+ if (dovar->attr.threadprivate)
+ gfc_error ("%s iteration variable must not be THREADPRIVATE "
+ "at %L", name, &do_code->loc);
+ if (code->ext.omp_clauses)
+ for (list = 0; list < OMP_LIST_NUM; list++)
+ if (!is_simd || code->ext.omp_clauses->collapse > 1
+ ? (list != OMP_LIST_PRIVATE && list != OMP_LIST_LASTPRIVATE
+ && list != OMP_LIST_ALLOCATE)
+ : (list != OMP_LIST_PRIVATE && list != OMP_LIST_LASTPRIVATE
+ && list != OMP_LIST_ALLOCATE && list != OMP_LIST_LINEAR))
+ for (n = code->ext.omp_clauses->lists[list]; n; n = n->next)
+ if (dovar == n->sym)
+ {
+ if (!is_simd || code->ext.omp_clauses->collapse > 1)
+ gfc_error ("%s iteration variable present on clause "
+ "other than PRIVATE, LASTPRIVATE or "
+ "ALLOCATE at %L", name, &do_code->loc);
+ else
+ gfc_error ("%s iteration variable present on clause "
+ "other than PRIVATE, LASTPRIVATE, "
+ "ALLOCATE or LINEAR at %L",
+ name, &do_code->loc);
+ break;
+ }
+ }
+ if (is_outer_iteration_variable (code, i, dovar))
+ {
+ gfc_error ("%s iteration variable used in more than one loop at %L "
+ "(depth %d)",
+ name, &do_code->loc, i);
+ break;
+ }
+ else if (!bound_expr_is_canonical (code, i,
+ do_code->ext.iterator->start,
+ &start_var))
+ {
+ gfc_error ("%s loop start expression not in canonical form at %L",
+ name, &do_code->loc);
+ break;
+ }
+ else if (!bound_expr_is_canonical (code, i,
+ do_code->ext.iterator->end,
+ &end_var))
+ {
+ gfc_error ("%s loop end expression not in canonical form at %L",
+ name, &do_code->loc);
+ break;
+ }
+ else if (start_var && end_var && start_var != end_var)
+ {
+ gfc_error ("%s loop bounds reference different "
+ "iteration variables at %L", name, &do_code->loc);
+ break;
+ }
+ else if (!expr_is_invariant (code, i, do_code->ext.iterator->step))
+ {
+ gfc_error ("%s loop increment not in canonical form at %L",
+ name, &do_code->loc);
+ break;
+ }
+ if (start_var || end_var)
+ code->ext.omp_clauses->non_rectangular = 1;
+
+ for (c = do_code->next; c; c = c->next)
+ if (c->op != EXEC_NOP && c->op != EXEC_CONTINUE)
+ {
+ gfc_error ("%s loops not perfectly nested at %L",
+ name, &c->loc);
+ break;
+ }
+ if (i == num_loops || c)
+ break;
+ do_code = do_code->block->next;
+
+ if (do_code)
+ do_code = resolve_nested_loop_transforms (do_code, name,
+ num_loops - i,
+ &code->loc);
+ if (!do_code
+ || (do_code->op != EXEC_DO && do_code->op != EXEC_DO_WHILE))
+ {
+ gfc_error ("not enough DO loops for %s at %L",
+ name, &code->loc);
+ break;
+ }
+ }
+}
+
static void
resolve_omp_do (gfc_code *code)
{
- gfc_code *do_code, *c;
- int list, i, collapse;
- gfc_omp_namelist *n;
- gfc_symbol *dovar;
+ gfc_code *do_code;
+ int collapse;
const char *name;
bool is_simd = false;
@@ -10667,238 +10795,31 @@ resolve_omp_do (gfc_code *code)
collapse = 1;
}
+ do_code = resolve_nested_loop_transforms (code->block->next, name, collapse,
+ &code->loc);
+
/* While the spec defines the loop nest depth independently of the COLLAPSE
clause, in practice the middle end only pays attention to the COLLAPSE
depth and treats any further inner loops as the final-loop-body. So
here we also check canonical loop nest form only for the number of
outer loops specified by the COLLAPSE clause too. */
- do_code = resolve_nested_loop_transforms (code->block->next, name, collapse,
- &code->loc);
-
- for (i = 1; i <= collapse; i++)
- {
- gfc_symbol *start_var = NULL, *end_var = NULL;
- if (do_code->op == EXEC_DO_WHILE)
- {
- gfc_error ("%s cannot be a DO WHILE or DO without loop control "
- "at %L", name, &do_code->loc);
- break;
- }
- if (do_code->op == EXEC_DO_CONCURRENT)
- {
- gfc_error ("%s cannot be a DO CONCURRENT loop at %L", name,
- &do_code->loc);
- break;
- }
- if (do_code->op != EXEC_DO)
- {
- gfc_error ("%s must be DO loop at %L", name,
- &do_code->loc);
- break;
- }
-
- gcc_assert (do_code->op != EXEC_OMP_UNROLL);
- gcc_assert (do_code->op == EXEC_DO);
- if (do_code->ext.iterator->var->ts.type != BT_INTEGER)
- gfc_error ("%s iteration variable must be of type integer at %L",
- name, &do_code->loc);
- dovar = do_code->ext.iterator->var->symtree->n.sym;
- if (dovar->attr.threadprivate)
- gfc_error ("%s iteration variable must not be THREADPRIVATE "
- "at %L", name, &do_code->loc);
- if (code->ext.omp_clauses)
- for (list = 0; list < OMP_LIST_NUM; list++)
- if (!is_simd || code->ext.omp_clauses->collapse > 1
- ? (list != OMP_LIST_PRIVATE && list != OMP_LIST_LASTPRIVATE
- && list != OMP_LIST_ALLOCATE)
- : (list != OMP_LIST_PRIVATE && list != OMP_LIST_LASTPRIVATE
- && list != OMP_LIST_ALLOCATE && list != OMP_LIST_LINEAR))
- for (n = code->ext.omp_clauses->lists[list]; n; n = n->next)
- if (dovar == n->sym)
- {
- if (!is_simd || code->ext.omp_clauses->collapse > 1)
- gfc_error ("%s iteration variable present on clause "
- "other than PRIVATE, LASTPRIVATE or "
- "ALLOCATE at %L", name, &do_code->loc);
- else
- gfc_error ("%s iteration variable present on clause "
- "other than PRIVATE, LASTPRIVATE, ALLOCATE or "
- "LINEAR at %L", name, &do_code->loc);
- break;
- }
- if (is_outer_iteration_variable (code, i, dovar))
- {
- gfc_error ("%s iteration variable used in more than one loop at %L",
- name, &do_code->loc);
- break;
- }
- else if (!bound_expr_is_canonical (code, i,
- do_code->ext.iterator->start,
- &start_var))
- {
- gfc_error ("%s loop start expression not in canonical form at %L",
- name, &do_code->loc);
- break;
- }
- else if (!bound_expr_is_canonical (code, i,
- do_code->ext.iterator->end,
- &end_var))
- {
- gfc_error ("%s loop end expression not in canonical form at %L",
- name, &do_code->loc);
- break;
- }
- else if (start_var && end_var && start_var != end_var)
- {
- gfc_error ("%s loop bounds reference different "
- "iteration variables at %L", name, &do_code->loc);
- break;
- }
- else if (!expr_is_invariant (code, i, do_code->ext.iterator->step))
- {
- gfc_error ("%s loop increment not in canonical form at %L",
- name, &do_code->loc);
- break;
- }
- if (start_var || end_var)
- code->ext.omp_clauses->non_rectangular = 1;
-
- for (c = do_code->next; c; c = c->next)
- if (c->op != EXEC_NOP && c->op != EXEC_CONTINUE)
- {
- gfc_error ("collapsed %s loops not perfectly nested at %L",
- name, &c->loc);
- break;
- }
- if (i == collapse || c)
- break;
- do_code = do_code->block;
- do_code = resolve_nested_loop_transforms (do_code, name, collapse - i,
- &code->loc);
- if (do_code->op != EXEC_DO && do_code->op != EXEC_DO_WHILE)
- {
- gfc_error ("not enough DO loops for collapsed %s at %L",
- name, &code->loc);
- break;
- }
- do_code = do_code->next;
- do_code = resolve_nested_loop_transforms (do_code, name, collapse - i,
- &code->loc);
- if (do_code == NULL
- || (do_code->op != EXEC_DO && do_code->op != EXEC_DO_WHILE))
- {
- gfc_error ("not enough DO loops for collapsed %s at %L",
- name, &code->loc);
- break;
- }
- }
+ resolve_nested_loops (code, name, do_code, collapse, is_simd, false);
}
static void
resolve_omp_tile (gfc_code *code)
{
- gfc_code *do_code, *next;
- gfc_symbol *dovar;
+ gfc_code *do_code;
const char *name = "!$OMP TILE";
- unsigned num_loops = 0;
+ int num_loops = 0;
gcc_assert (code->ext.omp_clauses->tile_sizes);
for (gfc_expr_list *el = code->ext.omp_clauses->tile_sizes; el;
el = el->next)
num_loops++;
do_code = resolve_nested_loop_transforms (code, name, num_loops, &code->loc);
-
- for (unsigned i = 1; i <= num_loops; i++)
- {
-
- gfc_symbol *start_var = NULL, *end_var = NULL;
-
- if (do_code->op == EXEC_DO_WHILE)
- {
- gfc_error ("%s cannot be a DO WHILE or DO without loop control "
- "at %L", name, &do_code->loc);
- return;
- }
- if (do_code->op == EXEC_DO_CONCURRENT)
- {
- gfc_error ("%s cannot be a DO CONCURRENT loop at %L", name,
- &do_code->loc);
- return;
- }
- if (do_code->op != EXEC_DO)
- {
- gfc_error ("%s must be DO loop at %L", name,
- &do_code->loc);
- return;
- }
-
- gcc_assert (do_code->op != EXEC_OMP_UNROLL);
- gcc_assert (do_code->op == EXEC_DO);
- dovar = do_code->ext.iterator->var->symtree->n.sym;
- if (is_outer_iteration_variable (code, i, dovar))
- {
- gfc_error ("%s iteration variable used in more than one loop at %L (depth %d)",
- name, &do_code->loc, i);
- return;
- }
- else if (!bound_expr_is_canonical (code, i,
- do_code->ext.iterator->start,
- &start_var))
- {
- gfc_error ("%s loop start expression not in canonical form at %L",
- name, &do_code->loc);
- return;
- }
- else if (!bound_expr_is_canonical (code, i,
- do_code->ext.iterator->end,
- &end_var))
- {
- gfc_error ("%s loop end expression not in canonical form at %L",
- name, &do_code->loc);
- return;
- }
- else if (start_var && end_var && start_var != end_var)
- {
- gfc_error ("%s loop bounds reference different "
- "iteration variables at %L", name, &do_code->loc);
- return;
- }
- else if (!expr_is_invariant (code, i, do_code->ext.iterator->step))
- {
- gfc_error ("%s loop increment not in canonical form at %L",
- name, &do_code->loc);
- return;
- }
- if (start_var || end_var)
- code->ext.omp_clauses->non_rectangular = 1;
- for (next = do_code->next; next; next = next->next)
- if (next->op != EXEC_NOP && next->op != EXEC_CONTINUE)
- {
- gfc_error ("%s loops not perfectly nested at %L",
- name, &next->loc);
- break;
- }
- if (i == num_loops || next)
- break;
- do_code = do_code->block;
- do_code = resolve_nested_loop_transforms (do_code, name, num_loops - i, &code->loc);
- if (do_code->op != EXEC_DO && do_code->op != EXEC_DO_WHILE)
- {
- gfc_error ("not enough DO loops for %s at %L",
- name, &code->loc);
- break;
- }
- do_code = do_code->next;
- do_code = resolve_nested_loop_transforms (do_code, name, num_loops - i, &code->loc);
- if (do_code == NULL
- || (do_code->op != EXEC_DO && do_code->op != EXEC_DO_WHILE))
- {
- gfc_error ("not enough DO loops for %s at %L",
- name, &code->loc);
- break;
- }
- }
+ resolve_nested_loops (code, name, do_code, num_loops, false, true);
}
static gfc_statement
diff --git a/gcc/testsuite/ChangeLog.omp b/gcc/testsuite/ChangeLog.omp
index 72d7b52256a..24a8bc43b10 100644
--- a/gcc/testsuite/ChangeLog.omp
+++ b/gcc/testsuite/ChangeLog.omp
@@ -1,3 +1,9 @@
+2023-06-13 Sandra Loosemore <sandra@codesourcery.com>
+
+ * gfortran.dg/gomp/collapse1.f90: Adjust expected error message.
+ * gfortran.dg/gomp/collapse2.f90: Likewise.
+ * gfortran.dg/gomp/loop-transforms/tile-2.f90: Likewise.
+
2023-06-13 Sandra Loosemore <sandra@codesourcery.com>
* c-c++-common/gomp/imperfect1.c: New.
diff --git a/gcc/testsuite/gfortran.dg/gomp/collapse1.f90 b/gcc/testsuite/gfortran.dg/gomp/collapse1.f90
index 77b2bdd7fcb..d938e1b569d 100644
--- a/gcc/testsuite/gfortran.dg/gomp/collapse1.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/collapse1.f90
@@ -9,7 +9,7 @@ subroutine collapse1
!$omp threadprivate (thr)
l = .false.
a(:, :, :) = 0
- !$omp parallel do collapse(4) schedule(static, 4) ! { dg-error "not enough DO loops for collapsed" }
+ !$omp parallel do collapse(4) schedule(static, 4) ! { dg-error "not enough DO loops for" }
do i = 1, 3
do j = 4, 6
do k = 5, 7
diff --git a/gcc/testsuite/gfortran.dg/gomp/collapse2.f90 b/gcc/testsuite/gfortran.dg/gomp/collapse2.f90
index 1ab934e3d0d..0aa7d9391e5 100644
--- a/gcc/testsuite/gfortran.dg/gomp/collapse2.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/collapse2.f90
@@ -17,13 +17,13 @@ program p
end do
x = 5 ! { dg-error "loops not perfectly nested" }
end do
- !$omp parallel do collapse(2) ! { dg-error "not enough DO loops for collapsed" }
+ !$omp parallel do collapse(2) ! { dg-error "not enough DO loops for" }
do i = 1, 8
x = 5
do j = 1, 8
end do
end do
- !$omp parallel do ordered(2) ! { dg-error "not enough DO loops for collapsed" }
+ !$omp parallel do ordered(2) ! { dg-error "not enough DO loops for" }
do i = 1, 8
x = 5
do j = 1, 8
diff --git a/gcc/testsuite/gfortran.dg/gomp/loop-transforms/tile-2.f90 b/gcc/testsuite/gfortran.dg/gomp/loop-transforms/tile-2.f90
index 8a5eae3a188..f4c24f76eac 100644
--- a/gcc/testsuite/gfortran.dg/gomp/loop-transforms/tile-2.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/loop-transforms/tile-2.f90
@@ -64,7 +64,7 @@ subroutine test3
implicit none
integer :: i, j, k
- !$omp taskloop collapse(3) ! { dg-error {not enough DO loops for collapsed \!\$OMP TASKLOOP at \(1\)} }
+ !$omp taskloop collapse(3) ! { dg-error {not enough DO loops for \!\$OMP TASKLOOP at \(1\)} }
!$omp tile sizes (1,2) ! { dg-error {loop nest depth after \!\$OMP TILE at \(1\) is insufficient for outer \!\$OMP TASKLOOP} }
!$omp tile sizes (1,2)
do i = 1,100
--
2.31.1
^ permalink raw reply [flat|nested] 7+ messages in thread* [OG13 6/6] OpenMP: Fortran support for imperfectly nested loops
2023-06-14 22:07 [OG13 0/6] OpenMP: Support for imperfectly-nested loops Sandra Loosemore
` (4 preceding siblings ...)
2023-06-14 22:08 ` [OG13 5/6] OpenMP: Refactor and tidy Fortran front-end code for loop transformations Sandra Loosemore
@ 2023-06-14 22:08 ` Sandra Loosemore
5 siblings, 0 replies; 7+ messages in thread
From: Sandra Loosemore @ 2023-06-14 22:08 UTC (permalink / raw)
To: gcc-patches
OpenMP 5.0 removed the restriction that multiple collapsed loops must
be perfectly nested, allowing "intervening code" (including nested
BLOCKs) before or after each nested loop. In GCC this code is moved
into the inner loop body by the respective front ends.
In the Fortran front end, most of the semantic processing happens during
the translation phase, so the parse phase just collects the intervening
statements, checks them for errors, and splices them around the loop body.
gcc/fortran/ChangeLog
* openmp.cc: Include omp-api.h.
(resolve_omp_clauses): Consolidate inscan reduction clause conflict
checking here.
(scan_for_next_loop_in_chain): New.
(scan_for_next_loop_in_block): New.
(gfc_resolve_omp_do_blocks): Set omp_current_do_collapse properly.
Handle imperfectly-nested loops when looking for nested omp scan.
Refactor to move inscan reduction clause conflict checking to
resolve_omp_clauses.
(gfc_resolve_do_iterator): Handle imperfectly-nested loops.
(struct icode_error_state): New.
(icode_code_error_callback): New.
(icode_expr_error_callback): New.
(diagnose_intervening_code_errors_1): New.
(diagnose_intervening_code_errors): New.
(restructure_intervening_code): New.
(resolve_nested_loops): Update error handling, and extend to
detect imperfect nesting errors and check validity of
intervening code. Call restructure_intervening_code if needed.
(resolve_omp_do): Rename collapse -> count.
gcc/testsuite/ChangeLog
* gfortran.dg/gomp/collapse1.f90: Adjust expected errors.
* gfortran.dg/gomp/collapse2.f90: Likewise.
* gfortran.dg/gomp/imperfect1.f90: New.
* gfortran.dg/gomp/imperfect2.f90: New.
* gfortran.dg/gomp/imperfect3.f90: New.
* gfortran.dg/gomp/imperfect4.f90: New.
* gfortran.dg/gomp/imperfect5.f90: New.
* gfortran.dg/gomp/loop-transforms/tile-1.f90: Adjust expected errors.
* gfortran.dg/gomp/loop-transforms/tile-2.f90: Likewise.
* gfortran.dg/gomp/loop-transforms/tile-imperfect-nest.f90: Likewise.
libgomp/ChangeLog
* testsuite/libgomp.fortran/imperfect-destructor.f90: New.
* testsuite/libgomp.fortran/imperfect-transform-1.f90: New.
* testsuite/libgomp.fortran/imperfect-transform-2.f90: New.
* testsuite/libgomp.fortran/imperfect1.f90: New.
* testsuite/libgomp.fortran/imperfect2.f90: New.
* testsuite/libgomp.fortran/imperfect3.f90: New.
* testsuite/libgomp.fortran/imperfect4.f90: New.
* testsuite/libgomp.fortran/target-imperfect-transform-1.f90: New.
* testsuite/libgomp.fortran/target-imperfect-transform-2.f90: New.
* testsuite/libgomp.fortran/target-imperfect1.f90: New.
* testsuite/libgomp.fortran/target-imperfect2.f90: New.
* testsuite/libgomp.fortran/target-imperfect3.f90: New.
* testsuite/libgomp.fortran/target-imperfect4.f90: New.
---
gcc/fortran/ChangeLog.omp | 23 +
gcc/fortran/openmp.cc | 668 +++++++++++++++---
gcc/testsuite/ChangeLog.omp | 13 +
gcc/testsuite/gfortran.dg/gomp/collapse1.f90 | 2 +-
gcc/testsuite/gfortran.dg/gomp/collapse2.f90 | 10 +-
gcc/testsuite/gfortran.dg/gomp/imperfect1.f90 | 39 +
gcc/testsuite/gfortran.dg/gomp/imperfect2.f90 | 56 ++
gcc/testsuite/gfortran.dg/gomp/imperfect3.f90 | 29 +
gcc/testsuite/gfortran.dg/gomp/imperfect4.f90 | 36 +
gcc/testsuite/gfortran.dg/gomp/imperfect5.f90 | 67 ++
.../gomp/loop-transforms/tile-1.f90 | 12 +-
.../gomp/loop-transforms/tile-2.f90 | 2 +-
.../loop-transforms/tile-imperfect-nest.f90 | 16 +-
libgomp/ChangeLog.omp | 16 +
.../libgomp.fortran/imperfect-destructor.f90 | 142 ++++
.../libgomp.fortran/imperfect-transform-1.f90 | 70 ++
.../libgomp.fortran/imperfect-transform-2.f90 | 70 ++
.../testsuite/libgomp.fortran/imperfect1.f90 | 67 ++
.../testsuite/libgomp.fortran/imperfect2.f90 | 102 +++
.../testsuite/libgomp.fortran/imperfect3.f90 | 110 +++
.../testsuite/libgomp.fortran/imperfect4.f90 | 121 ++++
.../target-imperfect-transform-1.f90 | 73 ++
.../target-imperfect-transform-2.f90 | 73 ++
.../libgomp.fortran/target-imperfect1.f90 | 72 ++
.../libgomp.fortran/target-imperfect2.f90 | 110 +++
.../libgomp.fortran/target-imperfect3.f90 | 116 +++
.../libgomp.fortran/target-imperfect4.f90 | 126 ++++
27 files changed, 2125 insertions(+), 116 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/gomp/imperfect1.f90
create mode 100644 gcc/testsuite/gfortran.dg/gomp/imperfect2.f90
create mode 100644 gcc/testsuite/gfortran.dg/gomp/imperfect3.f90
create mode 100644 gcc/testsuite/gfortran.dg/gomp/imperfect4.f90
create mode 100644 gcc/testsuite/gfortran.dg/gomp/imperfect5.f90
create mode 100644 libgomp/testsuite/libgomp.fortran/imperfect-destructor.f90
create mode 100644 libgomp/testsuite/libgomp.fortran/imperfect-transform-1.f90
create mode 100644 libgomp/testsuite/libgomp.fortran/imperfect-transform-2.f90
create mode 100644 libgomp/testsuite/libgomp.fortran/imperfect1.f90
create mode 100644 libgomp/testsuite/libgomp.fortran/imperfect2.f90
create mode 100644 libgomp/testsuite/libgomp.fortran/imperfect3.f90
create mode 100644 libgomp/testsuite/libgomp.fortran/imperfect4.f90
create mode 100644 libgomp/testsuite/libgomp.fortran/target-imperfect-transform-1.f90
create mode 100644 libgomp/testsuite/libgomp.fortran/target-imperfect-transform-2.f90
create mode 100644 libgomp/testsuite/libgomp.fortran/target-imperfect1.f90
create mode 100644 libgomp/testsuite/libgomp.fortran/target-imperfect2.f90
create mode 100644 libgomp/testsuite/libgomp.fortran/target-imperfect3.f90
create mode 100644 libgomp/testsuite/libgomp.fortran/target-imperfect4.f90
diff --git a/gcc/fortran/ChangeLog.omp b/gcc/fortran/ChangeLog.omp
index 04ed7f88175..26375aca413 100644
--- a/gcc/fortran/ChangeLog.omp
+++ b/gcc/fortran/ChangeLog.omp
@@ -1,3 +1,26 @@
+2023-06-13 Sandra Loosemore <sandra@codesourcery.com>
+
+ * openmp.cc: Include omp-api.h.
+ (resolve_omp_clauses): Consolidate inscan reduction clause conflict
+ checking here.
+ (scan_for_next_loop_in_chain): New.
+ (scan_for_next_loop_in_block): New.
+ (gfc_resolve_omp_do_blocks): Set omp_current_do_collapse properly.
+ Handle imperfectly-nested loops when looking for nested omp scan.
+ Refactor to move inscan reduction clause conflict checking to
+ resolve_omp_clauses.
+ (gfc_resolve_do_iterator): Handle imperfectly-nested loops.
+ (struct icode_error_state): New.
+ (icode_code_error_callback): New.
+ (icode_expr_error_callback): New.
+ (diagnose_intervening_code_errors_1): New.
+ (diagnose_intervening_code_errors): New.
+ (restructure_intervening_code): New.
+ (resolve_nested_loops): Update error handling, and extend to
+ detect imperfect nesting errors and check validity of
+ intervening code. Call restructure_intervening_code if needed.
+ (resolve_omp_do): Rename collapse -> count.
+
2023-06-13 Sandra Loosemore <sandra@codesourcery.com>
* openmp.cc (find_nested_loop_in_chain): Move up in file.
diff --git a/gcc/fortran/openmp.cc b/gcc/fortran/openmp.cc
index 5ab64b5231f..bdca36e4743 100644
--- a/gcc/fortran/openmp.cc
+++ b/gcc/fortran/openmp.cc
@@ -31,6 +31,7 @@ along with GCC; see the file COPYING3. If not see
#include "target-memory.h" /* For gfc_encode_character. */
#include "bitmap.h"
#include "options.h"
+#include "omp-api.h" /* For omp_runtime_api_procname. */
static gfc_statement omp_code_to_statement (gfc_code *);
@@ -8183,15 +8184,24 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
gfc_error ("Object %qs is not a variable at %L", n->sym->name,
&n->where);
}
- if (omp_clauses->lists[OMP_LIST_REDUCTION_INSCAN]
- && code->op != EXEC_OMP_DO
- && code->op != EXEC_OMP_SIMD
- && code->op != EXEC_OMP_DO_SIMD
- && code->op != EXEC_OMP_PARALLEL_DO
- && code->op != EXEC_OMP_PARALLEL_DO_SIMD)
- gfc_error ("%<inscan%> REDUCTION clause on construct other than DO, SIMD, "
- "DO SIMD, PARALLEL DO, PARALLEL DO SIMD at %L",
- &omp_clauses->lists[OMP_LIST_REDUCTION_INSCAN]->where);
+ if (omp_clauses->lists[OMP_LIST_REDUCTION_INSCAN])
+ {
+ locus *loc = &omp_clauses->lists[OMP_LIST_REDUCTION_INSCAN]->where;
+ if (code->op != EXEC_OMP_DO
+ && code->op != EXEC_OMP_SIMD
+ && code->op != EXEC_OMP_DO_SIMD
+ && code->op != EXEC_OMP_PARALLEL_DO
+ && code->op != EXEC_OMP_PARALLEL_DO_SIMD)
+ gfc_error ("%<inscan%> REDUCTION clause on construct other than DO, "
+ "SIMD, DO SIMD, PARALLEL DO, PARALLEL DO SIMD at %L",
+ loc);
+ if (omp_clauses->ordered)
+ gfc_error ("ORDERED clause specified together with %<inscan%> "
+ "REDUCTION clause at %L", loc);
+ if (omp_clauses->sched_kind != OMP_SCHED_NONE)
+ gfc_error ("SCHEDULE clause specified together with %<inscan%> "
+ "REDUCTION clause at %L", loc);
+ }
for (list = 0; list < OMP_LIST_NUM; list++)
if (list != OMP_LIST_FIRSTPRIVATE
@@ -10091,68 +10101,130 @@ find_nested_loop_in_block (gfc_code *block)
return find_nested_loop_in_chain (ns->code);
}
+/* Forward declaration for mutually recursive functions. */
+static gfc_code *
+scan_for_next_loop_in_block (gfc_code *block, gfc_code **imperfectp);
+
+/* Like find_nested_loop_in_chain, but also stop when a loop transform is
+ found and check for intervening code too. Return the first nested
+ DO loop or loop transform in CHAIN, and set *IMPERFECTP to the first
+ intervening code statement if one is found. */
+static gfc_code *
+scan_for_next_loop_in_chain (gfc_code *chain, gfc_code **imperfectp)
+{
+ gfc_code *code;
+ gfc_code *result = NULL;
+
+ if (!chain)
+ return NULL;
+
+ for (code = chain; code; code = code->next)
+ {
+ /* DO WHILE and DO CONCURRENT are errors, but we need to catch them
+ here to ensure the right error is diagnosed elsewhere. */
+ if (!result
+ && (code->op == EXEC_DO
+ || code->op == EXEC_DO_WHILE
+ || code->op == EXEC_DO_CONCURRENT
+ || loop_transform_p (code->op)))
+ result = code;
+ else if (!result && code->op == EXEC_BLOCK)
+ {
+ result = scan_for_next_loop_in_block (code, imperfectp);
+ /* If no loop in the block, the block itself is intervening code. */
+ if (!result && !*imperfectp)
+ *imperfectp = code;
+ }
+ else if (code->op == EXEC_NOP || code->op == EXEC_CONTINUE)
+ continue;
+ else if (!*imperfectp)
+ *imperfectp = code;
+ if (result && *imperfectp)
+ break;
+ }
+ return result;
+}
+
+/* Like find_nested_loop_in_block, but also checks for intervening code.
+ Return the first nested DO loop in BLOCK, or NULL if there
+ isn't one. Sets *IMPERFECTP to the first piece of intervening code. */
+static gfc_code *
+scan_for_next_loop_in_block (gfc_code *block, gfc_code **imperfectp)
+{
+ gfc_namespace *ns;
+ gcc_assert (block->op == EXEC_BLOCK);
+ ns = block->ext.block.ns;
+ gcc_assert (ns);
+ return scan_for_next_loop_in_chain (ns->code, imperfectp);
+}
+
void
gfc_resolve_omp_do_blocks (gfc_code *code, gfc_namespace *ns)
{
if (code->block->next && code->block->next->op == EXEC_DO)
{
int i;
- gfc_code *c;
omp_current_do_code = code->block->next;
if (code->ext.omp_clauses->orderedc)
omp_current_do_collapse = code->ext.omp_clauses->orderedc;
- else
+ else if (code->ext.omp_clauses->collapse)
omp_current_do_collapse = code->ext.omp_clauses->collapse;
- for (i = 1, c = omp_current_do_code; i < omp_current_do_collapse; i++)
- {
- c = c->block;
- if (c->op != EXEC_DO || c->next == NULL)
- break;
- c = c->next;
- if (c->op != EXEC_DO)
- break;
- }
- if (i < omp_current_do_collapse || omp_current_do_collapse <= 0)
+ else
omp_current_do_collapse = 1;
if (code->ext.omp_clauses->lists[OMP_LIST_REDUCTION_INSCAN])
{
+ /* Checking that there is a matching EXEC_OMP_SCAN in the
+ innermost body cannot be deferred to resolve_omp_do because
+ we process directives nested in the loop before we get
+ there. */
locus *loc
= &code->ext.omp_clauses->lists[OMP_LIST_REDUCTION_INSCAN]->where;
- if (code->ext.omp_clauses->ordered)
- gfc_error ("ORDERED clause specified together with %<inscan%> "
- "REDUCTION clause at %L", loc);
- if (code->ext.omp_clauses->sched_kind != OMP_SCHED_NONE)
- gfc_error ("SCHEDULE clause specified together with %<inscan%> "
- "REDUCTION clause at %L", loc);
- gfc_code *block = c->block ? c->block->next : NULL;
- if (block && block->op != EXEC_OMP_SCAN)
- while (block && block->next && block->next->op != EXEC_OMP_SCAN)
- block = block->next;
- if (!block
- || (block->op != EXEC_OMP_SCAN
- && (!block->next || block->next->op != EXEC_OMP_SCAN)))
- gfc_error ("With INSCAN at %L, expected loop body with !$OMP SCAN "
- "between two structured block sequences", loc);
- else
+ gfc_code *c;
+
+ for (i = 1, c = omp_current_do_code;
+ i < omp_current_do_collapse; i++)
{
- if (block->op == EXEC_OMP_SCAN)
- gfc_warning (0, "!$OMP SCAN at %L with zero executable "
- "statements in preceding structured block "
- "sequence", &block->loc);
- if ((block->op == EXEC_OMP_SCAN && !block->next)
- || (block->next && block->next->op == EXEC_OMP_SCAN
- && !block->next->next))
- gfc_warning (0, "!$OMP SCAN at %L with zero executable "
- "statements in succeeding structured block "
- "sequence", block->op == EXEC_OMP_SCAN
- ? &block->loc : &block->next->loc);
- }
- if (block && block->op != EXEC_OMP_SCAN)
- block = block->next;
- if (block && block->op == EXEC_OMP_SCAN)
- /* Mark 'omp scan' as checked; flag will be unset later. */
- block->ext.omp_clauses->if_present = true;
+ c = find_nested_loop_in_chain (c->block->next);
+ if (!c || c->op != EXEC_DO || c->block == NULL)
+ break;
+ }
+
+ /* Skip this if we don't have enough nested loops. That
+ problem will be diagnosed elsewhere. */
+ if (c && c->op == EXEC_DO)
+ {
+ gfc_code *block = c->block ? c->block->next : NULL;
+ if (block && block->op != EXEC_OMP_SCAN)
+ while (block && block->next
+ && block->next->op != EXEC_OMP_SCAN)
+ block = block->next;
+ if (!block
+ || (block->op != EXEC_OMP_SCAN
+ && (!block->next || block->next->op != EXEC_OMP_SCAN)))
+ gfc_error ("With INSCAN at %L, expected loop body with "
+ "!$OMP SCAN between two "
+ "structured block sequences", loc);
+ else
+ {
+ if (block->op == EXEC_OMP_SCAN)
+ gfc_warning (0, "!$OMP SCAN at %L with zero executable "
+ "statements in preceding structured block "
+ "sequence", &block->loc);
+ if ((block->op == EXEC_OMP_SCAN && !block->next)
+ || (block->next && block->next->op == EXEC_OMP_SCAN
+ && !block->next->next))
+ gfc_warning (0, "!$OMP SCAN at %L with zero executable "
+ "statements in succeeding structured block "
+ "sequence", block->op == EXEC_OMP_SCAN
+ ? &block->loc : &block->next->loc);
+ }
+ if (block && block->op != EXEC_OMP_SCAN)
+ block = block->next;
+ if (block && block->op == EXEC_OMP_SCAN)
+ /* Mark 'omp scan' as checked; flag will be unset later. */
+ block->ext.omp_clauses->if_present = true;
+ }
}
}
gfc_resolve_blocks (code->block, ns);
@@ -10282,13 +10354,12 @@ gfc_resolve_do_iterator (gfc_code *code, gfc_symbol *sym, bool add_clause)
private just in the !$omp do resp. !$omp parallel do construct,
with no implications for the outer parallel constructs. */
- while (i-- >= 1)
+ while (i-- >= 1 && c)
{
if (code == c)
return;
-
- c = c->block->next;
- }
+ c = find_nested_loop_in_chain (c->block->next);
+ }
/* An openacc context may represent a data clause. Abort if so. */
if (!omp_current_ctx->is_openmp && !oacc_is_loop (omp_current_ctx->code))
@@ -10327,6 +10398,328 @@ gfc_resolve_omp_local_vars (gfc_namespace *ns)
gfc_traverse_ns (ns, handle_local_var);
}
+/* Error checking on intervening code uses a code walker. */
+
+struct icode_error_state
+{
+ const char *name;
+ bool errorp;
+ gfc_code *nested;
+ gfc_code *next;
+};
+
+static int
+icode_code_error_callback (gfc_code **codep,
+ int *walk_subtrees ATTRIBUTE_UNUSED, void *opaque)
+{
+ gfc_code *code = *codep;
+ icode_error_state *state = (icode_error_state *)opaque;
+
+ /* gfc_code_walker walks down CODE's next chain as well as
+ walking things that are actually nested in CODE. We need to
+ special-case traversal of outer blocks, so stop immediately if we
+ are heading down such a next chain. */
+ if (code == state->next)
+ return 1;
+
+ switch (code->op)
+ {
+ case EXEC_DO:
+ case EXEC_DO_WHILE:
+ case EXEC_DO_CONCURRENT:
+ gfc_error ("%s cannot contain loop in intervening code at %L",
+ state->name, &code->loc);
+ state->errorp = true;
+ break;
+ case EXEC_CYCLE:
+ case EXEC_EXIT:
+ /* 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:
+ gfc_error ("%s cannot contain OpenMP directive in intervening code "
+ "at %L",
+ state->name, &code->loc);
+ state->errorp = true;
+ break;
+ case EXEC_CALL:
+ /* Per OpenMP 5.2, the "omp_" prefix is reserved, so we don't have to
+ consider the possibility that some locally-bound definition
+ overrides the runtime routine. */
+ if (code->resolved_sym
+ && omp_runtime_api_procname (code->resolved_sym->name))
+ {
+ gfc_error ("%s cannot contain OpenMP API call in intervening code "
+ "at %L",
+ state->name, &code->loc);
+ state->errorp = true;
+ }
+ break;
+ default:
+ break;
+ }
+ return 0;
+}
+
+static int
+icode_expr_error_callback (gfc_expr **expr,
+ int *walk_subtrees ATTRIBUTE_UNUSED, void *opaque)
+{
+ icode_error_state *state = (icode_error_state *)opaque;
+
+ switch ((*expr)->expr_type)
+ {
+ /* As for EXPR_CALL with "omp_"-prefixed symbols. */
+ case EXPR_FUNCTION:
+ {
+ gfc_symbol *sym = (*expr)->value.function.esym;
+ if (sym && omp_runtime_api_procname (sym->name))
+ {
+ gfc_error ("%s cannot contain OpenMP API call in intervening code "
+ "at %L",
+ state->name, &((*expr)->where));
+ state->errorp = true;
+ }
+ }
+
+ break;
+ default:
+ break;
+ }
+
+ /* FIXME: The description of canonical loop form in the OpenMP standard
+ also says "array expressions" are not permitted in intervening code.
+ That term is not defined in either the OpenMP spec or the Fortran
+ standard, although the latter uses it informally to refer to any
+ expression that is not scalar-valued. It is also apparently not the
+ thing GCC internally calls EXPR_ARRAY. It seems the intent of the
+ OpenMP restriction is to disallow elemental operations/intrinsics
+ (including things that are not expressions, like assignment
+ statements) that generate implicit loops over array operands
+ (even if the result is a scalar), but even if the spec said
+ that there is no list of all the cases that would be forbidden.
+ This is OpenMP issue 3326. */
+
+ return 0;
+}
+
+static void
+diagnose_intervening_code_errors_1 (gfc_code *chain,
+ struct icode_error_state *state)
+{
+ gfc_code *code;
+ for (code = chain; code; code = code->next)
+ {
+ if (code == state->nested)
+ /* Do not walk the nested loop or its body, we are only
+ interested in intervening code. */
+ ;
+ else if (code->op == EXEC_BLOCK
+ && find_nested_loop_in_block (code) == state->nested)
+ /* This block contains the nested loop, recurse on its
+ statements. */
+ {
+ gfc_namespace* ns = code->ext.block.ns;
+ diagnose_intervening_code_errors_1 (ns->code, state);
+ }
+ else
+ /* Treat the whole statement as a unit. */
+ {
+ gfc_code *temp = state->next;
+ state->next = code->next;
+ gfc_code_walker (&code, icode_code_error_callback,
+ icode_expr_error_callback, state);
+ state->next = temp;
+ }
+ }
+}
+
+/* Diagnose intervening code errors in BLOCK with nested loop NESTED.
+ NAME is the user-friendly name of the OMP directive, used for error
+ messages. Returns true if any error was found. */
+static bool
+diagnose_intervening_code_errors (gfc_code *chain, const char *name,
+ gfc_code *nested)
+{
+ struct icode_error_state state;
+ state.name = name;
+ state.errorp = false;
+ state.nested = nested;
+ state.next = NULL;
+ diagnose_intervening_code_errors_1 (chain, &state);
+ return state.errorp;
+}
+
+/* Push intervening code surrounding a loop, including nested scopes,
+ into the body of the loop. CHAINP is the pointer to the head of
+ the next-chain to scan, OUTER_LOOP is the EXEC_DO for the next outer
+ loop level, and COLLAPSE is the number of nested loops we need to
+ process.
+ Note that CHAINP may point at outer_loop->block->next when we
+ are scanning the body of a loop, but if there is an intervening block
+ CHAINP points into the block's chain rather than its enclosing outer
+ loop. This is why OUTER_LOOP is passed separately. */
+static gfc_code *
+restructure_intervening_code (gfc_code **chainp, gfc_code *outer_loop,
+ int count)
+{
+ gfc_code *code;
+ gfc_code *head = *chainp;
+ gfc_code *tail = NULL;
+ gfc_code *innermost_loop = NULL;
+
+ for (code = *chainp; code; code = code->next, chainp = &((*chainp)->next))
+ {
+ if (code->op == EXEC_DO || loop_transform_p (code->op))
+ {
+ gfc_code *c = code;
+
+ /* Treat a series of loop transforms as a unit, same as a single
+ EXEC_DO. CODE is the first and C is the last in the chain. */
+ while (loop_transform_p (c->op) && !c->block)
+ c = c->next;
+
+ gcc_assert (c);
+ gcc_assert (c->op == EXEC_DO
+ || (loop_transform_p (c->op) && c->block));
+
+ /* Cut the transforms and the loop they apply to free from the
+ chain, leaving the ends dangling. */
+ *chainp = NULL;
+ tail = c->next;
+ c->next = NULL;
+
+ if (count == 1 && c->op == EXEC_DO)
+ innermost_loop = c;
+ else
+ innermost_loop
+ = restructure_intervening_code (&(c->block->next), c,
+ (loop_transform_p (c->op)
+ ? count : count - 1));
+ break;
+ }
+ else if (code->op == EXEC_BLOCK
+ && find_nested_loop_in_block (code))
+ {
+ gfc_namespace *ns = code->ext.block.ns;
+
+ /* Cut CODE free from its chain, leaving the ends dangling. */
+ *chainp = NULL;
+ tail = code->next;
+ code->next = NULL;
+
+ innermost_loop
+ = restructure_intervening_code (&(ns->code), outer_loop,
+ count);
+
+ /* At this point we have already pulled out the nested loop and
+ pointed outer_loop at it, and moved the intervening code that
+ was previously in the block into the body of innermost_loop.
+ Now we want to move the BLOCK itself so it wraps the entire
+ current body of innermost_loop. */
+ ns->code = innermost_loop->block->next;
+ innermost_loop->block->next = code;
+ break;
+ }
+ }
+
+ gcc_assert (innermost_loop);
+
+ /* Now we have split the intervening code into two parts:
+ head is the start of the part before the loop/block, terminating
+ at *chainp, and tail is the part after it. Splice the two parts
+ around the existing body of the innermost loop. */
+ if (head != code)
+ {
+ if (innermost_loop->block->next)
+ gfc_append_code (head, innermost_loop->block->next);
+ innermost_loop->block->next = head;
+ }
+ if (tail)
+ {
+ if (innermost_loop->block->next)
+ gfc_append_code (innermost_loop->block->next, tail);
+ else
+ innermost_loop->block->next = tail;
+ }
+
+ /* For loops, finally splice CODE into OUTER_LOOP. We already handled
+ relinking EXEC_BLOCK above. */
+ if ((code->op == EXEC_DO || loop_transform_p (code->op)) && outer_loop)
+ outer_loop->block->next = code;
+
+ return innermost_loop;
+}
/* CODE is an OMP loop construct. Return true if VAR matches an iteration
variable outer to level DEPTH. */
@@ -10556,29 +10949,36 @@ static void
resolve_nested_loops (gfc_code *code, const char *name, gfc_code *do_code,
int num_loops, bool is_simd, bool is_tile)
{
+ bool errorp = false;
+ bool perfect_nesting_errorp = false;
+ bool is_nested_tile = false;
+ bool any_imperfect = false;
+
for (int i = 1; i <= num_loops; i++)
{
gfc_symbol *dovar;
gfc_symbol *start_var = NULL, *end_var = NULL;
- gfc_code *c;
+ gfc_code *imperfect = NULL;
+ gfc_code *next;
+ /* Parse errors are not recoverable. */
if (do_code->op == EXEC_DO_WHILE)
{
gfc_error ("%s cannot be a DO WHILE or DO without loop control "
"at %L", name, &do_code->loc);
- break;
+ return;
}
if (do_code->op == EXEC_DO_CONCURRENT)
{
gfc_error ("%s cannot be a DO CONCURRENT loop at %L", name,
&do_code->loc);
- break;
+ return;
}
if (do_code->op != EXEC_DO)
{
gfc_error ("%s must be DO loop at %L", name,
&do_code->loc);
- break;
+ return;
}
dovar = do_code->ext.iterator->var->symtree->n.sym;
if (!is_tile)
@@ -10587,11 +10987,17 @@ resolve_nested_loops (gfc_code *code, const char *name, gfc_code *do_code,
gfc_omp_namelist *n;
if (do_code->ext.iterator->var->ts.type != BT_INTEGER)
- gfc_error ("%s iteration variable must be of type integer at %L",
- name, &do_code->loc);
+ {
+ gfc_error ("%s iteration variable must be of type integer at %L",
+ name, &do_code->loc);
+ errorp = true;
+ }
if (dovar->attr.threadprivate)
- gfc_error ("%s iteration variable must not be THREADPRIVATE "
- "at %L", name, &do_code->loc);
+ {
+ gfc_error ("%s iteration variable must not be THREADPRIVATE "
+ "at %L", name, &do_code->loc);
+ errorp = true;
+ }
if (code->ext.omp_clauses)
for (list = 0; list < OMP_LIST_NUM; list++)
if (!is_simd || code->ext.omp_clauses->collapse > 1
@@ -10611,7 +11017,7 @@ resolve_nested_loops (gfc_code *code, const char *name, gfc_code *do_code,
"other than PRIVATE, LASTPRIVATE, "
"ALLOCATE or LINEAR at %L",
name, &do_code->loc);
- break;
+ errorp = true;
}
}
if (is_outer_iteration_variable (code, i, dovar))
@@ -10619,7 +11025,7 @@ resolve_nested_loops (gfc_code *code, const char *name, gfc_code *do_code,
gfc_error ("%s iteration variable used in more than one loop at %L "
"(depth %d)",
name, &do_code->loc, i);
- break;
+ errorp = true;
}
else if (!bound_expr_is_canonical (code, i,
do_code->ext.iterator->start,
@@ -10627,7 +11033,7 @@ resolve_nested_loops (gfc_code *code, const char *name, gfc_code *do_code,
{
gfc_error ("%s loop start expression not in canonical form at %L",
name, &do_code->loc);
- break;
+ errorp = true;
}
else if (!bound_expr_is_canonical (code, i,
do_code->ext.iterator->end,
@@ -10635,53 +11041,125 @@ resolve_nested_loops (gfc_code *code, const char *name, gfc_code *do_code,
{
gfc_error ("%s loop end expression not in canonical form at %L",
name, &do_code->loc);
- break;
+ errorp = true;
}
else if (start_var && end_var && start_var != end_var)
{
gfc_error ("%s loop bounds reference different "
"iteration variables at %L", name, &do_code->loc);
- break;
+ errorp = true;
}
else if (!expr_is_invariant (code, i, do_code->ext.iterator->step))
{
gfc_error ("%s loop increment not in canonical form at %L",
name, &do_code->loc);
- break;
+ errorp = true;
}
if (start_var || end_var)
code->ext.omp_clauses->non_rectangular = 1;
- for (c = do_code->next; c; c = c->next)
- if (c->op != EXEC_NOP && c->op != EXEC_CONTINUE)
- {
- gfc_error ("%s loops not perfectly nested at %L",
- name, &c->loc);
- break;
- }
- if (i == num_loops || c)
+ if (i == num_loops)
break;
- do_code = do_code->block->next;
- if (do_code)
- do_code = resolve_nested_loop_transforms (do_code, name,
- num_loops - i,
- &code->loc);
- if (!do_code
- || (do_code->op != EXEC_DO && do_code->op != EXEC_DO_WHILE))
+ next = scan_for_next_loop_in_chain (do_code->block->next, &imperfect);
+ if (!next)
{
+ /* Parse error, can't recover from this. */
gfc_error ("not enough DO loops for %s at %L",
name, &code->loc);
- break;
+ return;
+ }
+
+ /* Only diagnose violation of imperfect nesting constraints once. */
+ if (!perfect_nesting_errorp && imperfect)
+ {
+ if (code->ext.omp_clauses->orderedc)
+ {
+ gfc_error ("%s inner loops must be perfectly nested with "
+ "ORDERED clause at %L",
+ name, &code->loc);
+ perfect_nesting_errorp = true;
+ }
+ else if (code->ext.omp_clauses->lists[OMP_LIST_REDUCTION_INSCAN])
+ {
+ gfc_error ("%s inner loops must be perfectly nested with "
+ "REDUCTION INSCAN clause at %L",
+ name, &code->loc);
+ perfect_nesting_errorp = true;
+ }
+ else if (is_tile)
+ {
+ gfc_error ("%s inner loops must be perfectly nested at %L",
+ name, &code->loc);
+ perfect_nesting_errorp = true;
+ }
+ else if (is_nested_tile)
+ {
+ gfc_error ("%s inner loops must be perfectly nested with "
+ "nested !$OMP TILE at %L",
+ name, &code->loc);
+ perfect_nesting_errorp = true;
+ }
+ if (perfect_nesting_errorp)
+ errorp = true;
+ }
+
+ /* Check constraints on intervening code, if we have some. */
+ if (imperfect)
+ {
+ any_imperfect = true;
+ if (diagnose_intervening_code_errors (do_code->block->next,
+ name, next))
+ errorp = true;
+ }
+
+ /* Check for presence of nested TILE directive, used for next level
+ of the imperfect loop error checking above. Then resolve all the
+ transforms at this level. */
+ if (!is_tile && !is_nested_tile && !perfect_nesting_errorp)
+ for (gfc_code *c = next; c && loop_transform_p (c->op); )
+ {
+ if (c->op == EXEC_OMP_TILE)
+ {
+ is_nested_tile = true;
+ break;
+ }
+ if (c->block)
+ c = c->block->next;
+ else
+ c = c->next;
+ }
+ next = resolve_nested_loop_transforms (next, name, num_loops - i,
+ &code->loc);
+ if (!next)
+ {
+ gfc_error ("not enough DO loops for %s at %L",
+ name, &code->loc);
+ return;
}
+
+ do_code = next;
}
+
+ /* Give up now if we found any constraint violations. */
+ if (errorp)
+ return;
+
+ /* Only restructure intervening code if we found some. Note that
+ restructure_intervening_code assumes CODE is a DO loop instead of a
+ top-level TILE directive, which should have been rejected already if
+ if contains intervening code. */
+ if (is_tile)
+ gcc_assert (!any_imperfect);
+ if (any_imperfect)
+ restructure_intervening_code (&(code->block->next), code, num_loops);
}
static void
resolve_omp_do (gfc_code *code)
{
gfc_code *do_code;
- int collapse;
+ int count;
const char *name;
bool is_simd = false;
@@ -10787,15 +11265,15 @@ resolve_omp_do (gfc_code *code)
resolve_omp_clauses (code, code->ext.omp_clauses, NULL);
if (code->ext.omp_clauses->orderedc)
- collapse = code->ext.omp_clauses->orderedc;
+ count = code->ext.omp_clauses->orderedc;
else
{
- collapse = code->ext.omp_clauses->collapse;
- if (collapse <= 0)
- collapse = 1;
+ count = code->ext.omp_clauses->collapse;
+ if (count <= 0)
+ count = 1;
}
- do_code = resolve_nested_loop_transforms (code->block->next, name, collapse,
+ do_code = resolve_nested_loop_transforms (code->block->next, name, count,
&code->loc);
/* While the spec defines the loop nest depth independently of the COLLAPSE
@@ -10803,7 +11281,7 @@ resolve_omp_do (gfc_code *code)
depth and treats any further inner loops as the final-loop-body. So
here we also check canonical loop nest form only for the number of
outer loops specified by the COLLAPSE clause too. */
- resolve_nested_loops (code, name, do_code, collapse, is_simd, false);
+ resolve_nested_loops (code, name, do_code, count, is_simd, false);
}
static void
diff --git a/gcc/testsuite/ChangeLog.omp b/gcc/testsuite/ChangeLog.omp
index 24a8bc43b10..810f1e6c929 100644
--- a/gcc/testsuite/ChangeLog.omp
+++ b/gcc/testsuite/ChangeLog.omp
@@ -1,3 +1,16 @@
+2023-06-13 Sandra Loosemore <sandra@codesourcery.com>
+
+ * gfortran.dg/gomp/collapse1.f90: Adjust expected errors.
+ * gfortran.dg/gomp/collapse2.f90: Likewise.
+ * gfortran.dg/gomp/imperfect1.f90: New.
+ * gfortran.dg/gomp/imperfect2.f90: New.
+ * gfortran.dg/gomp/imperfect3.f90: New.
+ * gfortran.dg/gomp/imperfect4.f90: New.
+ * gfortran.dg/gomp/imperfect5.f90: New.
+ * gfortran.dg/gomp/loop-transforms/tile-1.f90: Adjust expected errors.
+ * gfortran.dg/gomp/loop-transforms/tile-2.f90: Likewise.
+ * gfortran.dg/gomp/loop-transforms/tile-imperfect-nest.f90: Likewise.
+
2023-06-13 Sandra Loosemore <sandra@codesourcery.com>
* gfortran.dg/gomp/collapse1.f90: Adjust expected error message.
diff --git a/gcc/testsuite/gfortran.dg/gomp/collapse1.f90 b/gcc/testsuite/gfortran.dg/gomp/collapse1.f90
index d938e1b569d..485922569b3 100644
--- a/gcc/testsuite/gfortran.dg/gomp/collapse1.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/collapse1.f90
@@ -31,7 +31,7 @@ subroutine collapse1
do i = 1, 3
do j = 4, 6
end do
- k = 4 ! { dg-error "loops not perfectly nested" }
+ k = 4
end do
!$omp parallel do collapse(2)
do i = 1, 3
diff --git a/gcc/testsuite/gfortran.dg/gomp/collapse2.f90 b/gcc/testsuite/gfortran.dg/gomp/collapse2.f90
index 0aa7d9391e5..60c1d7c0813 100644
--- a/gcc/testsuite/gfortran.dg/gomp/collapse2.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/collapse2.f90
@@ -6,24 +6,24 @@ program p
do j = 1, 8
do k = 1, 8
end do
- x = 5 ! { dg-error "loops not perfectly nested" }
+ x = 5
end do
end do
- !$omp parallel do ordered(3)
+ !$omp parallel do ordered(3) ! { dg-error "inner loops must be perfectly nested with ORDERED clause" }
do i = 1, 8
do j = 1, 8
do k = 1, 8
end do
end do
- x = 5 ! { dg-error "loops not perfectly nested" }
+ x = 5
end do
- !$omp parallel do collapse(2) ! { dg-error "not enough DO loops for" }
+ !$omp parallel do collapse(2)
do i = 1, 8
x = 5
do j = 1, 8
end do
end do
- !$omp parallel do ordered(2) ! { dg-error "not enough DO loops for" }
+ !$omp parallel do ordered(2) ! { dg-error "inner loops must be perfectly nested with ORDERED clause" }
do i = 1, 8
x = 5
do j = 1, 8
diff --git a/gcc/testsuite/gfortran.dg/gomp/imperfect1.f90 b/gcc/testsuite/gfortran.dg/gomp/imperfect1.f90
new file mode 100644
index 00000000000..4e750d9ad05
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/imperfect1.f90
@@ -0,0 +1,39 @@
+! This test case is expected to fail due to errors.
+
+subroutine f1 (depth, iter)
+ integer :: depth, iter
+end subroutine
+
+subroutine f2 (depth, iter)
+ integer :: depth, iter
+end subroutine
+
+subroutine s1 (a1, a2, a3)
+ integer :: a1, a2, a3
+ integer :: i, j, k
+
+ !$omp do collapse(3)
+ do i = 1, a1
+ call f1 (1, i)
+ do j = 1, a2
+ call f1 (2, j)
+ if (i == 3) then
+ cycle ! { dg-error "CYCLE statement" }
+ else
+ exit ! { dg-error "EXIT statement" }
+ endif
+!$omp barrier ! { dg-error "OpenMP directive in intervening code" }
+ do k = 1, a3
+ call f1 (3, k)
+ call f2 (3, k)
+ end do
+ call f2 (2, j)
+ end do
+ do k = 1, a3 ! { dg-error "loop in intervening code" }
+ call f1 (3, k)
+ call f2 (3, k)
+ end do
+ call f2 (1, i)
+ end do
+
+end subroutine
diff --git a/gcc/testsuite/gfortran.dg/gomp/imperfect2.f90 b/gcc/testsuite/gfortran.dg/gomp/imperfect2.f90
new file mode 100644
index 00000000000..d02191050d9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/imperfect2.f90
@@ -0,0 +1,56 @@
+! This test case is expected to fail due to errors.
+
+! Note that the calls to these functions in the test case don't make
+! any sense in terms of behavior, they're just there to test the error
+! behavior.
+
+module omp_lib
+ use iso_c_binding
+ interface
+ integer function omp_get_thread_num ()
+ end
+ subroutine omp_set_max_levels (i)
+ integer :: i
+ end
+ end interface
+end module
+
+program junk
+ use omp_lib
+ implicit none
+
+contains
+
+subroutine f1 (depth, iter)
+ integer :: depth, iter
+end subroutine
+
+subroutine f2 (depth, iter)
+ integer :: depth, iter
+end subroutine
+
+subroutine s1 (a1, a2, a3)
+ integer :: a1, a2, a3
+ integer :: i, j, k
+
+ integer :: m
+
+ !$omp do collapse(3)
+ do i = 1, a1
+ call f1 (1, i)
+ m = omp_get_thread_num () ! { dg-error "OpenMP API call in intervening code" }
+ do j = 1, a2 + omp_get_thread_num () ! This is OK
+ call f1 (2, j)
+ do k = 1, a3
+ call f1 (m, k)
+ call omp_set_max_active_levels (k) ! This is OK too
+ call f2 (m, k)
+ end do
+ call f2 (2, j)
+ call omp_set_max_active_levels (i) ! { dg-error "OpenMP API call in intervening code" }
+ end do
+ call f2 (1, i)
+ end do
+end subroutine
+
+end program
diff --git a/gcc/testsuite/gfortran.dg/gomp/imperfect3.f90 b/gcc/testsuite/gfortran.dg/gomp/imperfect3.f90
new file mode 100644
index 00000000000..2eccdfc8b58
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/imperfect3.f90
@@ -0,0 +1,29 @@
+! This test case is expected to fail due to errors.
+
+subroutine f1 (depth, iter)
+ integer :: depth, iter
+end subroutine
+
+subroutine f2 (depth, iter)
+ integer :: depth, iter
+end subroutine
+
+subroutine s1 (a1, a2, a3)
+ integer :: a1, a2, a3
+ integer :: i, j, k
+
+ !$omp do ordered(3) ! { dg-error "inner loops must be perfectly nested" }
+ do i = 1, a1
+ call f1 (1, i)
+ do j = 1, a2
+ call f1 (2, j)
+ do k = 1, a3
+ call f1 (3, k)
+ call f2 (3, k)
+ end do
+ call f2 (2, j)
+ end do
+ call f2 (1, i)
+ end do
+
+end subroutine
diff --git a/gcc/testsuite/gfortran.dg/gomp/imperfect4.f90 b/gcc/testsuite/gfortran.dg/gomp/imperfect4.f90
new file mode 100644
index 00000000000..b7ccd8b6c53
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/imperfect4.f90
@@ -0,0 +1,36 @@
+! This test case is expected to fail due to errors.
+
+subroutine f1 (depth, iter)
+ integer :: depth, iter
+end subroutine
+
+subroutine f2 (depth, iter)
+ integer :: depth, iter
+end subroutine
+
+! Unlike the C/C++ front ends, the Fortran front end already has the whole
+! parse tree for the OMP DO construct before doing error checking on it.
+! It gives up immediately if there are not enough nested loops for the
+! specified COLLAPSE depth, without error-checking intervening code.
+
+subroutine s1 (a1, a2, a3)
+ integer :: a1, a2, a3
+ integer :: i, j, k
+
+ !$omp do collapse(4) ! { dg-error "not enough DO loops" }
+ do i = 1, a1
+ call f1 (1, i)
+ do j = 1, a2
+ call f1 (2, j)
+ do k = 1, a3
+! This is not valid intervening code, but the above error takes precedence.
+!$omp barrier
+ call f1 (3, k)
+ call f2 (3, k)
+ end do
+ call f2 (2, j)
+ end do
+ call f2 (1, i)
+ end do
+
+end subroutine
diff --git a/gcc/testsuite/gfortran.dg/gomp/imperfect5.f90 b/gcc/testsuite/gfortran.dg/gomp/imperfect5.f90
new file mode 100644
index 00000000000..95cc7f144a2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/imperfect5.f90
@@ -0,0 +1,67 @@
+! This test case is expected to fail due to errors.
+
+subroutine f1 (depth, iter)
+ integer :: depth, iter
+end subroutine
+
+subroutine f2 (depth, iter)
+ integer :: depth, iter
+end subroutine
+
+function ijk (x, y, z)
+ integer :: ijk
+ integer :: x, y, z
+end function
+
+subroutine f3 (sum)
+ integer :: sum
+end subroutine
+
+! This function isn't particularly meaningful, but it should compile without
+! error.
+function s1 (a1, a2, a3)
+ integer :: s1
+ integer :: a1, a2, a3
+ integer :: i, j, k
+ integer :: r
+
+ r = 0
+ !$omp simd collapse(3) reduction (inscan, +:r)
+ do i = 1, a1
+ do j = 1, a2
+ do k = 1, a3
+ r = r + ijk (i, j, k)
+!$omp scan exclusive (r)
+ call f3 (r)
+ end do
+ end do
+ end do
+
+ s1 = r
+end function
+
+! Adding intervening code should trigger an error.
+function s2 (a1, a2, a3)
+ integer :: s2
+ integer :: a1, a2, a3
+ integer :: i, j, k
+ integer :: r
+
+ r = 0
+ !$omp simd collapse(3) reduction (inscan, +:r) ! { dg-error "inner loops must be perfectly nested" }
+ do i = 1, a1
+ call f1 (1, i)
+ do j = 1, a2
+ call f1 (2, j)
+ do k = 1, a3
+ r = r + ijk (i, j, k)
+!$omp scan exclusive (r)
+ call f3 (r)
+ end do
+ call f2 (2, j)
+ end do
+ call f2 (1, i)
+ end do
+
+ s2 = r
+end function
diff --git a/gcc/testsuite/gfortran.dg/gomp/loop-transforms/tile-1.f90 b/gcc/testsuite/gfortran.dg/gomp/loop-transforms/tile-1.f90
index 84ea93300fa..be3dd1e400c 100644
--- a/gcc/testsuite/gfortran.dg/gomp/loop-transforms/tile-1.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/loop-transforms/tile-1.f90
@@ -117,29 +117,29 @@ subroutine test
end do
!$end omp tile
- !$omp tile sizes(1,2,1)
+ !$omp tile sizes(1,2,1) ! { dg-error {\!\$OMP TILE inner loops must be perfectly nested at \(1\)} }
do i = 1,100
do j = 1,100
do k = 1,100
call dummy(i)
end do
end do
- call dummy(i) ! { dg-error {\!\$OMP TILE loops not perfectly nested at \(1\)} }
+ call dummy(i)
end do
!$end omp tile
- !$omp tile sizes(1,2,1)
+ !$omp tile sizes(1,2,1) ! { dg-error {\!\$OMP TILE inner loops must be perfectly nested at \(1\)} }
do i = 1,100
do j = 1,100
do k = 1,100
call dummy(i)
end do
- call dummy(j) ! { dg-error {\!\$OMP TILE loops not perfectly nested at \(1\)} }
+ call dummy(j)
end do
end do
!$end omp tile
- !$omp tile sizes(1,2,1) ! { dg-error {not enough DO loops for \!\$OMP TILE at \(1\)} }
+ !$omp tile sizes(1,2,1) ! { dg-error {\!\$OMP TILE inner loops must be perfectly nested at \(1\)} }
do i = 1,100
call dummy(i)
do j = 1,100
@@ -150,7 +150,7 @@ subroutine test
end do
!$end omp tile
- !$omp tile sizes(1,2,1) ! { dg-error {not enough DO loops for \!\$OMP TILE at \(1\)} }
+ !$omp tile sizes(1,2,1) ! { dg-error {\!\$OMP TILE inner loops must be perfectly nested at \(1\)} }
do i = 1,100
do j = 1,100
call dummy(j)
diff --git a/gcc/testsuite/gfortran.dg/gomp/loop-transforms/tile-2.f90 b/gcc/testsuite/gfortran.dg/gomp/loop-transforms/tile-2.f90
index f4c24f76eac..d14af08c27a 100644
--- a/gcc/testsuite/gfortran.dg/gomp/loop-transforms/tile-2.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/loop-transforms/tile-2.f90
@@ -64,7 +64,7 @@ subroutine test3
implicit none
integer :: i, j, k
- !$omp taskloop collapse(3) ! { dg-error {not enough DO loops for \!\$OMP TASKLOOP at \(1\)} }
+ !$omp taskloop collapse(3)
!$omp tile sizes (1,2) ! { dg-error {loop nest depth after \!\$OMP TILE at \(1\) is insufficient for outer \!\$OMP TASKLOOP} }
!$omp tile sizes (1,2)
do i = 1,100
diff --git a/gcc/testsuite/gfortran.dg/gomp/loop-transforms/tile-imperfect-nest.f90 b/gcc/testsuite/gfortran.dg/gomp/loop-transforms/tile-imperfect-nest.f90
index 3ec1671f01f..977a39af9da 100644
--- a/gcc/testsuite/gfortran.dg/gomp/loop-transforms/tile-imperfect-nest.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/loop-transforms/tile-imperfect-nest.f90
@@ -21,7 +21,7 @@ subroutine test0m
integer :: i, j, k, inner
!$omp parallel do collapse(2) private(inner)
do i = 1,m
- !$omp tile sizes (8, 1)
+ !$omp tile sizes (8, 1) ! { dg-error {\!\$OMP TILE inner loops must be perfectly nested at \(1\)} }
do j = 1,n
do k = 1, n
if (k == 1) then
@@ -29,7 +29,7 @@ subroutine test0m
endif
inner = inner + a(k, i) * b(j, k)
end do
- c(j, i) = inner ! { dg-error {\!\$OMP TILE loops not perfectly nested at \(1\)} }
+ c(j, i) = inner
end do
end do
end subroutine test0m
@@ -40,7 +40,7 @@ subroutine test1
!$omp parallel do collapse(2) private(inner)
!$omp tile sizes (8, 1)
do i = 1,m
- !$omp tile sizes (8, 1)
+ !$omp tile sizes (8, 1) ! { dg-error {\!\$OMP TILE inner loops must be perfectly nested at \(1\)} }
do j = 1,n
!$omp unroll partial(10)
do k = 1, n
@@ -49,7 +49,7 @@ subroutine test1
endif
inner = inner + a(k, i) * b(j, k)
end do
- c(j, i) = inner ! { dg-error {\!\$OMP TILE loops not perfectly nested at \(1\)} "TODO Fix with upcoming imperfect loop nest handling" { xfail *-*-* } }
+ c(j, i) = inner
end do
end do
end subroutine test1
@@ -61,7 +61,7 @@ subroutine test2
!$omp parallel do collapse(2) private(inner)
!$omp tile sizes (8, 1)
do i = 1,m
- !$omp tile sizes (8, 1)
+ !$omp tile sizes (8, 1) ! { dg-error {\!\$OMP TILE inner loops must be perfectly nested at \(1\)} }
do j = 1,n
do k = 1, n
if (k == 1) then
@@ -69,7 +69,7 @@ subroutine test2
endif
inner = inner + a(k, i) * b(j, k)
end do
- c(j, i) = inner ! { dg-error {\!\$OMP TILE loops not perfectly nested at \(1\)} }
+ c(j, i) = inner
end do
end do
end subroutine test2
@@ -79,7 +79,7 @@ subroutine test3
integer :: i, j, k, inner
!$omp parallel do collapse(2) private(inner)
do i = 1,m
- !$omp tile sizes (8, 1)
+ !$omp tile sizes (8, 1) ! { dg-error {\!\$OMP TILE inner loops must be perfectly nested at \(1\)} }
do j = 1,n
do k = 1, n
if (k == 1) then
@@ -87,7 +87,7 @@ subroutine test3
endif
inner = inner + a(k, i) * b(j, k)
end do
- c(j, i) = inner ! { dg-error {\!\$OMP TILE loops not perfectly nested at \(1\)} }
+ c(j, i) = inner
end do
end do
end subroutine test3
diff --git a/libgomp/ChangeLog.omp b/libgomp/ChangeLog.omp
index cd6dfa6af2d..f740f880934 100644
--- a/libgomp/ChangeLog.omp
+++ b/libgomp/ChangeLog.omp
@@ -1,3 +1,19 @@
+2023-06-13 Sandra Loosemore <sandra@codesourcery.com>
+
+ * testsuite/libgomp.fortran/imperfect-destructor.f90: New.
+ * testsuite/libgomp.fortran/imperfect-transform-1.f90: New.
+ * testsuite/libgomp.fortran/imperfect-transform-2.f90: New.
+ * testsuite/libgomp.fortran/imperfect1.f90: New.
+ * testsuite/libgomp.fortran/imperfect2.f90: New.
+ * testsuite/libgomp.fortran/imperfect3.f90: New.
+ * testsuite/libgomp.fortran/imperfect4.f90: New.
+ * testsuite/libgomp.fortran/target-imperfect-transform-1.f90: New.
+ * testsuite/libgomp.fortran/target-imperfect-transform-2.f90: New.
+ * testsuite/libgomp.fortran/target-imperfect1.f90: New.
+ * testsuite/libgomp.fortran/target-imperfect2.f90: New.
+ * testsuite/libgomp.fortran/target-imperfect3.f90: New.
+ * testsuite/libgomp.fortran/target-imperfect4.f90: New.
+
2023-06-13 Sandra Loosemore <sandra@codesourcery.com>
* testsuite/libgomp.c-c++-common/imperfect-transform-1.c: New.
diff --git a/libgomp/testsuite/libgomp.fortran/imperfect-destructor.f90 b/libgomp/testsuite/libgomp.fortran/imperfect-destructor.f90
new file mode 100644
index 00000000000..664d27fe968
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/imperfect-destructor.f90
@@ -0,0 +1,142 @@
+! { dg-do run }
+
+! Like imperfect2.f90, but adds bindings to the blocks.
+
+module m
+ implicit none
+ type t
+ integer :: i
+ contains
+ final :: fini
+ end type t
+
+ integer :: ccount(3), dcount(3)
+
+ contains
+
+ subroutine init(x, n)
+ type(t) :: x
+ integer :: n
+ x%i = n
+ ccount(x%i) = ccount(x%i) + 1
+ end subroutine init
+
+ subroutine fini(x)
+ type(t) :: x
+ dcount(x%i) = dcount(x%i) + 1
+ end subroutine fini
+end module m
+
+program foo
+ use m
+
+ integer :: f1count(3), f2count(3), g1count(3), g2count(3)
+
+ f1count(1) = 0
+ f1count(2) = 0
+ f1count(3) = 0
+ f2count(1) = 0
+ f2count(2) = 0
+ f2count(3) = 0
+
+ g1count(1) = 0
+ g1count(2) = 0
+ g1count(3) = 0
+ g2count(1) = 0
+ g2count(2) = 0
+ g2count(3) = 0
+
+ call s1 (3, 4, 5)
+
+ ! All intervening code at the same depth must be executed the same
+ ! number of times.
+ if (f1count(1) /= f2count(1)) error stop 101
+ if (f1count(2) /= f2count(2)) error stop 102
+ if (f1count(3) /= f2count(3)) error stop 103
+ if (g1count(1) /= f1count(1)) error stop 104
+ if (g2count(1) /= f1count(1)) error stop 105
+ if (g1count(2) /= f1count(2)) error stop 106
+ if (g2count(2) /= f1count(2)) error stop 107
+ if (g1count(3) /= f1count(3)) error stop 108
+ if (g2count(3) /= f1count(3)) error stop 109
+
+ ! Intervening code must be executed at least as many times as the loop
+ ! that encloses it.
+ if (f1count(1) < 3) error stop 111
+ if (f1count(2) < 3 * 4) error stop 112
+
+ ! Intervening code must not be executed more times than the number
+ ! of logical iterations.
+ if (f1count(1) > 3 * 4 * 5) error stop 121
+ if (f1count(2) > 3 * 4 * 5) error stop 122
+
+ ! Check that the innermost loop body is executed exactly the number
+ ! of logical iterations expected.
+ if (f1count(3) /= 3 * 4 * 5) error stop 131
+
+ ! Check that constructors and destructors are called equal number of times.
+ if (ccount(1) /= dcount(1)) error stop 141
+ if (ccount(2) /= dcount(2)) error stop 142
+ if (ccount(3) /= dcount(3)) error stop 143
+
+contains
+
+subroutine f1 (depth, iter)
+ integer :: depth, iter
+ f1count(depth) = f1count(depth) + 1
+end subroutine
+
+subroutine f2 (depth, iter)
+ integer :: depth, iter
+ f2count(depth) = f2count(depth) + 1
+end subroutine
+
+subroutine g1 (depth, iter)
+ integer :: depth, iter
+ g1count(depth) = g1count(depth) + 1
+end subroutine
+
+subroutine g2 (depth, iter)
+ integer :: depth, iter
+ g2count(depth) = g2count(depth) + 1
+end subroutine
+
+subroutine s1 (a1, a2, a3)
+ integer :: a1, a2, a3
+ integer :: i, j, k
+
+ !$omp do collapse(3)
+ do i = 1, a1
+ call f1 (1, i)
+ block
+ type (t) :: local1
+ call init (local1, 1)
+ call g1 (local1%i, i)
+ do j = 1, a2
+ call f1 (2, j)
+ block
+ type (t) :: local2
+ call init (local2, 2)
+ call g1 (local2%i, j)
+ do k = 1, a3
+ call f1 (3, k)
+ block
+ type (t) :: local3
+ call init (local3, 3)
+ call g1 (local3%i, k)
+ call g2 (local3%i, k)
+ end block
+ call f2 (3, k)
+ end do
+ call g2 (local2%i, j)
+ end block
+ call f2 (2, j)
+ end do
+ call g2 (local1%i, i)
+ end block
+ call f2 (1, i)
+ end do
+
+end subroutine
+
+end program
diff --git a/libgomp/testsuite/libgomp.fortran/imperfect-transform-1.f90 b/libgomp/testsuite/libgomp.fortran/imperfect-transform-1.f90
new file mode 100644
index 00000000000..aa956707414
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/imperfect-transform-1.f90
@@ -0,0 +1,70 @@
+! { dg-do run }
+
+! Like imperfect1.f90, but also includes loop transforms.
+
+program foo
+ integer, save :: f1count(3), f2count(3)
+
+ f1count(1) = 0
+ f1count(2) = 0
+ f1count(3) = 0
+ f2count(1) = 0
+ f2count(2) = 0
+ f2count(3) = 0
+
+ call s1 (3, 4, 5)
+
+ ! All intervening code at the same depth must be executed the same
+ ! number of times.
+ if (f1count(1) /= f2count(1)) error stop 101
+ if (f1count(2) /= f2count(2)) error stop 102
+ if (f1count(3) /= f2count(3)) error stop 103
+
+ ! Intervening code must be executed at least as many times as the loop
+ ! that encloses it.
+ if (f1count(1) < 3) error stop 111
+ if (f1count(2) < 3 * 4) error stop 112
+
+ ! Intervening code must not be executed more times than the number
+ ! of logical iterations.
+ if (f1count(1) > 3 * 4 * 5) error stop 121
+ if (f1count(2) > 3 * 4 * 5) error stop 122
+
+ ! Check that the innermost loop body is executed exactly the number
+ ! of logical iterations expected.
+ if (f1count(3) /= 3 * 4 * 5) error stop 131
+
+contains
+
+subroutine f1 (depth, iter)
+ integer :: depth, iter
+ f1count(depth) = f1count(depth) + 1
+end subroutine
+
+subroutine f2 (depth, iter)
+ integer :: depth, iter
+ f2count(depth) = f2count(depth) + 1
+end subroutine
+
+subroutine s1 (a1, a2, a3)
+ integer :: a1, a2, a3
+ integer :: i, j, k
+
+ !$omp do collapse(3)
+ do i = 1, a1
+ call f1 (1, i)
+ do j = 1, a2
+ call f1 (2, j)
+ !$omp unroll partial
+ do k = 1, a3
+ call f1 (3, k)
+ call f2 (3, k)
+ end do
+ call f2 (2, j)
+ end do
+ call f2 (1, i)
+ end do
+
+end subroutine
+
+end program
diff --git a/libgomp/testsuite/libgomp.fortran/imperfect-transform-2.f90 b/libgomp/testsuite/libgomp.fortran/imperfect-transform-2.f90
new file mode 100644
index 00000000000..be199ab9218
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/imperfect-transform-2.f90
@@ -0,0 +1,70 @@
+! { dg-do run }
+
+! Like imperfect1.f90, but also includes loop transforms.
+
+program foo
+ integer, save :: f1count(3), f2count(3)
+
+ f1count(1) = 0
+ f1count(2) = 0
+ f1count(3) = 0
+ f2count(1) = 0
+ f2count(2) = 0
+ f2count(3) = 0
+
+ call s1 (3, 4, 5)
+
+ ! All intervening code at the same depth must be executed the same
+ ! number of times.
+ if (f1count(1) /= f2count(1)) error stop 101
+ if (f1count(2) /= f2count(2)) error stop 102
+ if (f1count(3) /= f2count(3)) error stop 103
+
+ ! Intervening code must be executed at least as many times as the loop
+ ! that encloses it.
+ if (f1count(1) < 3) error stop 111
+ if (f1count(2) < 3 * 4) error stop 112
+
+ ! Intervening code must not be executed more times than the number
+ ! of logical iterations.
+ if (f1count(1) > 3 * 4 * 5) error stop 121
+ if (f1count(2) > 3 * 4 * 5) error stop 122
+
+ ! Check that the innermost loop body is executed exactly the number
+ ! of logical iterations expected.
+ if (f1count(3) /= 3 * 4 * 5) error stop 131
+
+contains
+
+subroutine f1 (depth, iter)
+ integer :: depth, iter
+ f1count(depth) = f1count(depth) + 1
+end subroutine
+
+subroutine f2 (depth, iter)
+ integer :: depth, iter
+ f2count(depth) = f2count(depth) + 1
+end subroutine
+
+subroutine s1 (a1, a2, a3)
+ integer :: a1, a2, a3
+ integer :: i, j, k
+
+ !$omp do collapse(3)
+ do i = 1, a1
+ call f1 (1, i)
+ do j = 1, a2
+ call f1 (2, j)
+ !$omp tile sizes(5)
+ do k = 1, a3
+ call f1 (3, k)
+ call f2 (3, k)
+ end do
+ call f2 (2, j)
+ end do
+ call f2 (1, i)
+ end do
+
+end subroutine
+
+end program
diff --git a/libgomp/testsuite/libgomp.fortran/imperfect1.f90 b/libgomp/testsuite/libgomp.fortran/imperfect1.f90
new file mode 100644
index 00000000000..8c483c2a4e5
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/imperfect1.f90
@@ -0,0 +1,67 @@
+! { dg-do run }
+
+program foo
+ integer, save :: f1count(3), f2count(3)
+
+ f1count(1) = 0
+ f1count(2) = 0
+ f1count(3) = 0
+ f2count(1) = 0
+ f2count(2) = 0
+ f2count(3) = 0
+
+ call s1 (3, 4, 5)
+
+ ! All intervening code at the same depth must be executed the same
+ ! number of times.
+ if (f1count(1) /= f2count(1)) error stop 101
+ if (f1count(2) /= f2count(2)) error stop 102
+ if (f1count(3) /= f2count(3)) error stop 103
+
+ ! Intervening code must be executed at least as many times as the loop
+ ! that encloses it.
+ if (f1count(1) < 3) error stop 111
+ if (f1count(2) < 3 * 4) error stop 112
+
+ ! Intervening code must not be executed more times than the number
+ ! of logical iterations.
+ if (f1count(1) > 3 * 4 * 5) error stop 121
+ if (f1count(2) > 3 * 4 * 5) error stop 122
+
+ ! Check that the innermost loop body is executed exactly the number
+ ! of logical iterations expected.
+ if (f1count(3) /= 3 * 4 * 5) error stop 131
+
+contains
+
+subroutine f1 (depth, iter)
+ integer :: depth, iter
+ f1count(depth) = f1count(depth) + 1
+end subroutine
+
+subroutine f2 (depth, iter)
+ integer :: depth, iter
+ f2count(depth) = f2count(depth) + 1
+end subroutine
+
+subroutine s1 (a1, a2, a3)
+ integer :: a1, a2, a3
+ integer :: i, j, k
+
+ !$omp do collapse(3)
+ do i = 1, a1
+ call f1 (1, i)
+ do j = 1, a2
+ call f1 (2, j)
+ do k = 1, a3
+ call f1 (3, k)
+ call f2 (3, k)
+ end do
+ call f2 (2, j)
+ end do
+ call f2 (1, i)
+ end do
+
+end subroutine
+
+end program
diff --git a/libgomp/testsuite/libgomp.fortran/imperfect2.f90 b/libgomp/testsuite/libgomp.fortran/imperfect2.f90
new file mode 100644
index 00000000000..e42cb08031b
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/imperfect2.f90
@@ -0,0 +1,102 @@
+! { dg-do run }
+
+program foo
+ integer, save :: f1count(3), f2count(3), g1count(3), g2count(3)
+
+ f1count(1) = 0
+ f1count(2) = 0
+ f1count(3) = 0
+ f2count(1) = 0
+ f2count(2) = 0
+ f2count(3) = 0
+
+ g1count(1) = 0
+ g1count(2) = 0
+ g1count(3) = 0
+ g2count(1) = 0
+ g2count(2) = 0
+ g2count(3) = 0
+
+ call s1 (3, 4, 5)
+
+ ! All intervening code at the same depth must be executed the same
+ ! number of times.
+ if (f1count(1) /= f2count(1)) error stop 101
+ if (f1count(2) /= f2count(2)) error stop 102
+ if (f1count(3) /= f2count(3)) error stop 103
+ if (g1count(1) /= f1count(1)) error stop 104
+ if (g2count(1) /= f1count(1)) error stop 105
+ if (g1count(2) /= f1count(2)) error stop 106
+ if (g2count(2) /= f1count(2)) error stop 107
+ if (g1count(3) /= f1count(3)) error stop 108
+ if (g2count(3) /= f1count(3)) error stop 109
+
+ ! Intervening code must be executed at least as many times as the loop
+ ! that encloses it.
+ if (f1count(1) < 3) error stop 111
+ if (f1count(2) < 3 * 4) error stop 112
+
+ ! Intervening code must not be executed more times than the number
+ ! of logical iterations.
+ if (f1count(1) > 3 * 4 * 5) error stop 121
+ if (f1count(2) > 3 * 4 * 5) error stop 122
+
+ ! Check that the innermost loop body is executed exactly the number
+ ! of logical iterations expected.
+ if (f1count(3) /= 3 * 4 * 5) error stop 131
+
+contains
+
+subroutine f1 (depth, iter)
+ integer :: depth, iter
+ f1count(depth) = f1count(depth) + 1
+end subroutine
+
+subroutine f2 (depth, iter)
+ integer :: depth, iter
+ f2count(depth) = f2count(depth) + 1
+end subroutine
+
+subroutine g1 (depth, iter)
+ integer :: depth, iter
+ g1count(depth) = g1count(depth) + 1
+end subroutine
+
+subroutine g2 (depth, iter)
+ integer :: depth, iter
+ g2count(depth) = g2count(depth) + 1
+end subroutine
+
+subroutine s1 (a1, a2, a3)
+ integer :: a1, a2, a3
+ integer :: i, j, k
+
+ !$omp do collapse(3)
+ do i = 1, a1
+ call f1 (1, i)
+ block
+ call g1 (1, i)
+ do j = 1, a2
+ call f1 (2, j)
+ block
+ call g1 (2, j)
+ do k = 1, a3
+ call f1 (3, k)
+ block
+ call g1 (3, k)
+ call g2 (3, k)
+ end block
+ call f2 (3, k)
+ end do
+ call g2 (2, j)
+ end block
+ call f2 (2, j)
+ end do
+ call g2 (1, i)
+ end block
+ call f2 (1, i)
+ end do
+
+end subroutine
+
+end program
diff --git a/libgomp/testsuite/libgomp.fortran/imperfect3.f90 b/libgomp/testsuite/libgomp.fortran/imperfect3.f90
new file mode 100644
index 00000000000..da094612332
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/imperfect3.f90
@@ -0,0 +1,110 @@
+! { dg-do run }
+
+! Like imperfect2.f90, but adds bindings to the blocks.
+
+program foo
+ integer, save :: f1count(3), f2count(3), g1count(3), g2count(3)
+
+ f1count(1) = 0
+ f1count(2) = 0
+ f1count(3) = 0
+ f2count(1) = 0
+ f2count(2) = 0
+ f2count(3) = 0
+
+ g1count(1) = 0
+ g1count(2) = 0
+ g1count(3) = 0
+ g2count(1) = 0
+ g2count(2) = 0
+ g2count(3) = 0
+
+ call s1 (3, 4, 5)
+
+ ! All intervening code at the same depth must be executed the same
+ ! number of times.
+ if (f1count(1) /= f2count(1)) error stop 101
+ if (f1count(2) /= f2count(2)) error stop 102
+ if (f1count(3) /= f2count(3)) error stop 103
+ if (g1count(1) /= f1count(1)) error stop 104
+ if (g2count(1) /= f1count(1)) error stop 105
+ if (g1count(2) /= f1count(2)) error stop 106
+ if (g2count(2) /= f1count(2)) error stop 107
+ if (g1count(3) /= f1count(3)) error stop 108
+ if (g2count(3) /= f1count(3)) error stop 109
+
+ ! Intervening code must be executed at least as many times as the loop
+ ! that encloses it.
+ if (f1count(1) < 3) error stop 111
+ if (f1count(2) < 3 * 4) error stop 112
+
+ ! Intervening code must not be executed more times than the number
+ ! of logical iterations.
+ if (f1count(1) > 3 * 4 * 5) error stop 121
+ if (f1count(2) > 3 * 4 * 5) error stop 122
+
+ ! Check that the innermost loop body is executed exactly the number
+ ! of logical iterations expected.
+ if (f1count(3) /= 3 * 4 * 5) error stop 131
+
+contains
+
+subroutine f1 (depth, iter)
+ integer :: depth, iter
+ f1count(depth) = f1count(depth) + 1
+end subroutine
+
+subroutine f2 (depth, iter)
+ integer :: depth, iter
+ f2count(depth) = f2count(depth) + 1
+end subroutine
+
+subroutine g1 (depth, iter)
+ integer :: depth, iter
+ g1count(depth) = g1count(depth) + 1
+end subroutine
+
+subroutine g2 (depth, iter)
+ integer :: depth, iter
+ g2count(depth) = g2count(depth) + 1
+end subroutine
+
+subroutine s1 (a1, a2, a3)
+ integer :: a1, a2, a3
+ integer :: i, j, k
+
+ !$omp do collapse(3)
+ do i = 1, a1
+ call f1 (1, i)
+ block
+ integer :: local1
+ local1 = 1
+ call g1 (local1, i)
+ do j = 1, a2
+ call f1 (2, j)
+ block
+ integer :: local2
+ local2 = 2
+ call g1 (local2, j)
+ do k = 1, a3
+ call f1 (3, k)
+ block
+ integer :: local3
+ local3 = 3
+ call g1 (local3, k)
+ call g2 (local3, k)
+ end block
+ call f2 (3, k)
+ end do
+ call g2 (local2, j)
+ end block
+ call f2 (2, j)
+ end do
+ call g2 (local1, i)
+ end block
+ call f2 (1, i)
+ end do
+
+end subroutine
+
+end program
diff --git a/libgomp/testsuite/libgomp.fortran/imperfect4.f90 b/libgomp/testsuite/libgomp.fortran/imperfect4.f90
new file mode 100644
index 00000000000..1679c8c5b92
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/imperfect4.f90
@@ -0,0 +1,121 @@
+! { dg-do run }
+
+! Like imperfect2.f90, but includes blocks that are themselves wholly
+! intervening code and not containers for nested loops.
+
+program foo
+ integer, save :: f1count(3), f2count(3), g1count(3), g2count(3)
+
+ f1count(1) = 0
+ f1count(2) = 0
+ f1count(3) = 0
+ f2count(1) = 0
+ f2count(2) = 0
+ f2count(3) = 0
+
+ g1count(1) = 0
+ g1count(2) = 0
+ g1count(3) = 0
+ g2count(1) = 0
+ g2count(2) = 0
+ g2count(3) = 0
+
+ call s1 (3, 4, 5)
+
+ ! All intervening code at the same depth must be executed the same
+ ! number of times.
+ if (f1count(1) /= f2count(1)) error stop 101
+ if (f1count(2) /= f2count(2)) error stop 102
+ if (f1count(3) /= f2count(3)) error stop 103
+ if (g1count(1) /= f1count(1)) error stop 104
+ if (g2count(1) /= f1count(1)) error stop 105
+ if (g1count(2) /= f1count(2)) error stop 106
+ if (g2count(2) /= f1count(2)) error stop 107
+ if (g1count(3) /= f1count(3)) error stop 108
+ if (g2count(3) /= f1count(3)) error stop 109
+
+ ! Intervening code must be executed at least as many times as the loop
+ ! that encloses it.
+ if (f1count(1) < 3) error stop 111
+ if (f1count(2) < 3 * 4) error stop 112
+
+ ! Intervening code must not be executed more times than the number
+ ! of logical iterations.
+ if (f1count(1) > 3 * 4 * 5) error stop 121
+ if (f1count(2) > 3 * 4 * 5) error stop 122
+
+ ! Check that the innermost loop body is executed exactly the number
+ ! of logical iterations expected.
+ if (f1count(3) /= 3 * 4 * 5) error stop 131
+
+contains
+
+subroutine f1 (depth, iter)
+ integer :: depth, iter
+ f1count(depth) = f1count(depth) + 1
+end subroutine
+
+subroutine f2 (depth, iter)
+ integer :: depth, iter
+ f2count(depth) = f2count(depth) + 1
+end subroutine
+
+subroutine g1 (depth, iter)
+ integer :: depth, iter
+ g1count(depth) = g1count(depth) + 1
+end subroutine
+
+subroutine g2 (depth, iter)
+ integer :: depth, iter
+ g2count(depth) = g2count(depth) + 1
+end subroutine
+
+subroutine s1 (a1, a2, a3)
+ integer :: a1, a2, a3
+ integer :: i, j, k
+
+ !$omp do collapse(3)
+ do i = 1, a1
+ block
+ call f1 (1, i)
+ end block
+ block
+ block
+ call g1 (1, i)
+ end block
+ do j = 1, a2
+ block
+ call f1 (2, j)
+ end block
+ block
+ block
+ call g1 (2, j)
+ end block
+ do k = 1, a3
+ call f1 (3, k)
+ block
+ call g1 (3, k)
+ call g2 (3, k)
+ end block
+ call f2 (3, k)
+ end do
+ block
+ call g2 (2, j)
+ end block
+ end block
+ block
+ call f2 (2, j)
+ end block
+ end do
+ block
+ call g2 (1, i)
+ end block
+ end block
+ block
+ call f2 (1, i)
+ end block
+ end do
+
+end subroutine
+
+end program
diff --git a/libgomp/testsuite/libgomp.fortran/target-imperfect-transform-1.f90 b/libgomp/testsuite/libgomp.fortran/target-imperfect-transform-1.f90
new file mode 100644
index 00000000000..34b6e075e05
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/target-imperfect-transform-1.f90
@@ -0,0 +1,73 @@
+! { dg-do run }
+
+! Like imperfect-transform.f90, but enables offloading.
+
+program foo
+ integer, save :: f1count(3), f2count(3)
+ !$omp declare target enter (f1count, f2count)
+
+ f1count(1) = 0
+ f1count(2) = 0
+ f1count(3) = 0
+ f2count(1) = 0
+ f2count(2) = 0
+ f2count(3) = 0
+
+ call s1 (3, 4, 5)
+
+ ! All intervening code at the same depth must be executed the same
+ ! number of times.
+ if (f1count(1) /= f2count(1)) error stop 101
+ if (f1count(2) /= f2count(2)) error stop 102
+ if (f1count(3) /= f2count(3)) error stop 103
+
+ ! Intervening code must be executed at least as many times as the loop
+ ! that encloses it.
+ if (f1count(1) < 3) error stop 111
+ if (f1count(2) < 3 * 4) error stop 112
+
+ ! Intervening code must not be executed more times than the number
+ ! of logical iterations.
+ if (f1count(1) > 3 * 4 * 5) error stop 121
+ if (f1count(2) > 3 * 4 * 5) error stop 122
+
+ ! Check that the innermost loop body is executed exactly the number
+ ! of logical iterations expected.
+ if (f1count(3) /= 3 * 4 * 5) error stop 131
+
+contains
+
+subroutine f1 (depth, iter)
+ integer :: depth, iter
+ !$omp atomic
+ f1count(depth) = f1count(depth) + 1
+end subroutine
+
+subroutine f2 (depth, iter)
+ integer :: depth, iter
+ !$omp atomic
+ f2count(depth) = f2count(depth) + 1
+end subroutine
+
+subroutine s1 (a1, a2, a3)
+ integer :: a1, a2, a3
+ integer :: i, j, k
+
+ !$omp target parallel do collapse(3) map(always, tofrom:f1count, f2count)
+ do i = 1, a1
+ call f1 (1, i)
+ do j = 1, a2
+ call f1 (2, j)
+ !$omp unroll partial
+ do k = 1, a3
+ call f1 (3, k)
+ call f2 (3, k)
+ end do
+ call f2 (2, j)
+ end do
+ call f2 (1, i)
+ end do
+
+end subroutine
+
+end program
diff --git a/libgomp/testsuite/libgomp.fortran/target-imperfect-transform-2.f90 b/libgomp/testsuite/libgomp.fortran/target-imperfect-transform-2.f90
new file mode 100644
index 00000000000..188cca1e5b4
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/target-imperfect-transform-2.f90
@@ -0,0 +1,73 @@
+! { dg-do run }
+
+! Like imperfect-transform.f90, but enables offloading.
+
+program foo
+ integer, save :: f1count(3), f2count(3)
+ !$omp declare target enter (f1count, f2count)
+
+ f1count(1) = 0
+ f1count(2) = 0
+ f1count(3) = 0
+ f2count(1) = 0
+ f2count(2) = 0
+ f2count(3) = 0
+
+ call s1 (3, 4, 5)
+
+ ! All intervening code at the same depth must be executed the same
+ ! number of times.
+ if (f1count(1) /= f2count(1)) error stop 101
+ if (f1count(2) /= f2count(2)) error stop 102
+ if (f1count(3) /= f2count(3)) error stop 103
+
+ ! Intervening code must be executed at least as many times as the loop
+ ! that encloses it.
+ if (f1count(1) < 3) error stop 111
+ if (f1count(2) < 3 * 4) error stop 112
+
+ ! Intervening code must not be executed more times than the number
+ ! of logical iterations.
+ if (f1count(1) > 3 * 4 * 5) error stop 121
+ if (f1count(2) > 3 * 4 * 5) error stop 122
+
+ ! Check that the innermost loop body is executed exactly the number
+ ! of logical iterations expected.
+ if (f1count(3) /= 3 * 4 * 5) error stop 131
+
+contains
+
+subroutine f1 (depth, iter)
+ integer :: depth, iter
+ !$omp atomic
+ f1count(depth) = f1count(depth) + 1
+end subroutine
+
+subroutine f2 (depth, iter)
+ integer :: depth, iter
+ !$omp atomic
+ f2count(depth) = f2count(depth) + 1
+end subroutine
+
+subroutine s1 (a1, a2, a3)
+ integer :: a1, a2, a3
+ integer :: i, j, k
+
+ !$omp target parallel do collapse(3) map(always, tofrom:f1count, f2count)
+ do i = 1, a1
+ call f1 (1, i)
+ do j = 1, a2
+ call f1 (2, j)
+ !$omp tile sizes(5)
+ do k = 1, a3
+ call f1 (3, k)
+ call f2 (3, k)
+ end do
+ call f2 (2, j)
+ end do
+ call f2 (1, i)
+ end do
+
+end subroutine
+
+end program
diff --git a/libgomp/testsuite/libgomp.fortran/target-imperfect1.f90 b/libgomp/testsuite/libgomp.fortran/target-imperfect1.f90
new file mode 100644
index 00000000000..608eee7e424
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/target-imperfect1.f90
@@ -0,0 +1,72 @@
+! { dg-do run }
+
+! Like imperfect1.f90, but enables offloading.
+
+program foo
+ integer, save :: f1count(3), f2count(3)
+ !$omp declare target enter (f1count, f2count)
+
+ f1count(1) = 0
+ f1count(2) = 0
+ f1count(3) = 0
+ f2count(1) = 0
+ f2count(2) = 0
+ f2count(3) = 0
+
+ call s1 (3, 4, 5)
+
+ ! All intervening code at the same depth must be executed the same
+ ! number of times.
+ if (f1count(1) /= f2count(1)) error stop 101
+ if (f1count(2) /= f2count(2)) error stop 102
+ if (f1count(3) /= f2count(3)) error stop 103
+
+ ! Intervening code must be executed at least as many times as the loop
+ ! that encloses it.
+ if (f1count(1) < 3) error stop 111
+ if (f1count(2) < 3 * 4) error stop 112
+
+ ! Intervening code must not be executed more times than the number
+ ! of logical iterations.
+ if (f1count(1) > 3 * 4 * 5) error stop 121
+ if (f1count(2) > 3 * 4 * 5) error stop 122
+
+ ! Check that the innermost loop body is executed exactly the number
+ ! of logical iterations expected.
+ if (f1count(3) /= 3 * 4 * 5) error stop 131
+
+contains
+
+subroutine f1 (depth, iter)
+ integer :: depth, iter
+ !$omp atomic
+ f1count(depth) = f1count(depth) + 1
+end subroutine
+
+subroutine f2 (depth, iter)
+ integer :: depth, iter
+ !$omp atomic
+ f2count(depth) = f2count(depth) + 1
+end subroutine
+
+subroutine s1 (a1, a2, a3)
+ integer :: a1, a2, a3
+ integer :: i, j, k
+
+ !$omp target parallel do collapse(3) map(always, tofrom:f1count, f2count)
+ do i = 1, a1
+ call f1 (1, i)
+ do j = 1, a2
+ call f1 (2, j)
+ do k = 1, a3
+ call f1 (3, k)
+ call f2 (3, k)
+ end do
+ call f2 (2, j)
+ end do
+ call f2 (1, i)
+ end do
+
+end subroutine
+
+end program
diff --git a/libgomp/testsuite/libgomp.fortran/target-imperfect2.f90 b/libgomp/testsuite/libgomp.fortran/target-imperfect2.f90
new file mode 100644
index 00000000000..982661c278a
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/target-imperfect2.f90
@@ -0,0 +1,110 @@
+! { dg-do run }
+
+! Like imperfect2.f90, but enables offloading.
+
+program foo
+ integer, save :: f1count(3), f2count(3), g1count(3), g2count(3)
+ !$omp declare target enter (f1count, f2count)
+ !$omp declare target enter (g1count, g2count)
+
+ f1count(1) = 0
+ f1count(2) = 0
+ f1count(3) = 0
+ f2count(1) = 0
+ f2count(2) = 0
+ f2count(3) = 0
+
+ g1count(1) = 0
+ g1count(2) = 0
+ g1count(3) = 0
+ g2count(1) = 0
+ g2count(2) = 0
+ g2count(3) = 0
+
+ call s1 (3, 4, 5)
+
+ ! All intervening code at the same depth must be executed the same
+ ! number of times.
+ if (f1count(1) /= f2count(1)) error stop 101
+ if (f1count(2) /= f2count(2)) error stop 102
+ if (f1count(3) /= f2count(3)) error stop 103
+ if (g1count(1) /= f1count(1)) error stop 104
+ if (g2count(1) /= f1count(1)) error stop 105
+ if (g1count(2) /= f1count(2)) error stop 106
+ if (g2count(2) /= f1count(2)) error stop 107
+ if (g1count(3) /= f1count(3)) error stop 108
+ if (g2count(3) /= f1count(3)) error stop 109
+
+ ! Intervening code must be executed at least as many times as the loop
+ ! that encloses it.
+ if (f1count(1) < 3) error stop 111
+ if (f1count(2) < 3 * 4) error stop 112
+
+ ! Intervening code must not be executed more times than the number
+ ! of logical iterations.
+ if (f1count(1) > 3 * 4 * 5) error stop 121
+ if (f1count(2) > 3 * 4 * 5) error stop 122
+
+ ! Check that the innermost loop body is executed exactly the number
+ ! of logical iterations expected.
+ if (f1count(3) /= 3 * 4 * 5) error stop 131
+
+contains
+
+subroutine f1 (depth, iter)
+ integer :: depth, iter
+ !$omp atomic
+ f1count(depth) = f1count(depth) + 1
+end subroutine
+
+subroutine f2 (depth, iter)
+ integer :: depth, iter
+ !$omp atomic
+ f2count(depth) = f2count(depth) + 1
+end subroutine
+
+subroutine g1 (depth, iter)
+ integer :: depth, iter
+ !$omp atomic
+ g1count(depth) = g1count(depth) + 1
+end subroutine
+
+subroutine g2 (depth, iter)
+ integer :: depth, iter
+ !$omp atomic
+ g2count(depth) = g2count(depth) + 1
+end subroutine
+
+subroutine s1 (a1, a2, a3)
+ integer :: a1, a2, a3
+ integer :: i, j, k
+
+ !$omp target parallel do collapse(3) map(always, tofrom:f1count, f2count, g1count, g2count)
+ do i = 1, a1
+ call f1 (1, i)
+ block
+ call g1 (1, i)
+ do j = 1, a2
+ call f1 (2, j)
+ block
+ call g1 (2, j)
+ do k = 1, a3
+ call f1 (3, k)
+ block
+ call g1 (3, k)
+ call g2 (3, k)
+ end block
+ call f2 (3, k)
+ end do
+ call g2 (2, j)
+ end block
+ call f2 (2, j)
+ end do
+ call g2 (1, i)
+ end block
+ call f2 (1, i)
+ end do
+
+end subroutine
+
+end program
diff --git a/libgomp/testsuite/libgomp.fortran/target-imperfect3.f90 b/libgomp/testsuite/libgomp.fortran/target-imperfect3.f90
new file mode 100644
index 00000000000..6f4f92d6f3f
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/target-imperfect3.f90
@@ -0,0 +1,116 @@
+! { dg-do run }
+
+! Like imperfect3.f90, but enables offloading.
+
+program foo
+ integer, save :: f1count(3), f2count(3), g1count(3), g2count(3)
+ !$omp declare target enter (f1count, f2count)
+ !$omp declare target enter (g1count, g2count)
+
+ f1count(1) = 0
+ f1count(2) = 0
+ f1count(3) = 0
+ f2count(1) = 0
+ f2count(2) = 0
+ f2count(3) = 0
+
+ g1count(1) = 0
+ g1count(2) = 0
+ g1count(3) = 0
+ g2count(1) = 0
+ g2count(2) = 0
+ g2count(3) = 0
+
+ call s1 (3, 4, 5)
+
+ ! All intervening code at the same depth must be executed the same
+ ! number of times.
+ if (f1count(1) /= f2count(1)) error stop 101
+ if (f1count(2) /= f2count(2)) error stop 102
+ if (f1count(3) /= f2count(3)) error stop 103
+ if (g1count(1) /= f1count(1)) error stop 104
+ if (g2count(1) /= f1count(1)) error stop 105
+ if (g1count(2) /= f1count(2)) error stop 106
+ if (g2count(2) /= f1count(2)) error stop 107
+ if (g1count(3) /= f1count(3)) error stop 108
+ if (g2count(3) /= f1count(3)) error stop 109
+
+ ! Intervening code must be executed at least as many times as the loop
+ ! that encloses it.
+ if (f1count(1) < 3) error stop 111
+ if (f1count(2) < 3 * 4) error stop 112
+
+ ! Intervening code must not be executed more times than the number
+ ! of logical iterations.
+ if (f1count(1) > 3 * 4 * 5) error stop 121
+ if (f1count(2) > 3 * 4 * 5) error stop 122
+
+ ! Check that the innermost loop body is executed exactly the number
+ ! of logical iterations expected.
+ if (f1count(3) /= 3 * 4 * 5) error stop 131
+
+contains
+
+subroutine f1 (depth, iter)
+ integer :: depth, iter
+ !$omp atomic
+ f1count(depth) = f1count(depth) + 1
+end subroutine
+
+subroutine f2 (depth, iter)
+ integer :: depth, iter
+ !$omp atomic
+ f2count(depth) = f2count(depth) + 1
+end subroutine
+
+subroutine g1 (depth, iter)
+ integer :: depth, iter
+ !$omp atomic
+ g1count(depth) = g1count(depth) + 1
+end subroutine
+
+subroutine g2 (depth, iter)
+ integer :: depth, iter
+ !$omp atomic
+ g2count(depth) = g2count(depth) + 1
+end subroutine
+
+subroutine s1 (a1, a2, a3)
+ integer :: a1, a2, a3
+ integer :: i, j, k
+
+ !$omp target parallel do collapse(3) map(always, tofrom:f1count, f2count, g1count, g2count)
+ do i = 1, a1
+ call f1 (1, i)
+ block
+ integer :: local1
+ local1 = 1
+ call g1 (local1, i)
+ do j = 1, a2
+ call f1 (2, j)
+ block
+ integer :: local2
+ local2 = 2
+ call g1 (local2, j)
+ do k = 1, a3
+ call f1 (3, k)
+ block
+ integer :: local3
+ local3 = 3
+ call g1 (local3, k)
+ call g2 (local3, k)
+ end block
+ call f2 (3, k)
+ end do
+ call g2 (local2, j)
+ end block
+ call f2 (2, j)
+ end do
+ call g2 (local1, i)
+ end block
+ call f2 (1, i)
+ end do
+
+end subroutine
+
+end program
diff --git a/libgomp/testsuite/libgomp.fortran/target-imperfect4.f90 b/libgomp/testsuite/libgomp.fortran/target-imperfect4.f90
new file mode 100644
index 00000000000..59ec0e92b05
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/target-imperfect4.f90
@@ -0,0 +1,126 @@
+! { dg-do run }
+
+! Like imperfect4.f90, but enables offloading.
+
+program foo
+ integer, save :: f1count(3), f2count(3), g1count(3), g2count(3)
+ !$omp declare target enter (f1count, f2count)
+ !$omp declare target enter (g1count, g2count)
+
+ f1count(1) = 0
+ f1count(2) = 0
+ f1count(3) = 0
+ f2count(1) = 0
+ f2count(2) = 0
+ f2count(3) = 0
+
+ g1count(1) = 0
+ g1count(2) = 0
+ g1count(3) = 0
+ g2count(1) = 0
+ g2count(2) = 0
+ g2count(3) = 0
+
+ call s1 (3, 4, 5)
+
+ ! All intervening code at the same depth must be executed the same
+ ! number of times.
+ if (f1count(1) /= f2count(1)) error stop 101
+ if (f1count(2) /= f2count(2)) error stop 102
+ if (f1count(3) /= f2count(3)) error stop 103
+ if (g1count(1) /= f1count(1)) error stop 104
+ if (g2count(1) /= f1count(1)) error stop 105
+ if (g1count(2) /= f1count(2)) error stop 106
+ if (g2count(2) /= f1count(2)) error stop 107
+ if (g1count(3) /= f1count(3)) error stop 108
+ if (g2count(3) /= f1count(3)) error stop 109
+
+ ! Intervening code must be executed at least as many times as the loop
+ ! that encloses it.
+ if (f1count(1) < 3) error stop 111
+ if (f1count(2) < 3 * 4) error stop 112
+
+ ! Intervening code must not be executed more times than the number
+ ! of logical iterations.
+ if (f1count(1) > 3 * 4 * 5) error stop 121
+ if (f1count(2) > 3 * 4 * 5) error stop 122
+
+ ! Check that the innermost loop body is executed exactly the number
+ ! of logical iterations expected.
+ if (f1count(3) /= 3 * 4 * 5) error stop 131
+
+contains
+
+subroutine f1 (depth, iter)
+ integer :: depth, iter
+ !$omp atomic
+ f1count(depth) = f1count(depth) + 1
+end subroutine
+
+subroutine f2 (depth, iter)
+ integer :: depth, iter
+ !$omp atomic
+ f2count(depth) = f2count(depth) + 1
+end subroutine
+
+subroutine g1 (depth, iter)
+ integer :: depth, iter
+ !$omp atomic
+ g1count(depth) = g1count(depth) + 1
+end subroutine
+
+subroutine g2 (depth, iter)
+ integer :: depth, iter
+ !$omp atomic
+ g2count(depth) = g2count(depth) + 1
+end subroutine
+
+subroutine s1 (a1, a2, a3)
+ integer :: a1, a2, a3
+ integer :: i, j, k
+
+ !$omp target parallel do collapse(3) map(always, tofrom:f1count, f2count, g1count, g2count)
+ do i = 1, a1
+ block
+ call f1 (1, i)
+ end block
+ block
+ block
+ call g1 (1, i)
+ end block
+ do j = 1, a2
+ block
+ call f1 (2, j)
+ end block
+ block
+ block
+ call g1 (2, j)
+ end block
+ do k = 1, a3
+ call f1 (3, k)
+ block
+ call g1 (3, k)
+ call g2 (3, k)
+ end block
+ call f2 (3, k)
+ end do
+ block
+ call g2 (2, j)
+ end block
+ end block
+ block
+ call f2 (2, j)
+ end block
+ end do
+ block
+ call g2 (1, i)
+ end block
+ end block
+ block
+ call f2 (1, i)
+ end block
+ end do
+
+end subroutine
+
+end program
--
2.31.1
^ permalink raw reply [flat|nested] 7+ messages in thread