gcc/testsuite/gfortran.dg/coarray_atomic_4.f90

   1 ! { dg-do compile }
   2 ! { dg-options "-fcoarray=single -fdump-tree-original" }
   3 !
   4 use iso_fortran_env, only: atomic_int_kind, atomic_logical_kind
   5 implicit none
   6
   7 intrinsic :: atomic_define
   8 intrinsic :: atomic_ref
   9 intrinsic :: atomic_cas
  10 intrinsic :: atomic_add
  11 intrinsic :: atomic_and
  12 intrinsic :: atomic_or
  13 intrinsic :: atomic_xor
  14 intrinsic :: atomic_fetch_add
  15 intrinsic :: atomic_fetch_and
  16 intrinsic :: atomic_fetch_or
  17 intrinsic :: atomic_fetch_xor
  18 integer(atomic_int_kind) :: caf[*], var
  19 logical(atomic_logical_kind) :: caf_log[*], var2
  20 integer :: stat
  21 integer(1) :: var3
  22 logical(1) :: var4
  23
  24 call atomic_define(caf, var, stat=stat)
  25 call atomic_define(caf_log, var2, stat=stat)
  26
  27 call atomic_ref(var, caf, stat=stat)
  28 call atomic_ref(var2, caf_log, stat=stat)
  29
  30 call atomic_cas(caf, var, 3_atomic_int_kind, 5_1, stat=stat)
  31 call atomic_cas(caf_log, var2, .true._atomic_logical_kind, &
  32                 .false._2, stat=stat)
  33
  34 call atomic_add(caf, 77, stat=stat)
  35 call atomic_and(caf, 88, stat=stat)
  36 call atomic_or(caf, 101, stat=stat)
  37 call atomic_xor(caf, 105_2, stat=stat)
  38
  39 call atomic_fetch_add(caf, var3, var, stat=stat)
  40 call atomic_fetch_and(caf, 22_1, var, stat=stat)
  41 call atomic_fetch_or(caf, var3, var, stat=stat)
  42 call atomic_fetch_xor(caf, 47_2, var, stat=stat)
  43
  44 end
  45
  46 ! All the atomic calls:
  47 ! { dg-final { scan-tree-dump-times "  __atomic_store_4 \\(&caf, \\(integer\\(kind=4\\)\\) var, 0\\);" 1 "original" } }
  48 ! { dg-final { scan-tree-dump-times "  __atomic_store_4 \\(&caf_log, \\(logical\\(kind=4\\)\\) var2, 0\\);" 1 "original" } }
  49 ! { dg-final { scan-tree-dump-times "var = \\(integer\\(kind=4\\)\\) __atomic_load_4 \\(&caf, 0\\);" 1 "original" } }
  50 ! { dg-final { scan-tree-dump-times "var2 = \\(logical\\(kind=4\\)\\) __atomic_load_4 \\(&caf_log, 0\\);" 1 "original" } }
  51 ! { dg-final { scan-tree-dump-times "  __atomic_compare_exchange_4 \\(&caf, &var, 5, 0, 0, 0\\);" 1 "original" } }
  52 ! { dg-final { scan-tree-dump-times "  __atomic_compare_exchange_4 \\(&caf_log, &var2, 0, 0, 0, 0\\);" 1 "original" } }
  53 ! { dg-final { scan-tree-dump-times "  __atomic_fetch_add_4 \\(&caf, 77, 0\\);" 1 "original" } }
  54 ! { dg-final { scan-tree-dump-times "  __atomic_fetch_and_4 \\(&caf, 88, 0\\);" 1 "original" } }
  55 ! { dg-final { scan-tree-dump-times "  __atomic_fetch_or_4 \\(&caf, 101, 0\\);" 1 "original" } }
  56 ! { dg-final { scan-tree-dump-times "  __atomic_fetch_xor_4 \\(&caf, 105, 0\\);" 1 "original" } }
  57 ! { dg-final { scan-tree-dump-times "var = \\(integer\\(kind=4\\)\\) __atomic_fetch_add_4 \\(&caf, \\(integer\\(kind=4\\)\\) var3, 0\\);" 1 "original" } }
  58 ! { dg-final { scan-tree-dump-times "var = \\(integer\\(kind=4\\)\\) __atomic_fetch_and_4 \\(&caf, 22, 0\\);" 1 "original" } }
  59 ! { dg-final { scan-tree-dump-times "  var = \\(integer\\(kind=4\\)\\) __atomic_fetch_or_4 \\(&caf, \\(integer\\(kind=4\\)\\) var3, 0\\);" 1 "original" } }
  60 ! { dg-final { scan-tree-dump-times "  var = \\(integer\\(kind=4\\)\\) __atomic_fetch_xor_4 \\(&caf, 47, 0\\);" 1 "original" } }
  61
  62 ! CAS: Handle "compare" argument
  63 ! { dg-final { scan-tree-dump-times "var = 3;" 1 "original" } }
  64 ! { dg-final { scan-tree-dump-times "var2 = 1;" 1 "original" } }
  65
  66 ! All calls should have a stat=0
  67 ! { dg-final { scan-tree-dump-times "stat = 0;" 14 "original" } }
  68