From 2e4659199e814b7ee0f6bd925fd2c0a7610da856 Mon Sep 17 00:00:00 2001 From: Chung-Lin Tang 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 6784b07..6043e10 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 2a454be..b1e73ee 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 55f0229..66b275d 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 aaeb950..e81c558 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 d60dd72..1bfddc7 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 cd2e39a..5d0d200 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 0000000..00a018c --- /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 0000000..a996169 --- /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 0000000..f9c76d6 --- /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 e9fa8ba..6306e97 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 c6b39e0..5b8617a 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.7.4