[commit: testsuite] atomics: Add a basic test for casArray#. (c67c578)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/testsuite

On branch  : atomics
Link       : http://ghc.haskell.org/trac/ghc/changeset/c67c5780d01544fc8f9b1c7a8e864f109cde467f/testsuite

>---------------------------------------------------------------

commit c67c5780d01544fc8f9b1c7a8e864f109cde467f
Author: Ryan Newton <rrnewton at gmail.com>
Date:   Fri Apr 20 15:50:56 2012 -0400

    Add a basic test for casArray#.


>---------------------------------------------------------------

c67c5780d01544fc8f9b1c7a8e864f109cde467f
 tests/concurrent/should_run/all.T                 |    3 ++
 tests/concurrent/should_run/compareAndSwap.hs     |   39 +++++++++++++++++++++
 tests/concurrent/should_run/compareAndSwap.stdout |    6 ++++
 3 files changed, 48 insertions(+)

diff --git a/tests/concurrent/should_run/all.T b/tests/concurrent/should_run/all.T
index b660c8d..8dfa79f 100644
--- a/tests/concurrent/should_run/all.T
+++ b/tests/concurrent/should_run/all.T
@@ -240,3 +240,6 @@ test('setnumcapabilities001',
        reqlib('parallel'),
        skip_if_not_smp ],
      compile_and_run, [''])
+
+# omit ghci, which can't handle unboxed tuples:
+test('compareAndSwap', omit_ways(['ghci']), compile_and_run, [''])
diff --git a/tests/concurrent/should_run/compareAndSwap.hs b/tests/concurrent/should_run/compareAndSwap.hs
new file mode 100644
index 0000000..a0966ab
--- /dev/null
+++ b/tests/concurrent/should_run/compareAndSwap.hs
@@ -0,0 +1,39 @@
+{-# Language MagicHash, UnboxedTuples  #-}
+
+import GHC.IO
+import GHC.IORef
+import GHC.ST
+import GHC.STRef
+import GHC.Prim
+import GHC.Base
+import Data.Primitive.Array
+import Control.Monad
+
+------------------------------------------------------------------------
+
+casArrayST :: MutableArray s a -> Int -> a -> a -> ST s (Bool, a)
+casArrayST (MutableArray arr#) (I# i#) old new = ST$ \s1# ->
+  case casArray# arr# i# old new s1# of 
+    (# s2#, x#, res #) -> (# s2#, (x# ==# 0#, res) #)
+
+------------------------------------------------------------------------
+-- Make sure this Int corresponds to a single object in memory (NOINLINE):
+{-# NOINLINE mynum #-}
+mynum :: Int
+mynum = 33
+
+main = do 
+  putStrLn "Perform a CAS within a MutableArray#"
+  arr <- newArray 5 mynum
+
+  res  <- stToIO$ casArrayST arr 3 mynum 44
+  res2 <- stToIO$ casArrayST arr 3 mynum 44
+  putStrLn$ "  1st try should succeed: "++show res
+  putStrLn$ "  2nd should fail: "++show res2
+
+  putStrLn "Printing array:"
+  forM_ [0..4] $ \ i -> do
+    x <- readArray arr i 
+    putStr ("  "++show x)
+  putStrLn ""
+  putStrLn "Done."
diff --git a/tests/concurrent/should_run/compareAndSwap.stdout b/tests/concurrent/should_run/compareAndSwap.stdout
new file mode 100644
index 0000000..b3f1466
--- /dev/null
+++ b/tests/concurrent/should_run/compareAndSwap.stdout
@@ -0,0 +1,6 @@
+Perform a CAS within a MutableArray#
+  1st try should succeed: (True,33)
+  2nd should fail: (False,44)
+Printing array:
+  33  33  33  44  33
+Done.