On 2021/10/21 12:15 AM, Jakub Jelinek wrote:
+program main
+ integer :: x, i, n
+
+ !$omp parallel
+ block
+ x = x + 1
+ end block
I'd prefer not to use those x = j or x = x + 1 etc.
as statements that do random work here whenever possible.
While those are dg-do compile testcases, especially if
it is without dg-errors I think it is preferrable not to show
bad coding examples.
E.g. the x = x + 1 above is wrong for 2 reasons, x is uninitialized
before the parallel, and there is a data race, the threads, teams etc.
can write to x concurrently.
I think better would be to use something like
call do_work
which doesn't have to be defined anywhere and will just stand there
as a black box for unspecified work.
+ !$omp workshare
+ block
+ x = x + 1
+ end block
There are exceptions though, e.g. workshare is such a case, because
e.g. call do_work is not valid in workshare.
So, it is ok to keep using x = x + 1 here if you initialize it
first at the start of the program.
+ !$omp workshare
+ block
+ x = 1
+ !$omp critical
+ block
+ x = 3
+ end block
+ end block
And then there are cases like the above, please
just use different variables there (all initialized) or
say an array and access different elements in the different spots.
Jakub
Thanks, attached is what I finally committed.
Chung-Lin
From 2e4659199e814b7ee0f6bd925fd2c0a7610da856 Mon Sep 17 00:00:00 2001
From: Chung-Lin Tang <clt...@codesourcery.com>
Date: Thu, 21 Oct 2021 14:56:20 +0800
Subject: [PATCH] openmp: Fortran strictly-structured blocks support
This implements strictly-structured blocks support for Fortran, as specified in
OpenMP 5.2. This now allows using a Fortran BLOCK construct as the body of most
OpenMP constructs, with a "!$omp end ..." ending directive optional for that
form.
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): Change return type to
'gfc_statement', 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/cancel-1.f90: Adjust testcase.
* gfortran.dg/gomp/nesting-3.f90: Adjust testcase.
* gfortran.dg/gomp/strictly-structured-block-1.f90: New test.
* gfortran.dg/gomp/strictly-structured-block-2.f90: New test.
* gfortran.dg/gomp/strictly-structured-block-3.f90: New test.
libgomp/ChangeLog:
* libgomp.texi (Support of strictly structured blocks in Fortran):
Adjust to 'Y'.
* testsuite/libgomp.fortran/task-reduction-16.f90: Adjust testcase.
---
gcc/fortran/decl.c | 1 +
gcc/fortran/parse.c | 69 +++++-
gcc/fortran/parse.h | 2 +-
gcc/fortran/trans-openmp.c | 6 +-
gcc/testsuite/gfortran.dg/gomp/cancel-1.f90 | 3 +
gcc/testsuite/gfortran.dg/gomp/nesting-3.f90 | 20 +-
.../gomp/strictly-structured-block-1.f90 | 214 ++++++++++++++++++
.../gomp/strictly-structured-block-2.f90 | 139 ++++++++++++
.../gomp/strictly-structured-block-3.f90 | 52 +++++
libgomp/libgomp.texi | 2 +-
.../libgomp.fortran/task-reduction-16.f90 | 1 +
11 files changed, 484 insertions(+), 25 deletions(-)
create mode 100644
gcc/testsuite/gfortran.dg/gomp/strictly-structured-block-1.f90
create mode 100644
gcc/testsuite/gfortran.dg/gomp/strictly-structured-block-2.f90
create mode 100644
gcc/testsuite/gfortran.dg/gomp/strictly-structured-block-3.f90
diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index 6784b07ae9e..6043e100fbb 100644
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -8429,6 +8429,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 2a454be79b0..b1e73ee6801 100644
--- a/gcc/fortran/parse.c
+++ b/gcc/fortran/parse.c
@@ -5459,7 +5459,7 @@ parse_oacc_loop (gfc_statement acc_st)
/* Parse the statements of an OpenMP structured block. */
-static void
+static gfc_statement
parse_omp_structured_block (gfc_statement omp_st, bool workshare_stmts_only)
{
gfc_statement st, omp_end_st;
@@ -5546,6 +5546,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 (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)
@@ -5562,7 +5588,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)
@@ -5588,13 +5613,13 @@ parse_omp_structured_block (gfc_statement omp_st, bool
workshare_stmts_only)
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:
@@ -5617,7 +5642,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
@@ -5627,9 +5652,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);
@@ -5665,6 +5708,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;
}
@@ -5805,13 +5850,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 aaeb950fb72..e81c5588c53 100644
--- a/gcc/fortran/trans-openmp.c
+++ b/gcc/fortran/trans-openmp.c
@@ -7000,7 +7000,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/cancel-1.f90
b/gcc/testsuite/gfortran.dg/gomp/cancel-1.f90
index d60dd72bd4c..1bfddc7b9db 100644
--- a/gcc/testsuite/gfortran.dg/gomp/cancel-1.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/cancel-1.f90
@@ -265,6 +265,7 @@ subroutine f2
end do
!$omp end do
!$omp sections
+ !$omp section
block
!$omp cancel parallel ! { dg-error "not closely nested
inside" }
!$omp cancel do ! { dg-error "not closely
nested inside" }
@@ -417,6 +418,7 @@ subroutine f2
!$omp end ordered
end do
!$omp sections
+ !$omp section
block
!$omp cancel parallel ! { dg-error "not closely nested
inside" }
!$omp cancel do ! { dg-error "not closely nested
inside" }
@@ -515,6 +517,7 @@ subroutine f3
end do
!$omp end do nowait
!$omp sections
+ !$omp section
block
!$omp cancel sections ! { dg-warning "nowait" }
end block
diff --git a/gcc/testsuite/gfortran.dg/gomp/nesting-3.f90
b/gcc/testsuite/gfortran.dg/gomp/nesting-3.f90
index cd2e39ae082..5d0d20079a8 100644
--- a/gcc/testsuite/gfortran.dg/gomp/nesting-3.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/nesting-3.f90
@@ -7,7 +7,7 @@ subroutine f1
block; end block
end do
!$omp sections ! { dg-error "may not be closely nested" }
- block; end block
+ call do_work
!$omp section
block; end block
!$omp end sections
@@ -33,7 +33,7 @@ subroutine f1
!$omp end sections
!$omp sections
!$omp sections ! { dg-error "may not be closely nested" }
- block; end block
+ call do_work
!$omp section
block; end block
!$omp end sections
@@ -72,7 +72,7 @@ subroutine f1
!$omp sections
!$omp section
!$omp sections ! { dg-error "may not be closely nested" }
- block; end block
+ call do_work
!$omp section
block; end block
!$omp end sections
@@ -105,7 +105,7 @@ subroutine f1
block; end block
end do
!$omp sections ! { dg-error "may not be closely nested" }
- block; end block
+ call do_work
!$omp section
block; end block
!$omp end sections
@@ -129,7 +129,7 @@ subroutine f1
block; end block
end do
!$omp sections ! { dg-error "may not be closely nested" }
- block; end block
+ call do_work
!$omp section
block; end block
!$omp end sections
@@ -150,7 +150,7 @@ subroutine f1
block; end block
end do
!$omp sections ! { dg-error "may not be closely nested" }
- block; end block
+ call do_work
!$omp section
block; end block
!$omp end sections
@@ -171,7 +171,7 @@ subroutine f1
block; end block
end do
!$omp sections ! { dg-error "may not be closely nested" }
- block; end block
+ call do_work
!$omp section
block; end block
!$omp end sections
@@ -195,7 +195,7 @@ subroutine f1
block; end block
end do
!$omp sections
- block; end block
+ call do_work
!$omp section
block; end block
!$omp end sections
@@ -224,7 +224,7 @@ subroutine f1
block; end block
end do
!$omp sections
- block; end block
+ call do_work
!$omp section
block; end block
!$omp end sections
@@ -257,7 +257,7 @@ subroutine f2
block; end block
end do
!$omp sections ! { dg-error "may not be closely nested" }
- block; end block
+ call do_work
!$omp section
block; end block
!$omp end sections
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..00a018c6145
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/strictly-structured-block-1.f90
@@ -0,0 +1,214 @@
+! { dg-do compile }
+! { dg-options "-fopenmp" }
+
+program main
+ integer :: x, i, n
+
+ x = 0
+ n = 10
+
+ !$omp parallel
+ block
+ x = x + 1
+ end block
+
+ !$omp parallel
+ block
+ x = x + 1
+ end block
+ !$omp end parallel
+
+ !$omp teams
+ block
+ x = x + 1
+ end block
+
+ !$omp teams
+ block
+ x = x + 1
+ end block
+ !$omp end teams
+
+ !$omp masked
+ block
+ x = x + 1
+ end block
+
+ !$omp masked
+ block
+ x = x + 1
+ end block
+ !$omp end masked
+
+ !$omp scope
+ block
+ x = x + 1
+ end block
+
+ !$omp scope
+ block
+ x = x + 1
+ end block
+ !$omp end scope
+
+ !$omp single
+ block
+ x = x + 1
+ end block
+
+ !$omp single
+ block
+ x = x + 1
+ end block
+ !$omp end single
+
+ !$omp workshare
+ block
+ x = x + 1
+ end block
+
+ !$omp workshare
+ block
+ x = x + 1
+ end block
+ !$omp end workshare
+
+ !$omp task
+ block
+ x = x + 1
+ end block
+
+ !$omp task
+ block
+ x = x + 1
+ end block
+ !$omp end task
+
+ !$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
+ block
+ x = x + 1
+ end block
+
+ !$omp target
+ block
+ x = x + 1
+ end block
+ !$omp end target
+
+ !$omp parallel workshare
+ block
+ x = x + 1
+ end block
+
+ !$omp parallel workshare
+ block
+ x = x + 1
+ end block
+ !$omp end parallel workshare
+
+ !$omp parallel masked
+ block
+ x = x + 1
+ end block
+
+ !$omp parallel masked
+ block
+ x = x + 1
+ end block
+ !$omp end parallel masked
+
+ !$omp target parallel
+ block
+ x = x + 1
+ end block
+
+ !$omp target parallel
+ block
+ x = x + 1
+ end block
+ !$omp end target parallel
+
+ !$omp target teams
+ block
+ x = x + 1
+ end block
+
+ !$omp target teams
+ block
+ x = x + 1
+ end block
+ !$omp end target teams
+
+ !$omp critical
+ block
+ x = x + 1
+ end block
+
+ !$omp critical
+ block
+ x = x + 1
+ end block
+ !$omp end critical
+
+ !$omp taskgroup
+ block
+ x = x + 1
+ end block
+
+ !$omp taskgroup
+ block
+ x = x + 1
+ end block
+ !$omp end taskgroup
+
+ !$omp do ordered
+ do i = 1, n
+ !$omp ordered
+ block
+ x = x + 1
+ end block
+ end do
+
+ !$omp do ordered
+ do i = 1, n
+ !$omp ordered
+ block
+ x = x + 1
+ end block
+ !$omp end ordered
+ end do
+
+ !$omp master
+ block
+ x = x + 1
+ end block
+
+ !$omp master
+ block
+ x = x + 1
+ end block
+ !$omp end master
+
+ !$omp parallel master
+ block
+ x = x + 1
+ end block
+
+ !$omp parallel master
+ block
+ x = x + 1
+ end block
+ !$omp end parallel master
+
+end program
diff --git a/gcc/testsuite/gfortran.dg/gomp/strictly-structured-block-2.f90
b/gcc/testsuite/gfortran.dg/gomp/strictly-structured-block-2.f90
new file mode 100644
index 00000000000..a99616980c0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/strictly-structured-block-2.f90
@@ -0,0 +1,139 @@
+! { dg-do compile }
+! { dg-options "-fopenmp" }
+
+program main
+ integer :: x, i, n
+
+ x = 0
+ n = 10
+
+ !$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
+ x = x + 1
+ !$omp end teams ! { dg-error "Unexpected !.OMP END TEAMS statement" }
+
+ !$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
+ x = x + 1
+ !$omp end scope ! { dg-error "Unexpected !.OMP END SCOPE statement" }
+
+ !$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
+ x = x + 1
+ !$omp end workshare ! { dg-error "Unexpected !.OMP END WORKSHARE statement" }
+
+ !$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
+ x = x + 1
+ !$omp end target data ! { dg-error "Unexpected !.OMP END TARGET DATA
statement" }
+
+ !$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
+ x = x + 1
+ !$omp end parallel workshare ! { dg-error "Unexpected !.OMP END PARALLEL
WORKSHARE statement" }
+
+ !$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
+ x = x + 1
+ !$omp end target parallel ! { dg-error "Unexpected !.OMP END TARGET PARALLEL
statement" }
+
+ !$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
+ x = x + 1
+ !$omp end critical ! { dg-error "Unexpected !.OMP END CRITICAL statement" }
+
+ !$omp taskgroup
+ block
+ x = x + 1
+ end block
+ x = x + 1
+ !$omp end taskgroup ! { dg-error "Unexpected !.OMP END TASKGROUP statement" }
+
+ !$omp do ordered
+ do i = 1, n
+ !$omp ordered
+ block
+ x = x + 1
+ end block
+ x = x + 1
+ !$omp end ordered ! { dg-error "Unexpected !.OMP END ORDERED statement" }
+ end do
+
+ !$omp master
+ block
+ x = x + 1
+ end block
+ x = x + 1
+ !$omp end master ! { dg-error "Unexpected !.OMP END MASTER statement" }
+
+ !$omp parallel master
+ block
+ x = x + 1
+ end block
+ x = x + 1
+ !$omp end parallel master ! { dg-error "Unexpected !.OMP END PARALLEL MASTER
statement" }
+
+end program
diff --git a/gcc/testsuite/gfortran.dg/gomp/strictly-structured-block-3.f90
b/gcc/testsuite/gfortran.dg/gomp/strictly-structured-block-3.f90
new file mode 100644
index 00000000000..f9c76d64120
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/strictly-structured-block-3.f90
@@ -0,0 +1,52 @@
+! { dg-do compile }
+! { dg-options "-fopenmp" }
+
+program main
+ integer :: x, y
+
+ x = 0
+ y = 0
+
+ !$omp parallel
+ !$omp parallel
+ block
+ x = x + 1
+ end block
+ !$omp end parallel
+ !$omp end parallel
+
+ !$omp workshare
+ block
+ x = 1
+ !$omp critical
+ block
+ y = 3
+ end block
+ end block
+
+ !$omp sections
+ block
+ !$omp section
+ block
+ x = 1
+ end block
+ x = x + 2
+ !$omp section
+ x = x + 4
+ end block
+
+ !$omp sections
+ !$omp section
+ block
+ end block
+ x = 1
+ !$omp end sections
+
+ !$omp sections
+ block
+ block
+ end block
+ x = 1
+ end block
+
+end program main
diff --git a/libgomp/libgomp.texi b/libgomp/libgomp.texi
index e9fa8ba0bf7..6306e97696e 100644
--- a/libgomp/libgomp.texi
+++ b/libgomp/libgomp.texi
@@ -337,7 +337,7 @@ The OpenMP 4.5 specification is fully supported.
@multitable @columnfractions .60 .10 .25
@headitem Description @tab Status @tab Comments
-@item Support of strictly structured blocks in Fortran @tab N @tab
+@item Support of strictly structured blocks in Fortran @tab Y @tab
@item Support of structured block sequences in C/C++ @tab Y @tab
@item @code{unconstrained} and @code{reproducible} modifiers on @code{order}
clause @tab Y @tab
diff --git a/libgomp/testsuite/libgomp.fortran/task-reduction-16.f90
b/libgomp/testsuite/libgomp.fortran/task-reduction-16.f90
index c6b39e0b391..5b8617a6f5d 100644
--- a/libgomp/testsuite/libgomp.fortran/task-reduction-16.f90
+++ b/libgomp/testsuite/libgomp.fortran/task-reduction-16.f90
@@ -20,6 +20,7 @@ contains
!$omp scope reduction (task, iand: c)
!$omp barrier
!$omp sections
+ !$omp section
block
a = a + 1; b(0) = b(0) * 2; call bar (2); b(2) = b(2) * 3
c(1) = iand(c(1), not(ishft(1_8, 2)))
--
2.17.1
