* [Patch] Fortran/OpenMP: Fix handling of strictly structured blocks
@ 2023-10-07 15:40 Tobias Burnus
0 siblings, 0 replies; only message in thread
From: Tobias Burnus @ 2023-10-07 15:40 UTC (permalink / raw)
To: gcc-patches, fortran
[-- Attachment #1: Type: text/plain, Size: 932 bytes --]
Strictly structured blocks are '!$omp <some directive>' directly
followed by 'BLOCK ... END BLOCK', i.e. a Fortran block construct.
I did run into this issue because 'integer :: n; n = 5; !$omp ...;
block; integer :: A(n)' was not accepted.
Well, it turned out that was because the BLOCK handling was not quite right.
In an unrelated patch, I got an ICE for an empty labelled BLOCK - but
only without -fopenmp. I was not quite sure that we had a testcase for
it - my 'grep' attempt did not find one but we use plenty of BLOCK.
Hence, I added another BLOCK testcase.
Comments, remarks, suggestions?
If not, I will later commit it.
Tobias
-----------------
Siemens Electronic Design Automation GmbH; Anschrift: Arnulfstraße 201, 80634 München; Gesellschaft mit beschränkter Haftung; Geschäftsführer: Thomas Heurung, Frank Thürauf; Sitz der Gesellschaft: München; Registergericht München, HRB 106955
[-- Attachment #2: fix-omp-strict-struct-block-v4.diff --]
[-- Type: text/x-patch, Size: 6568 bytes --]
Fortran/OpenMP: Fix handling of strictly structured blocks
For strictly structured blocks, a BLOCK was created but the code
was placed after the block the outer structured block. Additionally,
labelled blocks were mishandled. As the code is now properly in a
BLOCK, it solves additional issues.
gcc/fortran/ChangeLog:
* parse.cc (parse_omp_structured_block): Make the user code end
up inside of BLOCK construct for strictly structured blocks;
fix fallout for 'section' and 'teams'.
* openmp.cc (resolve_omp_target): Fix changed BLOCK handling
for teams in target checking.
libgomp/ChangeLog:
* testsuite/libgomp.fortran/strictly-structured-block-1.f90: New test.
gcc/testsuite/ChangeLog:
* gfortran.dg/block_17.f90: New test.
* gfortran.dg/gomp/strictly-structured-block-5.f90: New test.
gcc/fortran/openmp.cc | 2 +
gcc/fortran/parse.cc | 22 +++++--
gcc/testsuite/gfortran.dg/block_17.f90 | 9 +++
.../gomp/strictly-structured-block-5.f90 | 77 ++++++++++++++++++++++
.../strictly-structured-block-1.f90 | 22 +++++++
5 files changed, 127 insertions(+), 5 deletions(-)
diff --git a/gcc/fortran/openmp.cc b/gcc/fortran/openmp.cc
index dc0c8013c3d..79b5ae0e4bd 100644
--- a/gcc/fortran/openmp.cc
+++ b/gcc/fortran/openmp.cc
@@ -11245,6 +11245,8 @@ resolve_omp_target (gfc_code *code)
if (!code->ext.omp_clauses->contains_teams_construct)
return;
gfc_code *c = code->block->next;
+ if (c->op == EXEC_BLOCK)
+ c = c->ext.block.ns->code;
if (code->ext.omp_clauses->target_first_st_is_teams
&& ((GFC_IS_TEAMS_CONSTRUCT (c->op) && c->next == NULL)
|| (c->op == EXEC_BLOCK
diff --git a/gcc/fortran/parse.cc b/gcc/fortran/parse.cc
index 58386805ffe..444baf42cbd 100644
--- a/gcc/fortran/parse.cc
+++ b/gcc/fortran/parse.cc
@@ -5814,7 +5814,7 @@ parse_omp_structured_block (gfc_statement omp_st, bool workshare_stmts_only)
{
gfc_statement st, omp_end_st, first_st;
gfc_code *cp, *np;
- gfc_state_data s;
+ gfc_state_data s, s2;
accept_statement (omp_st);
@@ -5915,13 +5915,21 @@ parse_omp_structured_block (gfc_statement omp_st, bool workshare_stmts_only)
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);
+
+ push_state (&s2, COMP_BLOCK, my_ns->proc_name);
+ gfc_current_ns = my_ns;
+ my_parent = my_ns->parent;
+ if (omp_st == ST_OMP_SECTIONS
+ || omp_st == ST_OMP_PARALLEL_SECTIONS)
+ {
+ np = new_level (cp);
+ np->op = cp->op;
+ }
+
first_st = next_statement ();
st = parse_spec (first_st);
}
@@ -5937,6 +5945,8 @@ parse_omp_structured_block (gfc_statement omp_st, bool workshare_stmts_only)
case ST_OMP_TEAMS_LOOP:
{
gfc_state_data *stk = gfc_state_stack->previous;
+ if (stk->state == COMP_OMP_STRICTLY_STRUCTURED_BLOCK)
+ stk = stk->previous;
stk->tail->ext.omp_clauses->target_first_st_is_teams = true;
break;
}
@@ -6035,8 +6045,10 @@ parse_omp_structured_block (gfc_statement omp_st, bool workshare_stmts_only)
else if (block_construct && st == ST_END_BLOCK)
{
accept_statement (st);
+ gfc_current_ns->code = gfc_state_stack->head;
gfc_current_ns = my_parent;
- pop_state ();
+ pop_state (); /* Inner BLOCK */
+ pop_state (); /* Outer COMP_OMP_STRICTLY_STRUCTURED_BLOCK */
st = next_statement ();
if (st == omp_end_st)
diff --git a/gcc/testsuite/gfortran.dg/block_17.f90 b/gcc/testsuite/gfortran.dg/block_17.f90
new file mode 100644
index 00000000000..6ab3106ebd0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/block_17.f90
@@ -0,0 +1,9 @@
+subroutine foo()
+ block
+ end block
+end
+
+subroutine bar()
+ my_name: block
+ end block my_name
+end
diff --git a/gcc/testsuite/gfortran.dg/gomp/strictly-structured-block-5.f90 b/gcc/testsuite/gfortran.dg/gomp/strictly-structured-block-5.f90
new file mode 100644
index 00000000000..79cb9207180
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/strictly-structured-block-5.f90
@@ -0,0 +1,77 @@
+subroutine f()
+ !$omp parallel
+ block
+ end block
+
+ !$omp parallel
+ block
+ inner: block
+ block
+ end block
+ end block inner
+ end block
+end
+
+subroutine f2()
+ !$omp parallel
+ my_name : block
+ end block my_name
+
+ !$omp parallel
+ another_block : block
+ inner: block
+ block
+ end block
+ end block inner
+ end block another_block
+end
+
+subroutine f3()
+ !$omp parallel
+ my_name : block
+ end block my_name2 ! { dg-error "Expected label 'my_name' for END BLOCK statement" }
+ end block my_name ! avoid follow up errors
+end subroutine
+
+subroutine f4
+ integer :: n
+ n = 5
+ !$omp parallel
+ my: block
+ integer :: A(n)
+ A(1) = 1
+ end block my
+end
+
+subroutine f4a
+ intrinsic :: sin
+ !$omp parallel
+ block
+ procedure(), pointer :: proc
+ procedure(sin) :: my_sin
+ proc => sin
+ end block
+end subroutine
+
+subroutine f5(x)
+ !$omp parallel
+ block
+ intent(in) :: x ! { dg-error "INTENT is not allowed inside of BLOCK" }
+ optional :: x ! { dg-error "OPTIONAL is not allowed inside of BLOCK" }
+ value :: x ! { dg-error "VALUE is not allowed inside of BLOCK" }
+ end block
+end
+
+subroutine f6()
+ !$omp parallel
+ myblock: block
+ cycle myblock ! { dg-error "CYCLE statement at .1. is not applicable to non-loop construct 'myblock'" }
+ end block myblock
+
+ !$omp parallel
+ myblock2: block
+ exit myblock2 ! OK.
+ ! jumps to the end of the block but stays in the structured block
+ end block myblock2
+ !$omp end parallel
+end
diff --git a/libgomp/testsuite/libgomp.fortran/strictly-structured-block-1.f90 b/libgomp/testsuite/libgomp.fortran/strictly-structured-block-1.f90
new file mode 100644
index 00000000000..8e7f6c8b9d3
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/strictly-structured-block-1.f90
@@ -0,0 +1,22 @@
+subroutine one
+ implicit none (external, type)
+ integer :: i, j
+ i = 5
+ j = 6
+ !$omp parallel
+ my_block : block
+ !$omp atomic write
+ i = 7
+ exit my_block
+
+ !$omp atomic write
+ j = 99 ! Should be unreachable
+
+ ! exit should jump here - end of block but inside of it.
+ end block my_block
+ if (i /= 7) stop 1
+ if (j /= 6) stop 2
+end
+
+ call one
+end
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2023-10-07 15:40 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2023-10-07 15:40 [Patch] Fortran/OpenMP: Fix handling of strictly structured blocks Tobias Burnus
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).