How can I prevent QuickCheck from catching all exceptions? - testing

Question

The QuickCheck library seems to catch all exceptions that are thrown when testing a property. In particular, this behavior prevents me from putting a time limit on the entire QuickCheck computation. For example:
module QuickCheckTimeout where
import System.Timeout (timeout)
import Control.Concurrent (threadDelay)
import Test.QuickCheck (quickCheck, within, Property)
import Test.QuickCheck.Monadic (monadicIO, run, assert)
-- use threadDelay to simulate a slow computation
prop_slow_plus_zero_right_identity :: Int -> Property
prop_slow_plus_zero_right_identity i = monadicIO $ do
run (threadDelay (100000 * i))
assert (i + 0 == i)
runTests :: IO ()
runTests = do
result <- timeout 3000000 (quickCheck prop_slow_plus_zero_right_identity)
case result of
Nothing -> putStrLn "timed out!"
Just _ -> putStrLn "completed!"
Because QuickCheck catches all the exceptions, timeout breaks: it doesn't actually abort the computation! Instead, QuickCheck treats the property as having failed, and tries to shrink the input that caused the failure. This shrinking process is then not run with a time bound, causing the total time used by the computation to exceed the prescribed time limit.
One might think I could use QuickCheck's within combinator to bound the computation time. (within treats a property as having failed if it doesn't finish within the given time limit.) However, within doesn't quite do what I want, since QuickCheck still tries to shrink the input that caused the failure, a process that can take far too long. (What could alternatively work for me is a version of within that prevents QuickCheck from trying to shrink the inputs to a property that failed because it didn't finish within the given time limit.)
How can I prevent QuickCheck from catching all exceptions?

Answer 1

Since QuickCheck does the right thing when the user manually interrupts the test by pressing Ctrl+C, you might be able to work around this issue by writing something similar to timeout, but that throws an asynchroneous UserInterrupt exception instead of a custom exception type.
This is pretty much a straight copy-and-paste job from the source of System.Timeout:
import Control.Concurrent
import Control.Exception
timeout' n f = do
pid <- myThreadId
bracket (forkIO (threadDelay n >> throwTo pid UserInterrupt))
(killThread)
(const f)
With this approach, you'll have to use quickCheckResult and check the failure reason to detect whether the test timed out or not. It seems to work decent enough:
> runTests
*** Failed! Exception: 'user interrupt' (after 13 tests):
16

Answer 2

Maybe the chasingbottoms package would be useful? http://hackage.haskell.org/packages/archive/ChasingBottoms/1.3.0.3/doc/html/Test-ChasingBottoms-TimeOut.html

Answer 3

Not answering the main question, but your suggested alternative:
What could alternatively work for me is a version of within that prevents QuickCheck from trying to shrink the inputs to a property that failed because it didn't finish within the given time limit
There is noShrinking which should work for that:
https://hackage.haskell.org/package/QuickCheck/docs/Test-QuickCheck.html#v:noShrinking
As a downside, this will disable shrinking also if the tests fails for other reasons besides the timeout.