Hi Jakub,
this version adjusts the patch to let sections/parallel sections also use
strictly-structured blocks, making it more towards 5.2.
Because of this change, some of the testcases using the sections-construct need
a bit of adjustment too, since "block; end block" at the start of the construct
now means something different than before.
There are now three new testcases, with the non-dg-error/dg-error cases
separated,
and a third testcase containing a few cases listed in prior emails. I hope this
is
enough.
The implementation status entry in libgomp/libgomp.texi for strictly-structured
blocks
has also been changed to "Y" in this patch.
Tested without regressions, is this now okay for trunk?
Thanks,
Chung-Lin
2021-10-20 Chung-Lin Tang <clt...@codesourcery.com>
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.
diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index d6a22d13451..66489da12be 100644
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -8449,6 +8449,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..2fb98844356 100644
--- a/gcc/fortran/parse.c
+++ b/gcc/fortran/parse.c
@@ -5451,7 +5451,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;
@@ -5538,6 +5538,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)
@@ -5554,7 +5580,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)
@@ -5580,13 +5605,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:
@@ -5609,7 +5634,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 +5644,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 +5700,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;
}
@@ -5797,13 +5842,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/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..6422185a0f7 100644
--- a/gcc/testsuite/gfortran.dg/gomp/nesting-3.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/nesting-3.f90
@@ -1,5 +1,5 @@
subroutine f1
- integer i, j
+ integer i, j, x
!$omp do
do i = 0, 2
!$omp do ! { dg-error "may not be closely nested" }
@@ -7,7 +7,7 @@ subroutine f1
block; end block
end do
!$omp sections ! { dg-error "may not be closely nested" }
- block; end block
+ x = j
!$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
+ x = i
!$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
+ x = i
!$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
+ x = i
!$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
+ x = i
!$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
+ x = i
!$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
+ x = i
!$omp section
block; end block
!$omp end sections
@@ -195,7 +195,7 @@ subroutine f1
block; end block
end do
!$omp sections
- block; end block
+ x = i
!$omp section
block; end block
!$omp end sections
@@ -224,7 +224,7 @@ subroutine f1
block; end block
end do
!$omp sections
- block; end block
+ x = i
!$omp section
block; end block
!$omp end sections
@@ -250,14 +250,14 @@ subroutine f1
end
subroutine f2
- integer i, j
+ integer i, j, x
!$omp ordered
!$omp do ! { dg-error "may not be closely nested" }
do j = 0, 2
block; end block
end do
!$omp sections ! { dg-error "may not be closely nested" }
- block; end block
+ x = i
!$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..931661af433
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/strictly-structured-block-1.f90
@@ -0,0 +1,211 @@
+! { dg-do compile }
+! { dg-options "-fopenmp" }
+
+program main
+ integer :: x, i, n
+
+ !$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..815934e6ad6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/strictly-structured-block-2.f90
@@ -0,0 +1,136 @@
+! { dg-do compile }
+! { dg-options "-fopenmp" }
+
+program main
+ integer :: x, i, n
+
+ !$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..f786d1c6c10
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/strictly-structured-block-3.f90
@@ -0,0 +1,49 @@
+! { dg-do compile }
+! { dg-options "-fopenmp" }
+
+program main
+ integer :: x
+
+ !$omp parallel
+ !$omp parallel
+ block
+ x = x + 1
+ end block
+ !$omp end parallel
+ !$omp end parallel
+
+ !$omp workshare
+ block
+ x = 1
+ !$omp critical
+ block
+ x = 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 bdd7e3ac442..d996e32c93b 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)))
