b7c4a12a9d
OpenMP 5.0 removed the restriction that multiple collapsed loops must be perfectly nested, allowing "intervening code" (including nested BLOCKs) before or after each nested loop. In GCC this code is moved into the inner loop body by the respective front ends. In the Fortran front end, most of the semantic processing happens during the translation phase, so the parse phase just collects the intervening statements, checks them for errors, and splices them around the loop body. gcc/fortran/ChangeLog * gfortran.h (struct gfc_namespace): Add omp_structured_block bit. * openmp.cc: Include omp-api.h. (resolve_omp_clauses): Consolidate inscan reduction clause conflict checking here. (find_nested_loop_in_chain): New. (find_nested_loop_in_block): New. (gfc_resolve_omp_do_blocks): Set omp_current_do_collapse properly. Handle imperfectly-nested loops when looking for nested omp scan. Refactor to move inscan reduction clause conflict checking to resolve_omp_clauses. (gfc_resolve_do_iterator): Handle imperfectly-nested loops. (struct icode_error_state): New. (icode_code_error_callback): New. (icode_expr_error_callback): New. (diagnose_intervening_code_errors_1): New. (diagnose_intervening_code_errors): New. (make_structured_block): New. (restructure_intervening_code): New. (is_outer_iteration_variable): Do not assume loops are perfectly nested. (check_nested_loop_in_chain): New. (check_nested_loop_in_block_state): New. (check_nested_loop_in_block_symbol): New. (check_nested_loop_in_block): New. (expr_uses_intervening_var): New. (is_intervening_var): New. (expr_is_invariant): Do not assume loops are perfectly nested. (resolve_omp_do): Handle imperfectly-nested loops. * trans-stmt.cc (gfc_trans_block_construct): Generate OMP_STRUCTURED_BLOCK if magic bit is set on block namespace. gcc/testsuite/ChangeLog * gfortran.dg/gomp/collapse1.f90: Adjust expected errors. * gfortran.dg/gomp/collapse2.f90: Likewise. * gfortran.dg/gomp/imperfect-gotos.f90: New. * gfortran.dg/gomp/imperfect-invalid-scope.f90: New. * gfortran.dg/gomp/imperfect1.f90: New. * gfortran.dg/gomp/imperfect2.f90: New. * gfortran.dg/gomp/imperfect3.f90: New. * gfortran.dg/gomp/imperfect4.f90: New. * gfortran.dg/gomp/imperfect5.f90: New. libgomp/ChangeLog * testsuite/libgomp.fortran/imperfect-destructor.f90: New. * testsuite/libgomp.fortran/imperfect1.f90: New. * testsuite/libgomp.fortran/imperfect2.f90: New. * testsuite/libgomp.fortran/imperfect3.f90: New. * testsuite/libgomp.fortran/imperfect4.f90: New. * testsuite/libgomp.fortran/target-imperfect1.f90: New. * testsuite/libgomp.fortran/target-imperfect2.f90: New. * testsuite/libgomp.fortran/target-imperfect3.f90: New. * testsuite/libgomp.fortran/target-imperfect4.f90: New.
67 lines
1.5 KiB
Fortran
67 lines
1.5 KiB
Fortran
! { dg-do run }
|
|
|
|
program foo
|
|
integer, save :: f1count(3), f2count(3)
|
|
|
|
f1count(1) = 0
|
|
f1count(2) = 0
|
|
f1count(3) = 0
|
|
f2count(1) = 0
|
|
f2count(2) = 0
|
|
f2count(3) = 0
|
|
|
|
call s1 (3, 4, 5)
|
|
|
|
! All intervening code at the same depth must be executed the same
|
|
! number of times.
|
|
if (f1count(1) /= f2count(1)) error stop 101
|
|
if (f1count(2) /= f2count(2)) error stop 102
|
|
if (f1count(3) /= f2count(3)) error stop 103
|
|
|
|
! Intervening code must be executed at least as many times as the loop
|
|
! that encloses it.
|
|
if (f1count(1) < 3) error stop 111
|
|
if (f1count(2) < 3 * 4) error stop 112
|
|
|
|
! Intervening code must not be executed more times than the number
|
|
! of logical iterations.
|
|
if (f1count(1) > 3 * 4 * 5) error stop 121
|
|
if (f1count(2) > 3 * 4 * 5) error stop 122
|
|
|
|
! Check that the innermost loop body is executed exactly the number
|
|
! of logical iterations expected.
|
|
if (f1count(3) /= 3 * 4 * 5) error stop 131
|
|
|
|
contains
|
|
|
|
subroutine f1 (depth, iter)
|
|
integer :: depth, iter
|
|
f1count(depth) = f1count(depth) + 1
|
|
end subroutine
|
|
|
|
subroutine f2 (depth, iter)
|
|
integer :: depth, iter
|
|
f2count(depth) = f2count(depth) + 1
|
|
end subroutine
|
|
|
|
subroutine s1 (a1, a2, a3)
|
|
integer :: a1, a2, a3
|
|
integer :: i, j, k
|
|
|
|
!$omp do collapse(3)
|
|
do i = 1, a1
|
|
call f1 (1, i)
|
|
do j = 1, a2
|
|
call f1 (2, j)
|
|
do k = 1, a3
|
|
call f1 (3, k)
|
|
call f2 (3, k)
|
|
end do
|
|
call f2 (2, j)
|
|
end do
|
|
call f2 (1, i)
|
|
end do
|
|
|
|
end subroutine
|
|
|
|
end program
|