1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
|
{-# LANGUAGE ScopedTypeVariables, FlexibleInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-} -- OK because a test module
module TestUtil
(runTests
,testGen, testRaw
,erroneous, erroneousIO
,(====), (==>)
,ASCIIString(..)
,module X
) where
import Test.QuickCheck
import System.IO.Unsafe
import Text.Show.Functions()
import Control.Concurrent.Extra as X
import Control.Exception.Extra as X
import Control.Monad.Extra as X
import Data.Char as X
import Data.Either.Extra as X
import Data.Function as X
import Data.IORef.Extra as X
import Data.List.Extra as X hiding (union, unionBy)
import Data.List.NonEmpty.Extra as X (NonEmpty(..), (|>), (|:), appendl, appendr, union, unionBy)
import Data.Maybe as X
import Data.Monoid.Extra as X
import Data.Tuple.Extra as X
import Data.Version.Extra as X
import Numeric.Extra as X
import System.Directory.Extra as X
import System.FilePath as X
import System.Info.Extra as X
import System.IO.Extra as X
import System.Process.Extra as X
import System.Time.Extra as X
{-# NOINLINE testCount #-}
testCount :: IORef Int
testCount = unsafePerformIO $ newIORef 0
testGen :: Testable prop => String -> prop -> IO ()
testGen msg prop = testRaw msg $ do
r <- quickCheckResult prop
case r of
Success{} -> pure ()
_ -> errorIO "Test failed"
testRaw :: String -> IO () -> IO ()
testRaw msg test = do
putStrLn msg
test
modifyIORef testCount (+1)
erroneous :: Show a => a -> Bool
erroneous x = unsafePerformIO $ fmap isLeft $ try_ $ evaluate $ length $ show x
erroneousIO :: Show a => IO a -> Bool
erroneousIO x = unsafePerformIO $ fmap isLeft $ try_ $ evaluate . length . show =<< x
(====) :: (Show a, Eq a) => a -> a -> Bool
a ==== b
| a == b = True
| otherwise = error $ "Not equal!\n" ++ show a ++ "\n" ++ show b
runTests :: IO () -> IO ()
runTests t = do
-- ensure that capturing output is robust
hSetBuffering stdout NoBuffering
hSetBuffering stderr NoBuffering
writeIORef testCount 0
t
n <- readIORef testCount
putStrLn $ "Success (" ++ show n ++ " tests)"
instance Testable a => Testable (IO a) where
property = property . unsafePerformIO
-- We only use this property to assert equality as a property
-- And the Show instance is useless (since it may be non-deterministic)
-- So we print out full information on failure
instance (Show a, Eq a) => Eq (IO a) where
a == b = unsafePerformIO $ do
a <- captureOutput $ try_ a
b <- captureOutput $ try_ b
if a == b then pure True else
error $ show ("IO values not equal", a, b)
instance Show (IO a) where
show _ = "<<IO>>"
instance Arbitrary a => Arbitrary (IO a) where
arbitrary = do
(prnt :: Maybe Int, thrw :: Maybe Int, res) <- arbitrary
pure $ do
whenJust prnt print
whenJust thrw (fail . show)
pure res
instance Eq SomeException where
a == b = show a == show b
|
