61 lines
1.8 KiB
Haskell
61 lines
1.8 KiB
Haskell
|
{-# LANGUAGE RecursiveDo #-}
|
||
|
|
module Test.UIO where
|
||
|
|
|
||
|
|
import Data.IORef
|
||
|
|
|
||
|
|
import UIO
|
||
|
|
|
||
|
|
testBoth :: IO ()
|
||
|
|
testBoth = do
|
||
|
|
testUIOFix
|
||
|
|
testUIOUnique
|
||
|
|
testUIOMany
|
||
|
|
testIO
|
||
|
|
|
||
|
|
{-# NOINLINE testUIOFix #-}
|
||
|
|
testUIOFix :: IO ()
|
||
|
|
testUIOFix = do
|
||
|
|
r <- runUIO2 $ mdo
|
||
|
|
unordered $ atomicModifyIORef' r $ \v -> (v + 5, ())
|
||
|
|
r <- unordered $ newIORef 2
|
||
|
|
pure r
|
||
|
|
print =<< readIORef r
|
||
|
|
|
||
|
|
{-# NOINLINE testUIOMany #-}
|
||
|
|
testUIOMany :: IO ()
|
||
|
|
testUIOMany = do
|
||
|
|
r <- runUIO2 $ do
|
||
|
|
r <- unordered $ newIORef 0
|
||
|
|
unordered $ atomicModifyIORef' r $ \v -> (v + 1, ())
|
||
|
|
unordered $ atomicModifyIORef' r $ \v -> (v + 2, ())
|
||
|
|
unordered $ atomicModifyIORef' r $ \v -> (v + 3, ())
|
||
|
|
unordered $ atomicModifyIORef' r $ \v -> (v + 4, ())
|
||
|
|
unordered $ atomicModifyIORef' r $ \v -> (v + 5, ())
|
||
|
|
unordered $ atomicModifyIORef' r $ \v -> (v + 6, ())
|
||
|
|
unordered $ atomicModifyIORef' r $ \v -> (v + 7, ())
|
||
|
|
unordered $ atomicModifyIORef' r $ \v -> (v + 8, ())
|
||
|
|
unordered $ atomicModifyIORef' r $ \v -> (v + 9, ())
|
||
|
|
unordered $ atomicModifyIORef' r $ \v -> (v + 10, ())
|
||
|
|
pure r
|
||
|
|
print =<< readIORef r
|
||
|
|
|
||
|
|
{-# NOINLINE testUIOUnique #-}
|
||
|
|
testUIOUnique :: IO ()
|
||
|
|
testUIOUnique = do
|
||
|
|
r <- runUIO2 $ do
|
||
|
|
-- The following two lines can be merged by common subexpression elimination (CSE), which is very bad
|
||
|
|
r <- unordered $ newIORef 2
|
||
|
|
r2 <- unordered $ newIORef 2
|
||
|
|
-- Note that the following two lines must be different, otherwise they will *also* be merged by CSE, which will make the test appear to succeed!
|
||
|
|
unordered $ atomicModifyIORef' r $ \v -> (v + 5, ())
|
||
|
|
unordered $ atomicModifyIORef' r2 $ \v -> (v + 10, ())
|
||
|
|
pure r
|
||
|
|
print =<< readIORef r
|
||
|
|
|
||
|
|
{-# NOINLINE testBoth #-}
|
||
|
|
testIO :: IO ()
|
||
|
|
testIO = do
|
||
|
|
r <- newIORef 2
|
||
|
|
atomicModifyIORef' r $ \v -> (v + 5, ())
|
||
|
|
print =<< readIORef r
|