gcc/libgomp/testsuite/libgomp.fortran/scan-1.f90
Tobias Burnus 005cff4e2e Fortran: Add 'omp scan' support of OpenMP 5.0
gcc/fortran/ChangeLog:

	* dump-parse-tree.c (show_omp_clauses, show_omp_node,
	show_code_node): Handle OMP SCAN.
	* gfortran.h (enum gfc_statement): Add ST_OMP_SCAN.
	(enum): Add OMP_LIST_SCAN_IN and OMP_LIST_SCAN_EX.
	(enum gfc_exec_op): Add EXEC_OMP_SCAN.
	* match.h (gfc_match_omp_scan): New prototype.
	* openmp.c (gfc_match_omp_scan): New.
	(gfc_match_omp_taskgroup): Cleanup.
	(resolve_omp_clauses, gfc_resolve_omp_do_blocks,
	omp_code_to_statement, gfc_resolve_omp_directive): Handle 'omp scan'.
	* parse.c (decode_omp_directive, next_statement,
	gfc_ascii_statement): Likewise.
	* resolve.c (gfc_resolve_code): Handle EXEC_OMP_SCAN.
	* st.c (gfc_free_statement): Likewise.
	* trans-openmp.c (gfc_trans_omp_clauses, gfc_trans_omp_do,
	gfc_split_omp_clauses): Handle 'omp scan'.

libgomp/ChangeLog:

	* testsuite/libgomp.fortran/scan-1.f90: New test.

gcc/testsuite/ChangeLog:

	* gfortran.dg/gomp/reduction4.f90: Update; move FE some tests to ...
	* gfortran.dg/gomp/reduction6.f90: ... this new test and ...
	* gfortran.dg/gomp/reduction7.f90: ... this new test.
	* gfortran.dg/gomp/reduction5.f90: Add dg-error.
	* gfortran.dg/gomp/scan-1.f90: New test.
	* gfortran.dg/gomp/scan-2.f90: New test.
	* gfortran.dg/gomp/scan-3.f90: New test.
	* gfortran.dg/gomp/scan-4.f90: New test.
	* gfortran.dg/gomp/scan-5.f90: New test.
	* gfortran.dg/gomp/scan-6.f90: New test.
	* gfortran.dg/gomp/scan-7.f90: New test.
2020-12-08 16:54:22 +01:00

116 lines
1.7 KiB
Fortran

! { dg-require-effective-target size32plus }
module m
implicit none
integer r, a(1024), b(1024)
contains
subroutine foo (a, b)
integer, contiguous :: a(:), b(:)
integer :: i
!$omp do reduction (inscan, +:r)
do i = 1, 1024
r = r + a(i)
!$omp scan inclusive(r)
b(i) = r
end do
end
integer function bar ()
integer s, i
s = 0
!$omp parallel
!$omp do reduction (inscan, +:s)
do i = 1, 1024
s = s + 2 * a(i)
!$omp scan inclusive(s)
b(i) = s
end do
!$omp end parallel
bar = s
end
subroutine baz (a, b)
integer, contiguous :: a(:), b(:)
integer :: i
!$omp parallel do reduction (inscan, +:r)
do i = 1, 1024
r = r + a(i)
!$omp scan inclusive(r)
b(i) = r
end do
end
integer function qux ()
integer s, i
s = 0
!$omp parallel do reduction (inscan, +:s)
do i = 1, 1024
s = s + 2 * a(i)
!$omp scan inclusive(s)
b(i) = s
end do
qux = s
end
end module m
program main
use m
implicit none
integer s, i
s = 0
do i = 1, 1024
a(i) = i-1
b(i) = -1
end do
!$omp parallel
call foo (a, b)
!$omp end parallel
if (r /= 1024 * 1023 / 2) &
stop 1
do i = 1, 1024
s = s + i-1
if (b(i) /= s) then
stop 2
else
b(i) = 25
endif
end do
if (bar () /= 1024 * 1023) &
stop 3
s = 0
do i = 1, 1024
s = s + 2 * (i-1)
if (b(i) /= s) then
stop 4
else
b(i) = -1
end if
end do
r = 0
call baz (a, b)
if (r /= 1024 * 1023 / 2) &
stop 5
s = 0
do i = 1, 1024
s = s + i-1
if (b(i) /= s) then
stop 6
else
b(i) = -25
endif
end do
if (qux () /= 1024 * 1023) &
stop 6
s = 0
do i = 1, 1024
s = s + 2 * (i-1)
if (b(i) /= s) &
stop 7
end do
end program