public inbox for gcc-cvs@sourceware.org
help / color / mirror / Atom feed
* [gcc/devel/omp/gcc-11] openmp: Fortran strictly-structured blocks support
@ 2021-10-21 13:54 Chung-Lin Tang
0 siblings, 0 replies; only message in thread
From: Chung-Lin Tang @ 2021-10-21 13:54 UTC (permalink / raw)
To: gcc-cvs
https://gcc.gnu.org/g:7eb76b082f997da81ed3cf7406897375db6f6c19
commit 7eb76b082f997da81ed3cf7406897375db6f6c19
Author: Chung-Lin Tang <cltang@codesourcery.com>
Date: Thu Oct 21 14:56:20 2021 +0800
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.
(cherry picked from commit 2e4659199e814b7ee0f6bd925fd2c0a7610da856)
Diff:
---
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(-)
diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index 44463b71866..05353bb0ad1 100644
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -8422,6 +8422,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 75d583f2583..97ce82e7b8e 100644
--- a/gcc/fortran/parse.c
+++ b/gcc/fortran/parse.c
@@ -5460,7 +5460,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;
@@ -5547,6 +5547,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)
@@ -5563,7 +5589,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)
@@ -5589,13 +5614,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:
@@ -5618,7 +5643,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
@@ -5628,9 +5653,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);
@@ -5666,6 +5709,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;
}
@@ -5806,13 +5851,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 6f0fadd50c3..2611d9b6ba8 100644
--- a/gcc/fortran/trans-openmp.c
+++ b/gcc/fortran/trans-openmp.c
@@ -7040,7 +7040,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 38f9f4ade73..e6b1b558b6e 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)))
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2021-10-21 13:54 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2021-10-21 13:54 [gcc/devel/omp/gcc-11] openmp: Fortran strictly-structured blocks support Chung-Lin Tang
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).