next-ref-0.1.0.2: test/Spec.hs

{-# LANGUAGE LambdaCase, CPP #-}
import Test.Hspec
import Control.Concurrent.NextRef
import GHC.Conc
import Control.Monad (void, replicateM_)

while :: IO Bool -> IO () -> IO ()
while test act = test >>= \case
  True  -> act >> while test act
  False -> return ()


main :: IO ()
main = hspec $ describe "NextRef" $ do
  it "newNextRef/takeNext/takeNext blocks" $ do
    ref <- newNextRef ()
    takeNextRef ref
    threadId <- forkIO $ void $ takeNextRef ref

    while ((== ThreadRunning) `fmap` threadStatus threadId) $ threadDelay 100000

    stat <- threadStatus threadId
#if __GLASGOW_HASKELL__ == 708
    stat `shouldBe` ThreadBlocked BlockedOnOther
#else
    stat `shouldBe` ThreadBlocked BlockedOnSTM
#endif

  it "writing never blocks" $ do
    ref <- newNextRef 1
    replicateM_ 10 $ writeNextRef ref 2
    True `shouldBe` True

  it "readLast does not block" $ do
    ref <- newNextRef ()
    takeNextRef ref
    readLast ref

    True `shouldBe` True

  it "takeNext/write/takeNext doesn't block, updates correctly" $ do
    ref <- newNextRef (1 :: Int)
    actual <- takeNextRef ref
    actual `shouldBe` Just 1

    writeNextRef ref 2

    actual1 <- takeNextRef ref
    actual1 `shouldBe` Just 2

  it "takeNext/modify/takeNext doesn't block, updates correctly" $ do
    ref <- newNextRef (1 :: Int)
    actual <- takeNextRef ref
    actual `shouldBe` Just 1

    modifyNextRef ref (\x -> (x+1, ()))

    actual1 <- takeNextRef ref
    actual1 `shouldBe` Just 2

  it "close/takeNext give nothing" $ do
    ref <- newNextRef ()
    close ref
    actual <- takeNextRef ref
    actual `shouldBe` Nothing

  it "close/open/takeNext gives value" $ do
    ref <- newNextRef ()
    close ref
    open  ref
    actual <- takeNextRef ref
    actual `shouldBe` Just ()