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.

diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index 6784b07ae9e37d83a2ed7603f860843d29889881..6043e100fbb9721a740c5d46f6c256933f138690 100644 (file)
--- 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 2a454be79b0d8d3438c223669137f571a0e7b74d..b1e73ee6801100ef1170667206546ec33b5b0b39 100644 (file)
--- 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 55f0229930491572b3ece5ebff60394f76e28604..66b275de89bc0a37ea17818cc5456e5d80db5d58 100644 (file)
--- 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 aaeb950fb72f8832f1bcc6842d74d98a05306e10..e81c5588c53c1e20a78f165f558b712cc2d295cb 100644 (file)
--- 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 d60dd72bd4ce9fa9223f7e12630525afa643116b..1bfddc7b9db0caadf5c3722e1c6478ff2a3be442 100644 (file)
--- 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 cd2e39ae08253e0b958ee7c11dc295a957aa5bb6..5d0d20079a89b2e25dd14dd034bd611a249af78d 100644 (file)
--- 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 (file)
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 (file)
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 (file)
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 e9fa8ba0bf78e189582bf46231fdaf55ee2c93f4..6306e97696eb43458f9370529edad5ebb337ebfa 100644 (file)
--- 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 c6b39e0b3918435be6a36c4327c662180bddb041..5b8617a6f5d4d8a7cd368bb4003f7c1521194348 100644 (file)
--- 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)))