6837b3b895
PR middle-end/35130 * tree-nested.c (convert_call_expr): Put FRAME.* vars into OMP_CLAUSE_SHARED rather than OMP_CLAUSE_FIRSTPRIVATE clause. * testsuite/libgomp.fortran/pr35130.f90: New test. * testsuite/libgomp.c/pr35130.c: New test. From-SVN: r132349
21 lines
355 B
Fortran
21 lines
355 B
Fortran
! PR middle-end/35130
|
|
|
|
program pr35130
|
|
implicit none
|
|
real, dimension(20) :: a
|
|
integer :: k
|
|
a(:) = 0.0
|
|
!$omp parallel do private(k)
|
|
do k=1,size(a)
|
|
call inner(k)
|
|
end do
|
|
!$omp end parallel do
|
|
if (any (a.ne.42)) call abort
|
|
contains
|
|
subroutine inner(i)
|
|
implicit none
|
|
integer :: i
|
|
a(i) = 42
|
|
end subroutine inner
|
|
end program pr35130
|