diff --git a/io-sim/CHANGELOG.md b/io-sim/CHANGELOG.md index 60757341..143e60a0 100644 --- a/io-sim/CHANGELOG.md +++ b/io-sim/CHANGELOG.md @@ -1,5 +1,9 @@ # Revision history of io-sim +## Next release + +- Fixed `tryReadTBQueue` when returning `Nothing`. + ## 1.5.1.0 - The signature of: diff --git a/io-sim/src/Control/Monad/IOSim/STM.hs b/io-sim/src/Control/Monad/IOSim/STM.hs index 9528553e..0a12fa85 100644 --- a/io-sim/src/Control/Monad/IOSim/STM.hs +++ b/io-sim/src/Control/Monad/IOSim/STM.hs @@ -149,9 +149,7 @@ tryReadTBQueueDefault (TBQueue queue _size) = do return (Just x) [] -> case reverse ys of - [] -> do - writeTVar queue $! (xs, r', ys, w) - return Nothing + [] -> return Nothing -- NB. lazy: we want the transaction to be -- short, otherwise it will conflict diff --git a/io-sim/test/Test/Control/Monad/IOSim.hs b/io-sim/test/Test/Control/Monad/IOSim.hs index 913f5834..63284477 100644 --- a/io-sim/test/Test/Control/Monad/IOSim.hs +++ b/io-sim/test/Test/Control/Monad/IOSim.hs @@ -184,6 +184,10 @@ tests = [ testProperty "empties the queue" prop_flushTQueueEmpties , testProperty "maintains FIFO order" prop_flushTQueueOrder ] + , testGroup "tryReadTBQueue" + [ testProperty "works correctly when the queue is empty IO" prop_tryReadEmptyTBQueue_IO + , testProperty "works correctly when the queue is empty IOSim" prop_tryReadEmptyTBQueue_IOSim + ] ] ] @@ -1412,6 +1416,24 @@ writeAndFlushQueue entries = forM_ entries $ writeTQueue q flushTQueue q +prop_tryReadEmptyTBQueue_IO :: Bool -> Property +prop_tryReadEmptyTBQueue_IO sndRead = + ioProperty $ tryReadEmptyTBQueue sndRead + +prop_tryReadEmptyTBQueue_IOSim :: Bool -> Property +prop_tryReadEmptyTBQueue_IOSim sndRead = + runSimOrThrow $ tryReadEmptyTBQueue sndRead + +tryReadEmptyTBQueue :: MonadSTM m => Bool -> m Property +tryReadEmptyTBQueue sndRead = atomically $ do + q <- newTBQueue 10 + _ <- tryReadTBQueue q + writeTBQueue q () + when sndRead $ void $ tryReadTBQueue q + l <- lengthTBQueue q + + pure $ l === if sndRead then 0 else 1 + -- -- Utils --