Fortran/OpenMP: Fix handling of strictly structured blocks

For strictly structured blocks, a BLOCK was created but the code
was placed after the block the outer structured block. Additionally,
labelled blocks were mishandled. As the code is now properly in a
BLOCK, it solves additional issues.

gcc/fortran/ChangeLog:

	* parse.cc (parse_omp_structured_block): Make the user code end
	up inside of BLOCK construct for strictly structured blocks;
	fix fallout for 'section' and 'teams'.
	* openmp.cc (resolve_omp_target): Fix changed BLOCK handling
	for teams in target checking.

libgomp/ChangeLog:

	* testsuite/libgomp.fortran/strictly-structured-block-1.f90: New test.

gcc/testsuite/ChangeLog:

	* gfortran.dg/block_17.f90: New test.
	* gfortran.dg/gomp/strictly-structured-block-5.f90: New test.

(cherry picked from commit 6a8edd50a149f10621b59798c887c24c81c8b9ea)

5 files changed, 126 insertions, 6 deletions

diff --git a/gcc/fortran/openmp.cc b/gcc/fortran/openmp.cc
index d69607ef288..53e705fff74 100644
--- a/gcc/fortran/openmp.cc
+++ b/gcc/fortran/openmp.cc
@@ -12418,7 +12418,7 @@ resolve_omp_target (gfc_code *code)
     return;
   gfc_code *c = code->block->next;
   if (c->op == EXEC_BLOCK)
-    c = c->next;
+    c = c->ext.block.ns->code;
   if (code->ext.omp_clauses->target_first_st_is_teams_or_meta)
     {
       if (c->op == EXEC_OMP_METADIRECTIVE)
diff --git a/gcc/fortran/parse.cc b/gcc/fortran/parse.cc
index 1cbc2b5ca11..c4d3e0f9097 100644
--- a/gcc/fortran/parse.cc
+++ b/gcc/fortran/parse.cc
@@ -5784,7 +5784,7 @@ parse_omp_structured_block (gfc_statement omp_st, bool workshare_stmts_only)
 {
   gfc_statement st, omp_end_st, first_st;
   gfc_code *cp, *np;
-  gfc_state_data s;
+  gfc_state_data s, s2;
 
   accept_statement (omp_st);
 
@@ -5820,13 +5820,21 @@ parse_omp_structured_block (gfc_statement omp_st, bool workshare_stmts_only)
       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);
+
+      push_state (&s2, COMP_BLOCK, my_ns->proc_name);
+      gfc_current_ns = my_ns;
+      my_parent = my_ns->parent;
+      if (omp_st == ST_OMP_SECTIONS
+	  || omp_st == ST_OMP_PARALLEL_SECTIONS)
+	{
+	  np = new_level (cp);
+	  np->op = cp->op;
+	}
+
       first_st = next_statement ();
       st = parse_spec (first_st);
     }
@@ -5844,6 +5852,8 @@ parse_omp_structured_block (gfc_statement omp_st, bool workshare_stmts_only)
       case ST_OMP_BEGIN_METADIRECTIVE:
 	{
 	  gfc_state_data *stk = gfc_state_stack->previous;
+	  if (stk->state == COMP_OMP_STRICTLY_STRUCTURED_BLOCK)
+	    stk = stk->previous;
 	  stk->tail->ext.omp_clauses->target_first_st_is_teams_or_meta = true;
 	  break;
 	}
@@ -5938,8 +5948,10 @@ parse_omp_structured_block (gfc_statement omp_st, bool workshare_stmts_only)
       else if (block_construct && st == ST_END_BLOCK)
 	{
 	  accept_statement (st);
+	  gfc_current_ns->code = gfc_state_stack->head;
 	  gfc_current_ns = my_parent;
-	  pop_state ();
+	  pop_state ();  /* Inner BLOCK */
+	  pop_state ();  /* Outer COMP_OMP_STRICTLY_STRUCTURED_BLOCK */
 
 	  st = next_statement ();
 	  if (st == omp_end_st)
diff --git a/gcc/testsuite/gfortran.dg/block_17.f90 b/gcc/testsuite/gfortran.dg/block_17.f90
new file mode 100644
index 00000000000..6ab3106ebd0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/block_17.f90
@@ -0,0 +1,9 @@
+subroutine foo()
+  block
+  end block
+end
+
+subroutine bar()
+  my_name: block
+  end block my_name
+end
diff --git a/gcc/testsuite/gfortran.dg/gomp/strictly-structured-block-5.f90 b/gcc/testsuite/gfortran.dg/gomp/strictly-structured-block-5.f90
new file mode 100644
index 00000000000..79cb9207180
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/strictly-structured-block-5.f90
@@ -0,0 +1,77 @@
+subroutine f()
+  !$omp parallel
+  block
+  end block
+
+  !$omp parallel
+  block
+    inner: block
+       block
+       end block
+    end block inner
+  end block
+end
+
+subroutine f2()
+  !$omp parallel
+  my_name : block
+  end block my_name
+
+  !$omp parallel
+  another_block : block
+    inner: block
+       block
+       end block
+    end block inner
+  end block another_block
+end
+
+subroutine f3()
+  !$omp parallel
+  my_name : block
+  end block my_name2  ! { dg-error "Expected label 'my_name' for END BLOCK statement" }
+  end block my_name   ! avoid follow up errors
+end subroutine
+
+subroutine f4
+  integer :: n
+  n = 5
+  !$omp parallel
+  my: block
+    integer :: A(n)
+    A(1) = 1
+  end block my
+end
+
+subroutine f4a
+  intrinsic :: sin
+  !$omp parallel
+  block
+    procedure(), pointer :: proc
+    procedure(sin) :: my_sin
+    proc => sin
+  end block
+end subroutine
+
+subroutine f5(x)
+  !$omp parallel
+  block
+    intent(in) :: x  ! { dg-error "INTENT is not allowed inside of BLOCK" }
+    optional :: x    ! { dg-error "OPTIONAL is not allowed inside of BLOCK" }
+    value :: x       ! { dg-error "VALUE is not allowed inside of BLOCK" }
+  end block
+end
+
+subroutine f6()
+  !$omp parallel
+  myblock: block
+    cycle myblock !  { dg-error "CYCLE statement at .1. is not applicable to non-loop construct 'myblock'" }
+  end block myblock
+
+  !$omp parallel
+  myblock2: block
+    exit  myblock2 ! OK.
+    ! jumps to the end of the block but stays in the structured block
+  end block myblock2
+  !$omp end parallel
+end
diff --git a/libgomp/testsuite/libgomp.fortran/strictly-structured-block-1.f90 b/libgomp/testsuite/libgomp.fortran/strictly-structured-block-1.f90
new file mode 100644
index 00000000000..8e7f6c8b9d3
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/strictly-structured-block-1.f90
@@ -0,0 +1,22 @@
+subroutine one
+  implicit none (external, type)
+  integer :: i, j
+  i = 5
+  j = 6
+  !$omp parallel
+  my_block : block
+    !$omp atomic write
+    i = 7
+    exit my_block
+
+    !$omp atomic write
+    j = 99  ! Should be unreachable
+
+    ! exit should jump here - end of block but inside of it.
+  end block my_block
+  if (i /= 7) stop 1
+  if (j /= 6) stop 2
+end
+
+ call one
+end