676b5525e8
If the walk_body on the various sequences of reduction, lastprivate and/or linear clauses needs to create a temporary variable, we should declare that variable in that sequence rather than outside, where it would need to be privatized inside of the construct. 2020-08-08 Jakub Jelinek <jakub@redhat.com> PR fortran/93553 * tree-nested.c (convert_nonlocal_omp_clauses): For OMP_CLAUSE_REDUCTION, OMP_CLAUSE_LASTPRIVATE and OMP_CLAUSE_LINEAR save info->new_local_var_chain around walks of the clause gimple sequences and declare_vars if needed into the sequence. 2020-08-08 Tobias Burnus <tobias@codesourcery.com> PR fortran/93553 * testsuite/libgomp.fortran/pr93553.f90: New test.
22 lines
357 B
Fortran
22 lines
357 B
Fortran
program p
|
|
implicit none
|
|
integer :: x(8) = 0
|
|
call sub(x)
|
|
end
|
|
subroutine sub(x)
|
|
implicit none
|
|
integer i
|
|
integer :: x(8)
|
|
integer :: c(8) = [(11*i, i=1,8)]
|
|
call s
|
|
if (any (x /= c)) stop 1
|
|
contains
|
|
subroutine s
|
|
integer :: i
|
|
!$omp parallel do reduction(+:x)
|
|
do i = 1, 8
|
|
x(i) = c(i)
|
|
end do
|
|
end
|
|
end
|