[Brought the library up to date. Nils Anders Danielsson **20100602173134 Ignore-this: 3a2e8f73cfc7c8c4f139d2c6b68f5ee7 + It now works with GHC 6.12, Haddock 2.6.0, base 4, syb 0.1 and QuickCheck 2. ] { hunk ./ChasingBottoms.cabal 62 - [@> timeOut' 1 (reverse [1..5\]) >>= print@] @Value [5,4,3,2,1]@ + [@> timeOut' 1 (reverse [1..5\])@] @Value [5,4,3,2,1]@ hunk ./ChasingBottoms.cabal 64 - [@> timeOut' 1 (reverse [1..\]) >>= print@] @NonTermination@ + [@> timeOut' 1 (reverse [1..\])@] @NonTermination@ hunk ./ChasingBottoms.cabal 87 - [@> timeOutMicro 100 (print $ filter ((== 1) . (\`mod\` 83)) primes) >>= print@] @[167,499NonTermination@ + [@> timeOutMicro 100 (print $ filter ((== 1) . (\`mod\` 83)) primes)@] @[167,499,9NonTermination@ hunk ./ChasingBottoms.cabal 89 - [@> timeOutMicro 100 (print $ take 4 $ filter ((== 1) . (\`mod\` 83)) primes) >>= print@] @[167,499,997NonTermination@ + [@> timeOutMicro 100 (print $ take 6 $ filter ((== 1) . (\`mod\` 83)) primes)@] @[167,499,997,1163,1993NonTermination@ hunk ./ChasingBottoms.cabal 91 - [@> timeOutMicro 100 (print $ take 4 $ filter ((== 1) . (\`mod\` 83)) primes) >>= print@] @[167,499,997,1163]@ + [@> timeOutMicro 100 (print $ take 6 $ filter ((== 1) . (\`mod\` 83)) primes)@] @[167,499,997,1163,1993,2657]@ hunk ./ChasingBottoms.cabal 95 - All the type annotations above are required. - . hunk ./ChasingBottoms.cabal 100 - The code has been tested under GHC 6.8. Most parts can probably be + The code has been tested under GHC 6.12. Most parts can probably be hunk ./ChasingBottoms.cabal 106 -tested-with: GHC == 6.8.2 -cabal-version: >= 1.2 && < 2 +tested-with: GHC == 6.12.1 +cabal-version: == 1.8.* hunk ./ChasingBottoms.cabal 110 -flag small_base - description: Choose the new smaller, split-up base package. - hunk ./ChasingBottoms.cabal 123 - build-depends: QuickCheck >= 1.1 && < 2, - mtl >= 1.1 && < 2 - if flag(small_base) - build-depends: base >= 3 && < 4, - containers >= 0.1 && < 1, - random >= 1 && < 2 - else - build-depends: base >= 2 && < 3 + build-depends: QuickCheck == 2.1.*, + mtl == 1.1.*, + base == 4.*, + containers == 0.3.*, + random == 1.0.*, + syb >= 0.1.0.2 && < 0.2 hunk ./Test/ChasingBottoms/Approx.hs 1 -{-# OPTIONS -fglasgow-exts -fallow-undecidable-instances #-} +{-# LANGUAGE ScopedTypeVariables, + FlexibleInstances, UndecidableInstances #-} hunk ./Test/ChasingBottoms/Approx/Tests.hs 1 -{-# OPTIONS -fglasgow-exts #-} +{-# LANGUAGE ScopedTypeVariables, RankNTypes, + DeriveDataTypeable #-} hunk ./Test/ChasingBottoms/ApproxShow.hs 1 -{-# OPTIONS -fglasgow-exts -fallow-undecidable-instances #-} +{-# LANGUAGE ScopedTypeVariables, + FlexibleInstances, UndecidableInstances #-} hunk ./Test/ChasingBottoms/ApproxShow.hs 126 -showCon a = showString $ showConstr' a - where - showConstr' a - | dataTypeRep (dataTypeOf a) == dataTypeRep (dataTypeOf 'c') = - "'" ++ showConstr (toConstr a) ++ "'" - | otherwise = showConstr $ toConstr a +showCon a = showString $ showConstr $ toConstr a hunk ./Test/ChasingBottoms/ApproxShow/Tests.hs 1 -{-# OPTIONS -fglasgow-exts #-} +{-# LANGUAGE DeriveDataTypeable #-} hunk ./Test/ChasingBottoms/ContinuousFunctions.hs 1 -{-# OPTIONS -fglasgow-exts #-} +{-# LANGUAGE RankNTypes, ScopedTypeVariables, + GeneralizedNewtypeDeriving, DeriveDataTypeable #-} hunk ./Test/ChasingBottoms/ContinuousFunctions.hs 22 --- Note: /This module is unfinished and experimental. However, I do --- not think that I will ever finish it, so I have released it in its --- current state. The documentation below may not be completely --- correct. The source code lists some things which should be --- addressed./ +-- Note: /This module is unfinished and experimental. However, I do not think that I will ever finish it, so I have released it in its current state. The documentation below may not be completely correct. The source code lists some things which should be addressed./ hunk ./Test/ChasingBottoms/ContinuousFunctions.hs 57 --- functions. However, say that we want to test that @x --- 'Test.ChasingBottoms.SemanticOrd.<=!' y@ implies that @f x --- 'Test.ChasingBottoms.SemanticOrd.<=!' f y@ for all functions @f@ --- (whenever the latter expression returns a total result). This --- property is not valid in the presence of non-monotone functions. +-- functions. However, say that we want to test that @x 'O.<=!' y@ +-- implies that @f x 'O.<=!' f y@ for all functions @f@ (whenever the +-- latter expression returns a total result). This property is not +-- valid in the presence of non-monotone functions. hunk ./Test/ChasingBottoms/ContinuousFunctions.hs 146 -import Test.QuickCheck +import Test.QuickCheck hiding ((><), listOf) hunk ./Test/ChasingBottoms/ContinuousFunctions.hs 158 +import qualified Test.ChasingBottoms.SemanticOrd as O + hunk ./Test/ChasingBottoms/ContinuousFunctions.hs 216 -matchFlat :: Arbitrary a => MakePM a +matchFlat :: CoArbitrary a => MakePM a hunk ./Test/ChasingBottoms/ContinuousFunctions.hs 241 - -- seq added since toConstr is not strict enough for - -- one-constructor data types. (Bug reported; should be fixed in the - -- CVS repository.) hunk ./Test/ChasingBottoms/ContinuousFunctions.hs 242 - toVariant x = x `seq` case constrRep (toConstr x) of - AlgConstr n -> variant (n - 1) -- n >= 1. - IntConstr i -> coarbitrary i - FloatConstr d -> coarbitrary d - StringConstr s -> nonBottomError "match: Encountered StringConstr." + toVariant x = case constrRep (toConstr x) of + AlgConstr n -> variant (n - 1) -- n >= 1. + IntConstr i -> coarbitrary i + FloatConstr d -> coarbitrary d + CharConstr s -> nonBottomError "match: Encountered CharConstr." hunk ./Test/ChasingBottoms/ContinuousFunctions.hs 306 - (_, pms') <- partition 9 pms + (_, pms') <- partition' 9 pms hunk ./Test/ChasingBottoms/ContinuousFunctions.hs 308 - (use, keep) <- partition 2 pms' + (use, keep) <- partition' 2 pms' hunk ./Test/ChasingBottoms/ContinuousFunctions.hs 334 -partition :: Int -> Seq a -> Gen (Seq a, Seq a) -partition freq ss = case viewl ss of +partition' :: Int -> Seq a -> Gen (Seq a, Seq a) +partition' freq ss = case viewl ss of hunk ./Test/ChasingBottoms/ContinuousFunctions.hs 338 - (ys, zs) <- partition freq xs + (ys, zs) <- partition' freq xs hunk ./Test/ChasingBottoms/ContinuousFunctions.hs 445 - StringRep -> nonBottomError "makeResult: StringRep." + CharRep -> nonBottomError "makeResult: CharRep." hunk ./Test/ChasingBottoms/ContinuousFunctions/Tests.hs 1 -{-# OPTIONS -fglasgow-exts #-} +{-# LANGUAGE ScopedTypeVariables, DeriveDataTypeable #-} hunk ./Test/ChasingBottoms/ContinuousFunctions/Tests.hs 14 +import Test.ChasingBottoms.TestUtilities hunk ./Test/ChasingBottoms/ContinuousFunctions/Tests.hs 20 -import Test.QuickCheck.Batch (run, TestOptions(..), TestResult(..)) hunk ./Test/ChasingBottoms/ContinuousFunctions/Tests.hs 21 +import Control.Arrow hunk ./Test/ChasingBottoms/ContinuousFunctions/Tests.hs 77 - result <- run t testOptions + result <- run t hunk ./Test/ChasingBottoms/ContinuousFunctions/Tests.hs 82 - apply test (TestOk _ n args) = test n args - apply _ _ = (False, "Test failed.") - - testOptions = TestOptions { no_of_tests = 1000 - , length_of_tests = 0 -- No time limit. - , debug_tests = False - } - + apply test (Success labels) = test labels + apply _ _ = (False, "Test failed.") hunk ./Test/ChasingBottoms/ContinuousFunctions/Tests.hs 85 -spread n args = (uniqueShare >= 3%4, "uniqueShare: " ++ show uniqueShare) - where noUniqueArgs = length . group . sort $ args - uniqueShare = noUniqueArgs % n +spread labels = (uniqueShare >= 3%4, "uniqueShare: " ++ show uniqueShare) + where + noUniqueArgs = length labels + noArgs = sum $ map snd labels + uniqueShare = noUniqueArgs % noArgs hunk ./Test/ChasingBottoms/ContinuousFunctions/Tests.hs 91 -len max avg short n args = +len max avg short labels = hunk ./Test/ChasingBottoms/ContinuousFunctions/Tests.hs 97 - where maxLen = maximum lengths - averageLen = sum lengths % noArgs - noShortLists = genericLength (filter (<= short) lengths) - lengths = map read . concat $ args :: [Integer] - noArgs = toInteger n - shortShare = noShortLists % noArgs + where + lengths = map (read *** toInteger) labels :: [(Integer, Integer)] + noArgs = sum (map snd lengths) + maxLen = maximum $ map fst lengths + averageLen = sum (map (uncurry (*)) lengths) % noArgs + noShortLists = sum . map snd . filter ((<= short) . fst) $ lengths + shortShare = noShortLists % noArgs hunk ./Test/ChasingBottoms/ContinuousFunctions/Tests.hs 117 -prop_lists_have_decent_length = testDistribution (len 20 6 5) $ +prop_lists_have_decent_length = testDistribution (len 20 5 5) $ hunk ./Test/ChasingBottoms/ContinuousFunctions/Tests.hs 201 -viewFun (makeResult :: MakeResult b) (inputs :: [a]) = test $ +viewFun (makeResult :: MakeResult b) (inputs :: [a]) = quickCheck $ hunk ./Test/ChasingBottoms/IsBottom.hs 1 +{-# LANGUAGE ScopedTypeVariables #-} + hunk ./Test/ChasingBottoms/IsBottom.hs 21 -import Control.Exception (catch, throw, Exception(..), evaluate) +import qualified Control.Exception as E hunk ./Test/ChasingBottoms/IsBottom.hs 26 --- @a@ equals bottom and results in an exception which is caught by --- 'isBottom', and this exception is of a certain kind (see below), --- then @'isBottom' a = 'True'@. Other caught exceptions are --- re-thrown. If @a@ never reaches a weak head normal form and --- never throws an exception, then @'isBottom' a@ never terminates. +-- @a@ equals bottom and results in an exception of a certain kind +-- (see below), then @'isBottom' a = 'True'@. If @a@ never reaches a +-- weak head normal form and never throws one of these exceptions, +-- then @'isBottom' a@ never terminates. +-- +-- The exceptions that yield 'True' correspond to \"pure bottoms\", +-- i.e. bottoms that can originate in pure code: +-- +-- * 'E.ArrayException' +-- +-- * 'E.ErrorCall' +-- +-- * 'E.NoMethodError' +-- +-- * 'E.NonTermination' +-- +-- * 'E.PatternMatchFail' +-- +-- * 'E.RecConError' +-- +-- * 'E.RecSelError' +-- +-- * 'E.RecUpdError' hunk ./Test/ChasingBottoms/IsBottom.hs 50 --- The exceptions that yield 'True' are those that correspond to --- \"pure bottoms\", i.e. bottoms that can originate in pure code. --- Assertions are excluded, since their behaviour depends on compiler --- flags (not pure, and a failed assertion should really yield an --- exception and nothing else). The same applies to arithmetic --- exceptions (machine dependent, except possibly for --- 'Control.Exception.DivideByZero', but the value infinity makes that --- case unclear as well). +-- Assertions are excluded, because their behaviour depends on +-- compiler flags (not pure, and a failed assertion should really +-- yield an exception and nothing else). The same applies to +-- arithmetic exceptions (machine dependent, except possibly for +-- 'E.DivideByZero', but the value infinity makes that case unclear as +-- well). hunk ./Test/ChasingBottoms/IsBottom.hs 76 --- | @'nonBottomError' s@ raises an exception ('AssertionFailed') that --- is not caught by 'isBottom'. Use @s@ to describe the exception. +-- | @'nonBottomError' s@ raises an exception ('E.AssertionFailed') +-- that is not caught by 'isBottom'. Use @s@ to describe the +-- exception. hunk ./Test/ChasingBottoms/IsBottom.hs 81 -nonBottomError = throw . AssertionFailed +nonBottomError = E.throw . E.AssertionFailed hunk ./Test/ChasingBottoms/IsBottom.hs 90 --- 'isBottomTimeOut' is subject to all the same scheduling vagaries as --- 'Test.ChasingBottoms.TimeOut.timeOut'. +-- 'isBottomTimeOut' is subject to all the same vagaries as +-- 'T.timeOut'. hunk ./Test/ChasingBottoms/IsBottom.hs 95 - maybeTimeOut (evaluate f) `catch` \e -> case e of - ArithException _ -> throw e - ArrayException _ -> return True - AssertionFailed _ -> throw e - AsyncException _ -> throw e - BlockedOnDeadMVar -> throw e - Deadlock -> throw e - DynException _ -> throw e - ErrorCall _ -> return True - ExitException _ -> throw e - IOException _ -> throw e - NoMethodError _ -> return True - NonTermination -> return True - PatternMatchFail _ -> return True - RecConError _ -> return True - RecSelError _ -> return True - RecUpdError _ -> return True + maybeTimeOut (E.evaluate f) `E.catches` + [ E.Handler (\(_ :: E.ArrayException) -> return True) + , E.Handler (\(_ :: E.ErrorCall) -> return True) + , E.Handler (\(_ :: E.NoMethodError) -> return True) + , E.Handler (\(_ :: E.NonTermination) -> return True) + , E.Handler (\(_ :: E.PatternMatchFail) -> return True) + , E.Handler (\(_ :: E.RecConError) -> return True) + , E.Handler (\(_ :: E.RecSelError) -> return True) + , E.Handler (\(_ :: E.RecUpdError) -> return True) + ] hunk ./Test/ChasingBottoms/IsBottom.hs 115 - T.Exception e -> throw e -- Catch the exception above. + T.Exception e -> E.throw e -- Catch the exception above. addfile ./Test/ChasingBottoms/IsBottom.hs-boot hunk ./Test/ChasingBottoms/IsBottom.hs-boot 1 +module Test.ChasingBottoms.IsBottom where + +bottom :: a hunk ./Test/ChasingBottoms/IsBottom/Tests.hs 1 +{-# LANGUAGE ScopedTypeVariables #-} + hunk ./Test/ChasingBottoms/IsBottom/Tests.hs 17 - (E.evaluate f >> return False) `E.catch` const (return True) + (E.evaluate f >> return False) + `E.catch` (\(_ :: E.SomeException) -> return True) hunk ./Test/ChasingBottoms/IsType.hs 19 +import Data.List hunk ./Test/ChasingBottoms/IsType.hs 35 -isTuple x = if null s then False else head s == ',' - where s = tyConString (con x) +isTuple x = "(," `isPrefixOf` tyConString (con x) hunk ./Test/ChasingBottoms/Nat.hs 1 -{-# OPTIONS -fglasgow-exts #-} +{-# LANGUAGE DeriveDataTypeable #-} hunk ./Test/ChasingBottoms/Nat.hs 19 +import qualified Data.Generics as G hunk ./Test/ChasingBottoms/Nat.hs 27 --- No 'Data.Generics.Basics.Data' instance is provided since the --- implementation should be abstract. +-- No 'G.Data' instance is provided, because the implementation should +-- be abstract. hunk ./Test/ChasingBottoms/Nat.hs 30 --- Could add 'Data.Generics.Basics.Data' instance based on unary --- representation of natural numbers, but that would lead to --- inefficiencies. +-- Could add 'G.Data' instance based on unary representation of +-- natural numbers, but that would lead to inefficiencies. hunk ./Test/ChasingBottoms/Nat.hs 109 + + shrink 0 = [] + shrink n = [n - 1] + +instance CoArbitrary Nat where hunk ./Test/ChasingBottoms/Nat/Tests.hs 1 -{-# OPTIONS -fglasgow-exts #-} +{-# LANGUAGE ScopedTypeVariables #-} hunk ./Test/ChasingBottoms/Nat/Tests.hs 13 -import Test.QuickCheck.Batch hunk ./Test/ChasingBottoms/SemanticOrd.hs 1 -{-# OPTIONS -fglasgow-exts -fallow-undecidable-instances #-} +{-# LANGUAGE ScopedTypeVariables, RankNTypes, + FlexibleInstances, UndecidableInstances #-} hunk ./Test/ChasingBottoms/SemanticOrd/Tests.hs 1 -{-# OPTIONS -fglasgow-exts #-} +{-# LANGUAGE RankNTypes #-} hunk ./Test/ChasingBottoms/SemanticOrd/Tests.hs 12 -import Test.QuickCheck.Batch (run) hunk ./Test/ChasingBottoms/TestUtilities.hs 5 - runQuickCheckTests + run + , runQuickCheckTests hunk ./Test/ChasingBottoms/TestUtilities.hs 28 -import Test.QuickCheck.Batch hunk ./Test/ChasingBottoms/TestUtilities.hs 36 +-- | Runs a single test, using suitable settings. + +run :: Testable p => p -> IO Result +run = quickCheckWithResult (stdArgs { maxSuccess = 1000 + , maxDiscard = 5000 + }) + hunk ./Test/ChasingBottoms/TestUtilities.hs 48 -runQuickCheckTests :: [TestOptions -> IO TestResult] +runQuickCheckTests :: [IO Result] hunk ./Test/ChasingBottoms/TestUtilities.hs 53 - results <- mapM ($ testOptions) tests - mapM_ (putStr . showTR) results + results <- sequence tests + mapM_ (putStrLn . showTR) results hunk ./Test/ChasingBottoms/TestUtilities.hs 57 - ok (TestOk {}) = True - ok (TestExausted {}) = True -- We treat this as OK since the - -- distribution of test data is displayed. - ok (TestFailed {}) = False - ok (TestAborted {}) = False - - testOptions = TestOptions { no_of_tests = 1000 - , length_of_tests = 0 -- No time limit. - , debug_tests = False - } - - showTR (TestOk _ n args) = - "OK, passed " ++ show n ++ " tests.\n" ++ showArgs args - showTR (TestExausted _ n args) = - "Arguments exhausted after " ++ show n ++ " tests.\n" ++ showArgs args - showTR (TestFailed _ _) = "Test failed.\n" - showTR (TestAborted _) = "Test resulted in exception.\n" + ok (Success {}) = True + ok (GaveUp {}) = False + ok (Failure {}) = False + ok (NoExpectedFailure {}) = False hunk ./Test/ChasingBottoms/TestUtilities.hs 62 - showArgs :: [[String]] -> String - showArgs args - | all null args = "" - | otherwise = - unlines - . map (indent . uncurry (++) - . (formatNum *** (concat . intersperse ", "))) - . sortBy (\x y -> compare (fst y) (fst x)) - . map (length &&& head) . group . sort - $ args - where indent = (" " ++) - formatNum = flip shows ": " + showTR (Success {}) = "OK." + showTR (GaveUp { numTests = n }) = + "Gave up after " ++ show n ++ " tests." + showTR (Failure {}) = "Test failed." + showTR (NoExpectedFailure {}) = + "Test did not fail, but it should have." hunk ./Test/ChasingBottoms/TestUtilities.hs 221 - infix 4 ==., <=. - hunk ./Test/ChasingBottoms/TestUtilities.hs 227 - (x <=. y && y <=. x) && x ==. y + ((x <=. y) && (y <=. x)) && x ==. y hunk ./Test/ChasingBottoms/TestUtilities.hs 231 - not (x <=. y && y <=. x) && not (x ==. y) + not ((x <=. y) && (y <=. x)) && not (x ==. y) hunk ./Test/ChasingBottoms/TestUtilities.hs 260 - infix 4 <=. - hunk ./Test/ChasingBottoms/TestUtilities.hs 263 - x <=. y || y <=. x + (x <=. y) || (y <=. x) hunk ./Test/ChasingBottoms/TestUtilities.hs 288 - infix 4 ==., <=., <., >=., >. - hunk ./Test/ChasingBottoms/TestUtilities.hs 292 - (x <. y) == (x <=. y && not (x ==. y)) + (x <. y) == ((x <=. y) && not (x ==. y)) hunk ./Test/ChasingBottoms/TestUtilities.hs 296 - (x >. y) == (x >=. y && not (x ==. y)) + (x >. y) == ((x >=. y) && not (x ==. y)) hunk ./Test/ChasingBottoms/TestUtilities/Generators.hs 1 -{-# OPTIONS -fglasgow-exts #-} +{-# LANGUAGE RankNTypes, DeriveDataTypeable #-} hunk ./Test/ChasingBottoms/TestUtilities/Generators.hs 50 -import Test.QuickCheck.Batch (run) hunk ./Test/ChasingBottoms/TestUtilities/Generators.hs 120 -testGen depth gen = test $ forAll gen $ \n -> +testGen depth gen = quickCheck $ forAll gen $ \n -> hunk ./Test/ChasingBottoms/TestUtilities/Generators.hs 165 - test $ forAll (function coGen gen) $ \f -> + quickCheck $ forAll (function coGen gen) $ \f -> hunk ./Test/ChasingBottoms/TestUtilities/Generators.hs 253 -testGenPair depth gen gen' = test $ +testGenPair depth gen gen' = quickCheck $ hunk ./Test/ChasingBottoms/Tests.hs 1 -{-# OPTIONS -fglasgow-exts #-} +{-# LANGUAGE FlexibleInstances #-} hunk ./Test/ChasingBottoms/TimeOut.hs 1 -{-# OPTIONS -fglasgow-exts #-} +{-# LANGUAGE ScopedTypeVariables, DeriveDataTypeable #-} hunk ./Test/ChasingBottoms/TimeOut.hs 32 +import {-# SOURCE #-} qualified Test.ChasingBottoms.IsBottom as B + hunk ./Test/ChasingBottoms/TimeOut.hs 37 - | Exception E.Exception - deriving (Eq, Show, Typeable) + | Exception E.SomeException + deriving (Show, Typeable) hunk ./Test/ChasingBottoms/TimeOut.hs 43 --- * If the computation terminates before that, then --- @'Value' v@ is returned, where @v@ is the resulting value. Note --- that this value may be equal to bottom, e.g. if @c = 'return' --- 'Test.ChasingBottoms.IsBottom.bottom'@. +-- * If the computation terminates before that, then @'Value' v@ is +-- returned, where @v@ is the resulting value. Note that this +-- value may be equal to bottom, e.g. if @c = 'return' +-- 'B.bottom'@. hunk ./Test/ChasingBottoms/TimeOut.hs 53 +-- +-- Note that a user-defined exception is used to terminate the +-- computation, so if @c@ catches all exceptions, or blocks +-- asynchronous exceptions, then 'timeOut' may fail to function +-- properly. hunk ./Test/ChasingBottoms/TimeOut.hs 71 - ioThread <- forkIO $ (io >>= putMVar mv . Value) - `E.catch` (\e -> case e of - E.DynException d -> case fromDynamic d of - Just Die -> return () -- Thread properly killed. - Nothing -> putException e - _ -> putException e) + ioThread <- forkIO $ + (io >>= putMVar mv . Value) + `E.catch` (\(e :: E.SomeException) -> + case E.fromException e of + Just Die -> return () -- Thread properly killed. + Nothing -> putException e) hunk ./Test/ChasingBottoms/TimeOut.hs 86 --- we cannot kill the thread using killThread, which raises --- @'AsyncException' 'ThreadKilled'@. We use the locally defined type --- 'Die' together with a dynamic exception instead. +-- it seems like a bad idea to kill the thread using killThread, which +-- raises @'AsyncException' 'ThreadKilled'@. We use the locally +-- defined type 'Die' instead. + +data Die = Die deriving (Show, Typeable) hunk ./Test/ChasingBottoms/TimeOut.hs 92 -data Die = Die deriving Typeable +instance E.Exception Die hunk ./Test/ChasingBottoms/TimeOut.hs 94 -killThread' threadId = E.throwDynTo threadId Die +killThread' threadId = E.throwTo threadId Die hunk ./Test/ChasingBottoms/TimeOut.hs 103 --- ensures that @'timeOut'' 1 'Test.ChasingBottoms.IsBottom.bottom'@ --- usually returns @'Exception' \@. (@'timeOut' 1 ('return' --- 'Test.ChasingBottoms.IsBottom.bottom')@ usually returns @'Value' --- 'Test.ChasingBottoms.IsBottom.bottom'@; in other words, the --- computation reaches whnf almost immediately, defeating the purpose --- of the time-out.) +-- ensures that @'timeOut'' 1 'B.bottom'@ usually returns @'Exception' +-- \@. (@'timeOut' 1 ('return' 'B.bottom')@ usually +-- returns @'Value' 'B.bottom'@; in other words, the computation +-- reaches whnf almost immediately, defeating the purpose of the +-- time-out.) }