Hi all,
this patch add support for "strictly-structured blocks" introduced in OpenMP
5.1,
basically allowing BLOCK constructs to serve as the body for directives:
!$omp target
block
...
end block
[!$omp end target] !! end directive is optional
!$omp parallel
block
...
end block
...
!$omp end parallel !! error, considered as not match to above parallel
directive
The parsing loop in parse_omp_structured_block() has been modified to allow
a BLOCK construct after the first statement has been detected to be ST_BLOCK.
This is done by a hard modification of the state into (the new)
COMP_OMP_STRICTLY_STRUCTURED_BLOCK
after the statement is known (I'm not sure if there's a way to 'peek' the next
statement/token in the Fortran FE, open to suggestions on how to better write
this)
Tested with no regressions on trunk, is this okay to commit?
Thanks,
Chung-Lin
2021-10-07 Chung-Lin Tang <[email protected]>
gcc/fortran/ChangeLog:
* decl.c (gfc_match_end): Add COMP_OMP_STRICTLY_STRUCTURED_BLOCK case
together with COMP_BLOCK.
* parse.c (parse_omp_structured_block): Adjust declaration, add
'bool strictly_structured_block' default true parameter, add handling
for strictly-structured block case, adjust recursive calls to
parse_omp_structured_block.
(parse_executable): Adjust calls to parse_omp_structured_block.
* parse.h (enum gfc_compile_state): Add
COMP_OMP_STRICTLY_STRUCTURED_BLOCK.
* trans-openmp.c (gfc_trans_omp_workshare): Add EXEC_BLOCK case
handling.
gcc/testsuite/ChangeLog:
* gfortran.dg/gomp/strictly-structured-block-1.f90: New test.
diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index b3c65b7175b..ff66d1f9475 100644
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -8445,6 +8445,7 @@ gfc_match_end (gfc_statement *st)
break;
case COMP_BLOCK:
+ case COMP_OMP_STRICTLY_STRUCTURED_BLOCK:
*st = ST_END_BLOCK;
target = " block";
eos_ok = 0;
diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
index 7d765a0866d..d78bf9b8fa5 100644
--- a/gcc/fortran/parse.c
+++ b/gcc/fortran/parse.c
@@ -5451,8 +5451,9 @@ parse_oacc_loop (gfc_statement acc_st)
/* Parse the statements of an OpenMP structured block. */
-static void
-parse_omp_structured_block (gfc_statement omp_st, bool workshare_stmts_only)
+static gfc_statement
+parse_omp_structured_block (gfc_statement omp_st, bool workshare_stmts_only,
+ bool strictly_structured_block = true)
{
gfc_statement st, omp_end_st;
gfc_code *cp, *np;
@@ -5538,6 +5539,32 @@ parse_omp_structured_block (gfc_statement omp_st, bool
workshare_stmts_only)
gcc_unreachable ();
}
+ bool block_construct = false;
+ gfc_namespace* my_ns = NULL;
+ gfc_namespace* my_parent = NULL;
+
+ st = next_statement ();
+
+ if (strictly_structured_block && st == ST_BLOCK)
+ {
+ /* Adjust state to a strictly-structured block, now that we found that
+ the body starts with a BLOCK construct. */
+ s.state = COMP_OMP_STRICTLY_STRUCTURED_BLOCK;
+
+ block_construct = true;
+ gfc_notify_std (GFC_STD_F2008, "BLOCK construct at %C");
+
+ my_ns = gfc_build_block_ns (gfc_current_ns);
+ gfc_current_ns = my_ns;
+ my_parent = my_ns->parent;
+
+ new_st.op = EXEC_BLOCK;
+ new_st.ext.block.ns = my_ns;
+ new_st.ext.block.assoc = NULL;
+ accept_statement (ST_BLOCK);
+ st = parse_spec (ST_NONE);
+ }
+
do
{
if (workshare_stmts_only)
@@ -5554,7 +5581,6 @@ parse_omp_structured_block (gfc_statement omp_st, bool
workshare_stmts_only)
restrictions apply recursively. */
bool cycle = true;
- st = next_statement ();
for (;;)
{
switch (st)
@@ -5576,17 +5602,20 @@ parse_omp_structured_block (gfc_statement omp_st, bool
workshare_stmts_only)
parse_forall_block ();
break;
+ case ST_OMP_PARALLEL_SECTIONS:
+ st = parse_omp_structured_block (st, false, false);
+ continue;
+
case ST_OMP_PARALLEL:
case ST_OMP_PARALLEL_MASKED:
case ST_OMP_PARALLEL_MASTER:
- case ST_OMP_PARALLEL_SECTIONS:
- parse_omp_structured_block (st, false);
- break;
+ st = parse_omp_structured_block (st, false);
+ continue;
case ST_OMP_PARALLEL_WORKSHARE:
case ST_OMP_CRITICAL:
- parse_omp_structured_block (st, true);
- break;
+ st = parse_omp_structured_block (st, true);
+ continue;
case ST_OMP_PARALLEL_DO:
case ST_OMP_PARALLEL_DO_SIMD:
@@ -5609,7 +5638,7 @@ parse_omp_structured_block (gfc_statement omp_st, bool
workshare_stmts_only)
}
}
else
- st = parse_executable (ST_NONE);
+ st = parse_executable (st);
if (st == ST_NONE)
unexpected_eof ();
else if (st == ST_OMP_SECTION
@@ -5619,9 +5648,27 @@ parse_omp_structured_block (gfc_statement omp_st, bool
workshare_stmts_only)
np = new_level (np);
np->op = cp->op;
np->block = NULL;
+ st = next_statement ();
+ }
+ else if (block_construct && st == ST_END_BLOCK)
+ {
+ accept_statement (st);
+ gfc_current_ns = my_parent;
+ pop_state ();
+
+ st = next_statement ();
+ if (st == omp_end_st)
+ {
+ accept_statement (st);
+ st = next_statement ();
+ }
+ return st;
}
else if (st != omp_end_st)
- unexpected_statement (st);
+ {
+ unexpected_statement (st);
+ st = next_statement ();
+ }
}
while (st != omp_end_st);
@@ -5657,6 +5704,8 @@ parse_omp_structured_block (gfc_statement omp_st, bool
workshare_stmts_only)
gfc_commit_symbols ();
gfc_warning_check ();
pop_state ();
+ st = next_statement ();
+ return st;
}
@@ -5779,16 +5828,19 @@ parse_executable (gfc_statement st)
parse_oacc_structured_block (st);
break;
+ case ST_OMP_PARALLEL_SECTIONS:
+ case ST_OMP_SECTIONS:
+ st = parse_omp_structured_block (st, false, false);
+ continue;
+
case ST_OMP_PARALLEL:
case ST_OMP_PARALLEL_MASKED:
case ST_OMP_PARALLEL_MASTER:
- case ST_OMP_PARALLEL_SECTIONS:
case ST_OMP_ORDERED:
case ST_OMP_CRITICAL:
case ST_OMP_MASKED:
case ST_OMP_MASTER:
case ST_OMP_SCOPE:
- case ST_OMP_SECTIONS:
case ST_OMP_SINGLE:
case ST_OMP_TARGET:
case ST_OMP_TARGET_DATA:
@@ -5797,13 +5849,13 @@ parse_executable (gfc_statement st)
case ST_OMP_TEAMS:
case ST_OMP_TASK:
case ST_OMP_TASKGROUP:
- parse_omp_structured_block (st, false);
- break;
+ st = parse_omp_structured_block (st, false);
+ continue;
case ST_OMP_WORKSHARE:
case ST_OMP_PARALLEL_WORKSHARE:
- parse_omp_structured_block (st, true);
- break;
+ st = parse_omp_structured_block (st, true);
+ continue;
case ST_OMP_DISTRIBUTE:
case ST_OMP_DISTRIBUTE_PARALLEL_DO:
diff --git a/gcc/fortran/parse.h b/gcc/fortran/parse.h
index 55f02299304..66b275de89b 100644
--- a/gcc/fortran/parse.h
+++ b/gcc/fortran/parse.h
@@ -31,7 +31,7 @@ enum gfc_compile_state
COMP_STRUCTURE, COMP_UNION, COMP_MAP,
COMP_DO, COMP_SELECT, COMP_FORALL, COMP_WHERE, COMP_CONTAINS, COMP_ENUM,
COMP_SELECT_TYPE, COMP_SELECT_RANK, COMP_OMP_STRUCTURED_BLOCK, COMP_CRITICAL,
- COMP_DO_CONCURRENT
+ COMP_DO_CONCURRENT, COMP_OMP_STRICTLY_STRUCTURED_BLOCK
};
/* Stack element for the current compilation state. These structures
diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c
index d234d1b070f..9fdea8c67fd 100644
--- a/gcc/fortran/trans-openmp.c
+++ b/gcc/fortran/trans-openmp.c
@@ -6993,7 +6993,11 @@ gfc_trans_omp_workshare (gfc_code *code, gfc_omp_clauses
*clauses)
res = gfc_trans_omp_directive (code);
ompws_flags = saved_ompws_flags;
break;
-
+
+ case EXEC_BLOCK:
+ res = gfc_trans_block_construct (code);
+ break;
+
default:
gfc_internal_error ("gfc_trans_omp_workshare(): Bad statement code");
}
diff --git a/gcc/testsuite/gfortran.dg/gomp/strictly-structured-block-1.f90
b/gcc/testsuite/gfortran.dg/gomp/strictly-structured-block-1.f90
new file mode 100644
index 00000000000..bc798c1c218
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/strictly-structured-block-1.f90
@@ -0,0 +1,295 @@
+! { dg-do compile }
+! { dg-options "-fopenmp" }
+
+program main
+ integer :: x
+
+ !$omp parallel
+ block
+ x = x + 1
+ end block
+
+ !$omp parallel
+ block
+ x = x + 1
+ end block
+ !$omp end parallel
+
+ !$omp parallel
+ block
+ x = x + 1
+ end block
+ x = x + 1
+ !$omp end parallel ! { dg-error "Unexpected !.OMP END PARALLEL statement" }
+
+ !$omp teams
+ block
+ x = x + 1
+ end block
+
+ !$omp teams
+ block
+ x = x + 1
+ end block
+ !$omp end teams
+
+ !$omp teams
+ block
+ x = x + 1
+ end block
+ x = x + 1
+ !$omp end teams ! { dg-error "Unexpected !.OMP END TEAMS statement" }
+
+ !$omp masked
+ block
+ x = x + 1
+ end block
+
+ !$omp masked
+ block
+ x = x + 1
+ end block
+ !$omp end masked
+
+ !$omp masked
+ block
+ x = x + 1
+ end block
+ x = x + 1
+ !$omp end masked ! { dg-error "Unexpected !.OMP END MASKED statement" }
+
+ !$omp scope
+ block
+ x = x + 1
+ end block
+
+ !$omp scope
+ block
+ x = x + 1
+ end block
+ !$omp end scope
+
+ !$omp scope
+ block
+ x = x + 1
+ end block
+ x = x + 1
+ !$omp end scope ! { dg-error "Unexpected !.OMP END SCOPE statement" }
+
+ !$omp single
+ block
+ x = x + 1
+ end block
+
+ !$omp single
+ block
+ x = x + 1
+ end block
+ !$omp end single
+
+ !$omp single
+ block
+ x = x + 1
+ end block
+ x = x + 1
+ !$omp end single ! { dg-error "Unexpected !.OMP END SINGLE statement" }
+
+ !$omp workshare
+ block
+ x = x + 1
+ end block
+
+ !$omp workshare
+ block
+ x = x + 1
+ end block
+ !$omp end workshare
+
+ !$omp workshare
+ block
+ x = x + 1
+ end block
+ x = x + 1
+ !$omp end workshare ! { dg-error "Unexpected !.OMP END WORKSHARE statement" }
+
+ !$omp task
+ block
+ x = x + 1
+ end block
+
+ !$omp task
+ block
+ x = x + 1
+ end block
+ !$omp end task
+
+ !$omp task
+ block
+ x = x + 1
+ end block
+ x = x + 1
+ !$omp end task ! { dg-error "Unexpected !.OMP END TASK statement" }
+
+ !$omp target data map(x)
+ block
+ x = x + 1
+ end block
+
+ !$omp target data map(x)
+ block
+ x = x + 1
+ end block
+ !$omp end target data
+
+ !$omp target data map(x)
+ block
+ x = x + 1
+ end block
+ x = x + 1
+ !$omp end target data ! { dg-error "Unexpected !.OMP END TARGET DATA
statement" }
+
+ !$omp target
+ block
+ x = x + 1
+ end block
+
+ !$omp target
+ block
+ x = x + 1
+ end block
+ !$omp end target
+
+ !$omp target
+ block
+ x = x + 1
+ end block
+ x = x + 1
+ !$omp end target ! { dg-error "Unexpected !.OMP END TARGET statement" }
+
+ !$omp parallel workshare
+ block
+ x = x + 1
+ end block
+
+ !$omp parallel workshare
+ block
+ x = x + 1
+ end block
+ !$omp end parallel workshare
+
+ !$omp parallel workshare
+ block
+ x = x + 1
+ end block
+ x = x + 1
+ !$omp end parallel workshare ! { dg-error "Unexpected !.OMP END PARALLEL
WORKSHARE statement" }
+
+ !$omp parallel masked
+ block
+ x = x + 1
+ end block
+
+ !$omp parallel masked
+ block
+ x = x + 1
+ end block
+ !$omp end parallel masked
+
+ !$omp parallel masked
+ block
+ x = x + 1
+ end block
+ x = x + 1
+ !$omp end parallel masked ! { dg-error "Unexpected !.OMP END PARALLEL MASKED
statement" }
+
+ !$omp target parallel
+ block
+ x = x + 1
+ end block
+
+ !$omp target parallel
+ block
+ x = x + 1
+ end block
+ !$omp end target parallel
+
+ !$omp target parallel
+ block
+ x = x + 1
+ end block
+ x = x + 1
+ !$omp end target parallel ! { dg-error "Unexpected !.OMP END TARGET PARALLEL
statement" }
+
+ !$omp target teams
+ block
+ x = x + 1
+ end block
+
+ !$omp target teams
+ block
+ x = x + 1
+ end block
+ !$omp end target teams
+
+ !$omp target teams
+ block
+ x = x + 1
+ end block
+ x = x + 1
+ !$omp end target teams ! { dg-error "Unexpected !.OMP END TARGET TEAMS
statement" }
+
+ !$omp critical
+ block
+ x = x + 1
+ end block
+
+ !$omp critical
+ block
+ x = x + 1
+ end block
+ !$omp end critical
+
+ !$omp critical
+ block
+ x = x + 1
+ end block
+ x = x + 1
+ !$omp end critical ! { dg-error "Unexpected !.OMP END CRITICAL statement" }
+
+ !$omp taskgroup
+ block
+ x = x + 1
+ end block
+
+ !$omp taskgroup
+ block
+ x = x + 1
+ end block
+ !$omp end taskgroup
+
+ !$omp taskgroup
+ block
+ x = x + 1
+ end block
+ x = x + 1
+ !$omp end taskgroup ! { dg-error "Unexpected !.OMP END TASKGROUP statement" }
+
+ !$omp ordered
+ block
+ x = x + 1
+ end block
+
+ !$omp ordered
+ block
+ x = x + 1
+ end block
+ !$omp end ordered
+
+ !$omp ordered
+ block
+ x = x + 1
+ end block
+ x = x + 1
+ !$omp end ordered ! { dg-error "Unexpected !.OMP END ORDERED statement" }
+
+end program
