1! { dg-do compile } 2! { dg-options "-fcoarray=single -fdump-tree-original" } 3! 4use iso_fortran_env, only: atomic_int_kind, atomic_logical_kind 5implicit none 6 7intrinsic :: atomic_define 8intrinsic :: atomic_ref 9intrinsic :: atomic_cas 10intrinsic :: atomic_add 11intrinsic :: atomic_and 12intrinsic :: atomic_or 13intrinsic :: atomic_xor 14intrinsic :: atomic_fetch_add 15intrinsic :: atomic_fetch_and 16intrinsic :: atomic_fetch_or 17intrinsic :: atomic_fetch_xor 18integer(atomic_int_kind) :: caf[*], var 19logical(atomic_logical_kind) :: caf_log[*], var2 20integer :: stat 21integer(1) :: var3 22logical(1) :: var4 23 24call atomic_define(caf, var, stat=stat) 25call atomic_define(caf_log, var2, stat=stat) 26 27call atomic_ref(var, caf, stat=stat) 28call atomic_ref(var2, caf_log, stat=stat) 29 30call atomic_cas(caf, var, 3_atomic_int_kind, 5_1, stat=stat) 31call atomic_cas(caf_log, var2, .true._atomic_logical_kind, & 32 .false._2, stat=stat) 33 34call atomic_add(caf, 77, stat=stat) 35call atomic_and(caf, 88, stat=stat) 36call atomic_or(caf, 101, stat=stat) 37call atomic_xor(caf, 105_2, stat=stat) 38 39call atomic_fetch_add(caf, var3, var, stat=stat) 40call atomic_fetch_and(caf, 22_1, var, stat=stat) 41call atomic_fetch_or(caf, var3, var, stat=stat) 42call atomic_fetch_xor(caf, 47_2, var, stat=stat) 43 44end 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 69! { dg-final { cleanup-tree-dump "original" } } 70