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 <ja...@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
