tryReadTBQueueDefault: fix bug when returning Nothing

Author: amesgen

io-sim/CHANGELOG.md

@@ -22,6 +22,7 @@
   - `selectTraceEventsSayWithTime'`
   is more general.  These functions now accepts trace with any result, rather
   than one that finishes with `SimResult`.
+- Fixed `tryReadTBQueue` when returning `Nothing`.
 
 ## 1.6.0.0
 

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

@@ -192,6 +192,10 @@ tests =
       , testProperty "maintains FIFO order IO" prop_flushTBQueueOrder_IO
       , testProperty "maintains FIFO order IOSim" prop_flushTBQueueOrder_IOSim
       ]
+    , 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
+      ]
     ]
   ]
 
@@ -1464,6 +1468,24 @@ writeAndFlushTBQueue entries =
     forM_ entries $ writeTBQueue q
     flushTBQueue 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
 --