! syncall test
!
! Copyright (c) 2012-2014, Sourcery, Inc.
! All rights reserved.
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions are met:
! * Redistributions of source code must retain the above copyright
! notice, this list of conditions and the following disclaimer.
! * Redistributions in binary form must reproduce the above copyright
! notice, this list of conditions and the following disclaimer in the
! documentation and/or other materials provided with the distribution.
! * Neither the name of the Sourcery, Inc., nor the
! names of its contributors may be used to endorse or promote products
! derived from this software without specific prior written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
! ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
! WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
! DISCLAIMED. IN NO EVENT SHALL SOURCERY, INC., BE LIABLE FOR ANY
! DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
! (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
! LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
! ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
! (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
!
program syncall
 implicit none
 integer :: me,np,i
 me = this_image()
 np = num_images()
 call mysyncall()
end program syncall
subroutine mysyncall()
 use mpi_f08
 implicit none
 integer :: me,np,i
 integer, allocatable, dimension(:), codimension[:] :: scalar2
 logical :: success = .true.
 integer(c_int), allocatable :: tally(:)
 integer :: rank, size
 integer :: base
 integer(kind=mpi_address_kind) :: sz
 type(MPI_Win) :: win = mpi_win_null
 call mpi_comm_rank(mpi_comm_world, rank)
 call mpi_comm_size(mpi_comm_world, size)
 print *,"hello ", rank, " / ", size
 base = 100
 sz = 4096
 ! comment the line below to hide the issue
 if (rank.eq.1) call mpi_win_create(base, sz, 4, mpi_info_null, mpi_comm_self, win)
 me = this_image()
 np = num_images()
 allocate(scalar2(1)[*])
 scalar2(1) = -1
 if(me /= 1) call sleep(1)
 scalar2(1) = 1
 sync all
 if(me == 1) then
 do i=1,np
 if(scalar2(1)[i] /= 1) then
 success = .false.
 endif
 end do
 end if
 if(me == 1) then
 if (success) then
 print *,'Test passed.'
 else
 print *,'Test failed.'
 endif
 endif
 if (win.ne.mpi_win_null) call mpi_win_free(win)
end

$ cafrun -n 2 ./a.out
 Test failed.

$ cafrun -n 2 ./a.out
 Test passed.

$ caf -I/opt/mpich-4.3.1/include ns.f90
$ cafrun -n 2 ./a.out