Skip to content

Commit

Permalink
feature: emit GHC events on test start and completion
Browse files Browse the repository at this point in the history
  • Loading branch information
edmundnoble committed Apr 7, 2024
1 parent 21ed34d commit dbc4b41
Showing 1 changed file with 14 additions and 2 deletions.
16 changes: 14 additions & 2 deletions core/Test/Tasty/Run.hs
Original file line number Diff line number Diff line change
Expand Up @@ -36,6 +36,10 @@ import Prelude -- Silence AMP and FTP import warnings
import Data.Traversable (mapAccumM)
#endif

#if MIN_VERSION_base(4,18,0)
import Debug.Trace(traceEventIO)
#endif

#ifdef MIN_VERSION_unbounded_delays
import Control.Concurrent.Timeout (timeout)
#else
Expand Down Expand Up @@ -398,7 +402,15 @@ createTestActions opts0 tree = do
(parentPath, testDeps) <- ask
let
testPath = parentPath |> name
testAction = executeTest (run opts test) testStatus (lookupOption opts) (lookupOption opts)
testAction = \initializers finalizers -> do
#if MIN_VERSION_base(4,18,0)
let eventName = "Test.Tasty.run " <> show testPath
traceEventIO ("START " <> eventName)
#endif
executeTest (run opts test) testStatus (lookupOption opts) (lookupOption opts) initializers finalizers
#if MIN_VERSION_base(4,18,0)
`finally` traceEventIO ("END " <> eventName)
#endif
pure $ TAction (TestAction {..})

foldResource :: OptionSet -> ResourceSpec a -> (IO a -> Tr) -> Tr
Expand Down Expand Up @@ -436,7 +448,7 @@ createTestActions opts0 tree = do
TGroup _ trees -> mconcat (map collectFinalizers trees)
TAction _ -> mempty

goSeqGroup
goSeqGroup
:: DependencyType
-> Seq Dependency
-> Tr
Expand Down

0 comments on commit dbc4b41

Please sign in to comment.