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
|
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
import Data.Default
import Data.Int
import Data.Word
import Data.Monoid
import Data.Complex
import System.Locale
import qualified Data.Sequence as Seq
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.IntMap as IM
import qualified Data.IntSet as IS
import Data.Tree (Tree(..))
import Control.Monad (when)
import Control.Monad.Reader
import Data.IORef
import System.Exit (exitFailure)
import System.IO
newtype Test a = Test{ unTest :: ReaderT (IORef Int) IO a }
deriving (Functor, Applicative, Monad, MonadIO, MonadReader (IORef Int))
runTest :: (MonadIO m) => Test a -> m a
runTest t = liftIO $ do
hSetBuffering stdout LineBuffering
r <- newIORef 1
runReaderT (unTest t) r
instance (Default a) => Default (Test a) where
def = return def
withRef :: (IORef Int -> IO a) -> Test a
withRef f = do
r <- ask
liftIO (f r)
planTests :: Int -> Test ()
planTests n = liftIO $ do
putStrLn $ "1.." ++ show n
ok :: Bool -> String -> Test ()
ok b s = withRef $ \r -> do
c <- atomicModifyIORef r ((,) =<< succ)
putStrLn $ (if b then "" else "not ") ++ "ok " ++ show c ++ " - " ++ s
when (not b)
exitFailure
is {-, isNot-} :: (Show a, Eq a) => a -> a -> Test ()
is x y = ok (x == y) (show x ++ " == " ++ show y)
-- isNot x y = ok (x /= y) (show x ++ " /= " ++ show y)
-- diag :: String -> Test ()
-- diag s = liftIO $ do
-- putStrLn $ "# " ++ s
main :: IO ()
main = runTest $ do
planTests 37
sequence_ [def, liftIO def, return ()]
is (def (length :: [a] -> Int)) (0 :: Int)
is def ()
is def (Nothing :: Maybe (Int, Ordering, [Float]))
is def ""
is def (S.empty :: S.Set ())
is def (M.empty :: M.Map () ())
is def IS.empty
is def (IM.empty :: IM.IntMap ())
is def (Seq.empty :: Seq.Seq ())
is def (Node (0 :: Complex Float) [])
is def EQ
is def (Any False)
is def (All True)
is def (Last Nothing :: Last ())
is def (First Nothing :: First ())
is def (Sum (0 :: Integer))
is def (Product (1 :: Rational))
is def (0 :: Int)
is def (0 :: Integer)
is def (0 :: Float)
is def (0 :: Double)
is def (0 :: Rational)
is def (0 :: Complex Double)
is def (0 :: Int8)
is def (0 :: Int16)
is def (0 :: Int32)
is def (0 :: Int64)
is def (0 :: Word)
is def (0 :: Word8)
is def (0 :: Word16)
is def (0 :: Word32)
is def (0 :: Word64)
is def ((def, def) :: ((), Maybe ((), ())))
is def ((def, def, def) :: ((), Maybe ((), ()), [Ordering]))
is def ((def, def, def, def) :: ((), Maybe ((), ()), [Ordering], Float))
is def ((def, def, def, def, def, def, def) :: ((), (), (), (), (), (), ()))
is def defaultTimeLocale
|
