f8d535f3fe
Fortran version to commit e45483c7c4,
which implemented OpenMP's scope construct for C and C++.
Most testcases are based on the C testcases; it also contains some
testcases which existed previously but had no Fortran equivalent.
gcc/fortran/ChangeLog:
* dump-parse-tree.c (show_omp_node, show_code_node): Handle
EXEC_OMP_SCOPE.
* gfortran.h (enum gfc_statement): Add ST_OMP_(END_)SCOPE.
(enum gfc_exec_op): Add EXEC_OMP_SCOPE.
* match.h (gfc_match_omp_scope): New.
* openmp.c (OMP_SCOPE_CLAUSES): Define
(gfc_match_omp_scope): New.
(gfc_match_omp_cancellation_point, gfc_match_omp_end_nowait):
Improve error diagnostic.
(omp_code_to_statement): Handle ST_OMP_SCOPE.
(gfc_resolve_omp_directive): Handle EXEC_OMP_SCOPE.
* parse.c (decode_omp_directive, next_statement,
gfc_ascii_statement, parse_omp_structured_block,
parse_executable): Handle OpenMP's scope construct.
* resolve.c (gfc_resolve_blocks): Likewise
* st.c (gfc_free_statement): Likewise
* trans-openmp.c (gfc_trans_omp_scope): New.
(gfc_trans_omp_directive): Call it.
* trans.c (trans_code): handle EXEC_OMP_SCOPE.
libgomp/ChangeLog:
* testsuite/libgomp.fortran/scope-1.f90: New test.
* testsuite/libgomp.fortran/task-reduction-16.f90: New test.
gcc/testsuite/ChangeLog:
* gfortran.dg/gomp/scan-1.f90:
* gfortran.dg/gomp/cancel-1.f90: New test.
* gfortran.dg/gomp/cancel-4.f90: New test.
* gfortran.dg/gomp/loop-4.f90: New test.
* gfortran.dg/gomp/nesting-1.f90: New test.
* gfortran.dg/gomp/nesting-2.f90: New test.
* gfortran.dg/gomp/nesting-3.f90: New test.
* gfortran.dg/gomp/nowait-1.f90: New test.
* gfortran.dg/gomp/reduction-task-1.f90: New test.
* gfortran.dg/gomp/reduction-task-2.f90: New test.
* gfortran.dg/gomp/reduction-task-2a.f90: New test.
* gfortran.dg/gomp/reduction-task-3.f90: New test.
* gfortran.dg/gomp/scope-1.f90: New test.
* gfortran.dg/gomp/scope-2.f90: New test.
83 lines
2.6 KiB
Fortran
83 lines
2.6 KiB
Fortran
module m
|
|
implicit none (external, type)
|
|
integer :: a, b(0:2) = [1, 1, 1]
|
|
integer(8) :: c(0:1) = [not(0_8), not(0_8)]
|
|
contains
|
|
subroutine bar (i)
|
|
integer :: i
|
|
!$omp task in_reduction (*: b) in_reduction (iand: c) &
|
|
!$omp& in_reduction (+: a)
|
|
a = a + 4
|
|
b(1) = b(1) * 4
|
|
c(1) = iand (c(1), not(ishft(1_8, i + 16)))
|
|
!$omp end task
|
|
end subroutine bar
|
|
|
|
subroutine foo (x)
|
|
integer :: x
|
|
!$omp scope reduction (task, +: a)
|
|
!$omp scope reduction (task, *: b)
|
|
!$omp scope reduction (task, iand: c)
|
|
!$omp barrier
|
|
!$omp sections
|
|
block
|
|
a = a + 1; b(0) = b(0) * 2; call bar (2); b(2) = b(2) * 3
|
|
c(1) = iand(c(1), not(ishft(1_8, 2)))
|
|
end block
|
|
!$omp section
|
|
block
|
|
b(0) = b(0) * 2; call bar (4); b(2) = b(2) * 3
|
|
c(1) = iand(c(1), not(ishft(1_8, 4))); a = a + 1
|
|
end block
|
|
!$omp section
|
|
block
|
|
call bar (6); b(2) = b(2) * 3; c(1) = iand(c(1), not(ishft(1_8, 6)))
|
|
a = a + 1; b(0) = b(0) * 2
|
|
end block
|
|
!$omp section
|
|
block
|
|
b(2) = b(2) * 3; c(1) = iand(c(1), not(ishft(1_8, 8)))
|
|
a = a + 1; b(0) = b(0) * 2; call bar (8)
|
|
end block
|
|
!$omp section
|
|
block
|
|
c(1) = iand(c(1), not(ishft(1_8, 10))); a = a + 1
|
|
b(0) = b(0) * 2; call bar (10); b(2) = b(2) * 3
|
|
end block
|
|
!$omp section
|
|
block
|
|
a = a + 1; b(0) = b(0) * 2; b(2) = b(2) * 3
|
|
c(1) = iand(c(1), not(ishft(1_8, 12))); call bar (12)
|
|
end block
|
|
!$omp section
|
|
if (x /= 0) then
|
|
a = a + 1; b(0) = b(0) * 2; b(2) = b(2) * 3
|
|
call bar (14); c(1) = iand (c(1), not(ishft(1_8, 14)))
|
|
end if
|
|
!$omp end sections
|
|
!$omp end scope
|
|
!$omp end scope
|
|
!$omp end scope
|
|
end subroutine foo
|
|
end module m
|
|
|
|
program main
|
|
use m
|
|
implicit none (type, external)
|
|
integer, volatile :: one
|
|
one = 1
|
|
call foo (0)
|
|
if (a /= 30 .or. b(0) /= 64 .or. b(1) /= ishft (1, 12) .or. b(2) /= 3 * 3 * 3 * 3 * 3 * 3 &
|
|
.or. c(0) /= not(0_8) .or. c(1) /= not(int(z'15541554', kind=8))) &
|
|
stop 1
|
|
a = 0
|
|
b(:) = [1, 1, 1]
|
|
c(1) = not(0_8)
|
|
!$omp parallel
|
|
call foo (one)
|
|
!$omp end parallel
|
|
if (a /= 35 .or. b(0) /= 128 .or. b(1) /= ishft(1, 14) .or. b(2) /= 3 * 3 * 3 * 3 * 3 * 3 * 3 &
|
|
.or. c(0) /= not(0_8) .or. c(1) /= not(int(z'55545554', kind=8))) &
|
|
stop 2
|
|
end program main
|