From 1397df77bc5d5a6d7ab79403eed8b825465ec645 Mon Sep 17 00:00:00 2001 From: Mateusz Galazyn Date: Tue, 30 Apr 2024 15:09:57 +0200 Subject: [PATCH] Add watchdog for watchdogs --- src/Hedgehog/Extras/Test/TestWatchdog.hs | 6 +++--- test/Hedgehog/Extras/Test/TestWatchdogSpec.hs | 4 ++-- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/src/Hedgehog/Extras/Test/TestWatchdog.hs b/src/Hedgehog/Extras/Test/TestWatchdog.hs index 7461106c..87935a7b 100644 --- a/src/Hedgehog/Extras/Test/TestWatchdog.hs +++ b/src/Hedgehog/Extras/Test/TestWatchdog.hs @@ -146,9 +146,9 @@ runWithWatchdog config testCase = do -- | Execute a test case with a watchdog. runWithWatchdog_ :: HasCallStack => MonadBaseControl IO m - => WatchdogConfig -- ^ configuration - -> (HasCallStack => m a) -- ^ a test case to be wrapped in watchdog - -> m a + => WatchdogConfig -- ^ configuration + -> (HasCallStack => m a) -- ^ a test case to be wrapped in watchdog + -> m a runWithWatchdog_ config testCase = runWithWatchdog config (const testCase) -- | Execute a test case with watchdog with default config. diff --git a/test/Hedgehog/Extras/Test/TestWatchdogSpec.hs b/test/Hedgehog/Extras/Test/TestWatchdogSpec.hs index 1c6ced88..63fdff66 100644 --- a/test/Hedgehog/Extras/Test/TestWatchdogSpec.hs +++ b/test/Hedgehog/Extras/Test/TestWatchdogSpec.hs @@ -24,7 +24,7 @@ import qualified System.Process as P -- | Check that watchdog kills test case which waits without an end hprop_check_watchdog_kills_hanged_thread :: Property -hprop_check_watchdog_kills_hanged_thread = H.propertyOnce $ do +hprop_check_watchdog_kills_hanged_thread = H.propertyOnce $ runWithWatchdog_ (WatchdogConfig 5) $ do let watchdogCfg = WatchdogConfig 1 childTid <- H.newEmptyMVar tripwire <- H.makeTripwire @@ -46,7 +46,7 @@ hprop_check_watchdog_kills_hanged_thread = H.propertyOnce $ do -- - a process waiting forever -- - a child threads waiting hprop_check_watchdog_kills_hanged_thread_with_its_children :: Property -hprop_check_watchdog_kills_hanged_thread_with_its_children = H.propertyOnce $ do +hprop_check_watchdog_kills_hanged_thread_with_its_children = H.propertyOnce $ runWithWatchdog_ (WatchdogConfig 5) $ do let watchdogCfg = WatchdogConfig 1 childTid <- H.newEmptyMVar grandChildTid1 <- H.newEmptyMVar