[committed] Fix OpenMP ICE (PR fortran/69281)

[Jakub Jelinek <jakub at redhat dot com>]

Hi!

On the following testcase we ICE because the BLOCK that is initially in the
BIND_EXPR on the OMP_PARALLEL/TASK/TARGET body contains a VAR_DECL for
-fstack-arrays added artificial VLA.  Later on for move_sese_* reasons this
is the BLOCK used for the moving, which means that a copy of the VAR_DECL
with DECL_VALUE_EXPR is also in the original function where if we version
that function, we might tweak its type and that then turns the *omp_fn*
into invalid IL.  This problem doesn't exist for C/C++, because there we
actually wrap the body into 2 BLOCKs, one user supplied and the other that
just holds the artificials added during gimplification/omp lowering that
aren't problematic.  This patch makes the Fortran FE match the C/C++ more
closely by wrapping the body into another BIND_EXPR with its own BLOCK.

Bootstrapped/regtested on x86_64-linux and i686-linux, committed to trunk.
Backports queued.

2016-08-19  Jakub Jelinek  <jakub@redhat.com>

	PR fortran/69281
	* trans-openmp.c (gfc_trans_omp_parallel, gfc_trans_omp_task,
	gfc_trans_omp_target): Wrap gfc_trans_omp_code result in an extra
	BIND_EXPR with its own forced BLOCK.

	* gfortran.dg/gomp/pr69281.f90: New test.

--- gcc/fortran/trans-openmp.c.jj	2016-07-01 17:11:37.000000000 +0200
+++ gcc/fortran/trans-openmp.c	2016-08-19 14:19:46.246922616 +0200
@@ -3554,7 +3554,9 @@ gfc_trans_omp_parallel (gfc_code *code)
   gfc_start_block (&block);
   omp_clauses = gfc_trans_omp_clauses (&block, code->ext.omp_clauses,
 				       code->loc);
+  pushlevel ();
   stmt = gfc_trans_omp_code (code->block->next, true);
+  stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0));
   stmt = build2_loc (input_location, OMP_PARALLEL, void_type_node, stmt,
 		     omp_clauses);
   gfc_add_expr_to_block (&block, stmt);
@@ -4062,7 +4064,9 @@ gfc_trans_omp_task (gfc_code *code)
   gfc_start_block (&block);
   omp_clauses = gfc_trans_omp_clauses (&block, code->ext.omp_clauses,
 				       code->loc);
+  pushlevel ();
   stmt = gfc_trans_omp_code (code->block->next, true);
+  stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0));
   stmt = build2_loc (input_location, OMP_TASK, void_type_node, stmt,
 		     omp_clauses);
   gfc_add_expr_to_block (&block, stmt);
@@ -4215,7 +4219,11 @@ gfc_trans_omp_target (gfc_code *code)
       = gfc_trans_omp_clauses (&block, &clausesa[GFC_OMP_SPLIT_TARGET],
 			       code->loc);
   if (code->op == EXEC_OMP_TARGET)
-    stmt = gfc_trans_omp_code (code->block->next, true);
+    {
+      pushlevel ();
+      stmt = gfc_trans_omp_code (code->block->next, true);
+      stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0));
+    }
   else
     {
       pushlevel ();
--- gcc/testsuite/gfortran.dg/gomp/pr69281.f90.jj	2016-08-19 13:54:11.411692953 +0200
+++ gcc/testsuite/gfortran.dg/gomp/pr69281.f90	2016-08-19 14:23:11.000000000 +0200
@@ -0,0 +1,63 @@
+! PR fortran/69281
+! { dg-do compile }
+! { dg-additional-options "-fstack-arrays -O2" }
+
+program pr69281
+  implicit none
+  call foo1((/ 1, 3, 3, 7 /))
+  call foo2((/ 1, 3, 3, 7 /))
+  call foo3((/ 1, 3, 3, 7 /))
+  call foo4((/ 1, 3, 3, 7 /))
+  call foo5((/ 1, 3, 3, 7 /))
+  call foo6((/ 1, 3, 3, 7 /))
+contains
+  subroutine foo1(x)
+    integer, intent(in) :: x(:)
+    !$omp parallel
+      call baz(bar(x))
+    !$omp end parallel
+  end subroutine
+  subroutine foo2(x)
+    integer, intent(in) :: x(:)
+    !$omp task
+      call baz(bar(x))
+    !$omp end task
+  end subroutine
+  subroutine foo3(x)
+    integer, intent(in) :: x(:)
+    !$omp target
+      call baz(bar(x))
+    !$omp end target
+  end subroutine
+  subroutine foo4(x)
+    integer, intent(in) :: x(:)
+    !$omp target teams
+      call baz(bar(x))
+    !$omp end target teams
+  end subroutine
+  subroutine foo5(x)
+    integer, intent(in) :: x(:)
+    integer :: i
+    !$omp parallel do
+      do i = 1, 1
+        call baz(bar(x))
+      end do
+  end subroutine
+  subroutine foo6(x)
+    integer, intent(in) :: x(:)
+    integer :: i
+    !$omp target teams distribute parallel do
+      do i = 1, 1
+        call baz(bar(x))
+      end do
+  end subroutine
+  function bar(x) result(a)
+    integer, dimension(:), intent(in) :: x
+    integer, dimension(2,size(x)) :: a
+    a(1,:) = 1
+    a(2,:) = x
+  end function
+  subroutine baz(a)
+    integer, dimension(:,:), intent(in) :: a
+  end subroutine
+end program

	Jakub