1program co_reduce_factorial_int64
2  !! author: Daniel Topa & Izaak Beekman
3  !! category: regression
4  !!
5  !! [issue #172](https://github.com/sourceryinstitute/opencoarrays/issues/172)
6  !! wherein co-reduce gets junk in the first image when binary
7  !! operator's (pure function) arguments have `value` attribute
8  !! instead of `intent(in)`
9
10  implicit none
11  integer(kind=8) :: value[ * ] !! Each image stores their image number here
12  integer :: k
13  integer(kind=8) :: np
14  value = this_image ( )
15  np = num_images ( )
16  call co_reduce ( value, result_image = 1, operator = myProd )
17  !! value[k /= 1] undefined, value[ k == 1 ] should equal $n!$ where $n$ is `num_images()`
18  if ( this_image ( ) == 1 ) then
19     write ( * , '( "Number of images = ", g0 )' ) num_images ( )
20     do k = 1, num_images ( )
21        write ( * , '( 2( a, i0 ) )' ) 'value [ ', k, ' ] is ', value [ k ]
22        write ( * , '(a)' ) 'since RESULT_IMAGE is present, value on other images is undefined by the standard'
23     end do
24     write ( * , '( "Product  value = ", g0 )' ) value  !! should print num_images() factorial
25     write ( * , 100 )
26     if ( value == factorial( np ) ) then
27        write ( * , '(a)' ) 'Test passed.'
28     else
29        write ( * , '(a, I0)') 'Answer should have been num_images()! = ', factorial( np )
30        error stop 'Wrong answer for n! using co_reduce'
31     end if
32  end if
33100 format ( "Expected value = num_images()!", /, " 2! = 2, 3! = 6, 4! = 24, ..." )
34
35contains
36
37  pure function myProd ( a, b ) result ( rslt )
38    !! Product function to be used in `co_reduce` reduction for
39    !! computing factorials. When `value` attribute is changed to
40    !! `intent(in)` tests pass, and expected behavior is observed.
41    integer(kind=8), value :: a, b
42    !! multiply two inputs together.  If we change `value` to
43    !! `intent(in)` the test passes and the issue goes away and
44    !! according to C1276 of F2008:
45    !!
46    !! > C1276 The specification-part of a pure function subprogram
47    !! > shall specify that all its nonpointer dummy data objects have
48    !! > the INTENT (IN) or the VALUE attribute.
49    !!
50    !! Thanks to @LadaF for pointing this out.
51    integer(kind=8)        :: rslt !! product of a*b
52    rslt = a * b
53  end function
54
55  pure function factorial ( n ) result ( rslt )
56    !! Compute $n!$
57    integer(kind=8), intent(in) :: n
58    integer(kind=8) :: rslt
59    integer :: i
60    rslt = 1
61    do i = 1, n
62      rslt = rslt*i
63   end do
64 end function
65end program
66