Skip to content

Commit c035dea

Browse files
committed
io-sim:test - refactored traceNoDuplicates
Refactored `traceNoDuplicates` so that `GHC` doesn't put `r` outside of the function. This could also be achieved with `-fno-full-laziness`.
1 parent 000874c commit c035dea

File tree

1 file changed

+23
-7
lines changed

1 file changed

+23
-7
lines changed

io-sim/test/Test/Control/Monad/IOSimPOR.hs

Lines changed: 23 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -434,15 +434,31 @@ doit n = do
434434
threadDelay 1
435435
readTVarIO r
436436

437-
438-
traceNoDuplicates :: (Testable prop1, Show a1) => ((a1 -> a2 -> a2) -> prop1) -> Property
439-
traceNoDuplicates k = r `pseq` (k addTrace .&&. maximum (traceCounts ()) == 1)
437+
traceNoDuplicates :: forall a b.
438+
(Show a)
439+
=> ((a -> b -> b) -> Property)
440+
-> Property
441+
-- this NOINLINE pragma is useful for debugging if `r` didn't flow outside of
442+
-- `traceNoDuplicate`.
443+
{-# NOINLINE traceNoDuplicates #-}
444+
traceNoDuplicates k = unsafePerformIO $ do
445+
r <- newIORef (Map.empty :: Map String Int)
446+
return $ r `pseq`
447+
(k (addTrace r) .&&. counterexample "trace counts" (maximum (Map.elems (traceCounts r)) === 1))
440448
where
441-
r = unsafePerformIO $ newIORef (Map.empty :: Map String Int)
442-
addTrace t x = unsafePerformIO $ do
443-
atomicModifyIORef r (\m->(Map.insertWith (+) (show t) 1 m,()))
449+
addTrace :: IORef (Map String Int) -> a -> b -> b
450+
addTrace r t x = unsafePerformIO $ do
451+
let s = show t
452+
atomicModifyIORef r
453+
(\m->
454+
let m' = Map.insertWith (+) s 1 m
455+
in (m', ())
456+
)
444457
return x
445-
traceCounts () = unsafePerformIO $ Map.elems <$> readIORef r
458+
459+
traceCounts :: IORef (Map String Int) -> Map String Int
460+
traceCounts r = unsafePerformIO $ readIORef r
461+
446462

447463
-- | Checks that IOSimPOR is capable of analysing an infinite simulation
448464
-- lazily.

0 commit comments

Comments
 (0)