Skip to content

Commit

Permalink
Add unit test based on #172
Browse files Browse the repository at this point in the history
 But configure it so that it passes and doesn't exhibit regression
  • Loading branch information
zbeekman committed Jan 20, 2017
1 parent ad7efa8 commit 54c2a18
Show file tree
Hide file tree
Showing 3 changed files with 66 additions and 0 deletions.
1 change: 1 addition & 0 deletions CMakeLists.txt
Expand Up @@ -412,6 +412,7 @@ if(opencoarrays_aware_compiler)
add_mpi_test(syncimages2 32 ${tests_root}/unit/sync/syncimages2)
add_mpi_test(duplicate_syncimages 8 ${tests_root}/unit/sync/duplicate_syncimages)
add_mpi_test(co_reduce 4 ${tests_root}/unit/collectives/co_reduce_test)
add_mpi_test(co_reduce_res_im 4 ${tests_root}/unit/collectives/co_reduce_res_im)
add_mpi_test(syncimages_status 32 ${tests_root}/unit/sync/syncimages_status)
add_mpi_test(sync_ring_abort_np3 3 ${tests_root}/unit/sync/sync_image_ring_abort_on_stopped_image)
add_mpi_test(sync_ring_abort_np7 7 ${tests_root}/unit/sync/sync_image_ring_abort_on_stopped_image)
Expand Down
3 changes: 3 additions & 0 deletions src/tests/unit/collectives/CMakeLists.txt
Expand Up @@ -12,3 +12,6 @@ target_link_libraries(co_max_test OpenCoarrays)

add_executable(co_reduce_test co_reduce.F90)
target_link_libraries(co_reduce_test OpenCoarrays)

add_executable(co_reduce_res_im co_reduce_res_im.f90)
target_link_libraries(co_reduce_res_im OpenCoarrays)
62 changes: 62 additions & 0 deletions src/tests/unit/collectives/co_reduce_res_im.f90
@@ -0,0 +1,62 @@
program co_reduce_res_im
!! author: Daniel Topa & Izaak Beekman
!! category: unit test
!!
!! This test is derived from
!! [issue #172](https://github.com/sourceryinstitute/opencoarrays/issues/172)
!! but tweaks the binary operator's (pure function) arguments have
!! `intent(in)` which results in a working/passing test

implicit none
integer :: value[ * ] !! Each image stores their image number here
integer :: k
value = this_image ( )
call co_reduce ( value, result_image = 1, operator = myProd )
!! value[k /= 1] undefined, value[ k == 1 ] should equal $n!$ where $n$ is `num_images()`
if ( this_image ( ) == 1 ) then
write ( * , '( "Number of images = ", g0 )' ) num_images ( )
do k = 1, num_images ( )
write ( * , '( 2( a, i0 ) )' ) 'value [ ', k, ' ] is ', value [ k ]
write ( * , '(a)' ) 'since RESULT_IMAGE is present, value on other images is undefined by the standard'
end do
write ( * , '( "Product value = ", g0 )' ) value !! should print num_images() factorial
if ( value == factorial( num_images() ) ) then
write ( * , '(a)' ) 'Test passed.'
else
write ( * , '(a, I0)') 'Answer should have been num_images()! = ', factorial( num_images() )
error stop 'Wrong answer for n! using co_reduce'
end if
end if


contains

pure function myProd ( a, b ) result ( rslt )
!! Product function to be used in `co_reduce` reduction for
!! computing factorials. When `intent(in)` attribute is changed
!! to `value` tests fail
integer, intent(in) :: a, b
!! multiply two inputs together. If we change `intent(in)` to
!! `value` the test fails despite being correct according to C1276
!! of F2008:
!!
!! > C1276 The specification-part of a pure function subprogram
!! > shall specify that all its nonpointer dummy data objects have
!! > the INTENT (IN) or the VALUE attribute.
!!
!! Thanks to @LadaF for pointing this out.
integer :: rslt !! product of a*b
rslt = a * b
end function

pure function factorial ( n ) result ( rslt )
!! Compute $n!$
integer, intent(in) :: n
integer :: rslt
integer :: i
rslt = 1
do i = 1, n
rslt = rslt*i
end do
end function
end program

0 comments on commit 54c2a18

Please sign in to comment.