--- /dev/null
+! { dg-do run }
+! { dg-set-target-env-var GFORTRAN_NUM_IMAGES "4" }
+! { dg-options "-fdump-tree-original" }
+! Hand-crafted spin lock to make sure that atomic_add works.
+
+program main
+ use iso_fortran_env, only : atomic_int_kind
+ implicit none
+ integer (atomic_int_kind) :: x[*]
+ integer (atomic_int_kind) :: val
+ integer :: n, me
+ character (len=20) :: line
+ integer :: i
+ n = num_images()
+ me = this_image()
+ x = 0
+ sync all
+ ! Burn some CPU time to provoke race conditions.
+ do i=1,1000
+ write (unit=line,fmt='(F12.5)') sin(i*1.d0)
+ end do
+ call atomic_add (x[1], 1)
+ wait: do
+ call atomic_ref (val, x[1])
+ if (val == n) exit wait
+ end do wait
+ sync memory
+end program main
+! { dg-final { scan-tree-dump-times "__atomic_fetch_add_4" 1 "original" } }
--- /dev/null
+! { dg-do run }
+! { dg-set-target-env-var GFORTRAN_NUM_IMAGES "4" }
+! { dg-options "-fdump-tree-original" }
+! { dg-output "1234" }
+! Ordering of images through a spin lock using atomic_cas.
+
+program main
+ use iso_fortran_env, only : atomic_int_kind
+ implicit none
+ integer (atomic_int_kind) :: atom[*]
+ integer (atomic_int_kind) :: old, compare, new
+ integer :: me, n
+ atom = 0
+ me = this_image ()
+ n = num_images()
+ sync all
+ compare = me - 1
+ new = -1
+ wait: do
+ call atomic_cas (atom[1], old, compare, new)
+ if (old == compare) exit wait
+ end do wait
+ sync memory
+ write (*,'(I0)',advance="no") this_image()
+ call atomic_define (atom[1], this_image())
+ sync memory
+end program main
+! { dg-final { scan-tree-dump-times "__atomic_compare_exchange" 1 "original" } }
--- /dev/null
+! { dg-do run }
+! { dg-set-target-env-var GFORTRAN_NUM_IMAGES "4" }
+! { dg-options "-fdump-tree-original" }
+program atomic
+ use iso_fortran_env
+ implicit none
+ integer(atomic_int_kind) :: atom[*]
+ integer :: to_set[*]
+ integer :: val, i
+ if (this_image() == 1) then
+ call atomic_define (atom[1], 0)
+ end if
+ sync all
+ ! Spin loop on image 2 setting atom[1]
+ if (this_image () == 2) then
+ do i=1,num_images()
+ to_set[i] = 42
+ end do
+ call atomic_define (atom[1], 1)
+ sync memory
+ else
+ wait: do
+ call atomic_ref (val, atom[1])
+ if (val == 1) exit wait
+ end do wait
+ sync memory
+ if (to_set /= 42) stop 42
+ end if
+end program atomic
+! { dg-final { scan-tree-dump-times "__atomic_load_4" 1 "original" } }
+! { dg-final { scan-tree-dump-times "__atomic_store_4" 2 "original" } }
+! { dg-final { scan-tree-dump-times "__atomic_thread_fence" 3 "original" } }
- make STAT and ERRMSG work for ALLOCATE, DEALLOCATE, SYNC and locks
- Teams
- Types containing allocatable components in coarrays
-- Atomics
- Events
- MOVE_ALLOC
- automatic linking of relevant libraries with -fcoarray=shared