Skip to content

Commit

Permalink
io-sim:test - refactored traceNoDuplicates
Browse files Browse the repository at this point in the history
Refactored `traceNoDuplicates` so that `GHC` doesn't put `r` outside of
the function.  This could also be achieved with `-fno-full-laziness`.
  • Loading branch information
coot committed Jan 8, 2025
1 parent 000874c commit c035dea
Showing 1 changed file with 23 additions and 7 deletions.
30 changes: 23 additions & 7 deletions io-sim/test/Test/Control/Monad/IOSimPOR.hs
Original file line number Diff line number Diff line change
Expand Up @@ -434,15 +434,31 @@ doit n = do
threadDelay 1
readTVarIO r


traceNoDuplicates :: (Testable prop1, Show a1) => ((a1 -> a2 -> a2) -> prop1) -> Property
traceNoDuplicates k = r `pseq` (k addTrace .&&. maximum (traceCounts ()) == 1)
traceNoDuplicates :: forall a b.
(Show a)
=> ((a -> b -> b) -> Property)
-> Property
-- this NOINLINE pragma is useful for debugging if `r` didn't flow outside of
-- `traceNoDuplicate`.
{-# NOINLINE traceNoDuplicates #-}
traceNoDuplicates k = unsafePerformIO $ do
r <- newIORef (Map.empty :: Map String Int)
return $ r `pseq`
(k (addTrace r) .&&. counterexample "trace counts" (maximum (Map.elems (traceCounts r)) === 1))
where
r = unsafePerformIO $ newIORef (Map.empty :: Map String Int)
addTrace t x = unsafePerformIO $ do
atomicModifyIORef r (\m->(Map.insertWith (+) (show t) 1 m,()))
addTrace :: IORef (Map String Int) -> a -> b -> b
addTrace r t x = unsafePerformIO $ do
let s = show t
atomicModifyIORef r
(\m->
let m' = Map.insertWith (+) s 1 m
in (m', ())
)
return x
traceCounts () = unsafePerformIO $ Map.elems <$> readIORef r

traceCounts :: IORef (Map String Int) -> Map String Int
traceCounts r = unsafePerformIO $ readIORef r


-- | Checks that IOSimPOR is capable of analysing an infinite simulation
-- lazily.
Expand Down

0 comments on commit c035dea

Please sign in to comment.