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.

4 files changed, 105 insertions, 5 deletions

diff --git a/gcc/fortran/openmp.cc b/gcc/fortran/openmp.cc
index dc0c801..79b5ae0 100644
--- a/gcc/fortran/openmp.cc
+++ b/gcc/fortran/openmp.cc
@@ -11245,6 +11245,8 @@ resolve_omp_target (gfc_code *code)
   if (!code->ext.omp_clauses->contains_teams_construct)
     return;
   gfc_code *c = code->block->next;
+  if (c->op == EXEC_BLOCK)
+    c = c->ext.block.ns->code;
   if (code->ext.omp_clauses->target_first_st_is_teams
       && ((GFC_IS_TEAMS_CONSTRUCT (c->op) && c->next == NULL)
 	  || (c->op == EXEC_BLOCK
diff --git a/gcc/fortran/parse.cc b/gcc/fortran/parse.cc
index 5838680..444baf4 100644
--- a/gcc/fortran/parse.cc
+++ b/gcc/fortran/parse.cc
@@ -5814,7 +5814,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);
 
@@ -5915,13 +5915,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);
     }
@@ -5937,6 +5945,8 @@ parse_omp_structured_block (gfc_statement omp_st, bool workshare_stmts_only)
       case ST_OMP_TEAMS_LOOP:
 	{
 	  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 = true;
 	  break;
 	}
@@ -6035,8 +6045,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 0000000..6ab3106
--- /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 0000000..79cb920
--- /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