tryReadTBQueueDefault: fix bug when returning Nothing

Author: amesgen

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:

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

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
 --