git.iko.soy/vty
on da635bb help sign in
vty/test/Verify.hs
93 lines 2.6 kB history raw
1{-# LANGUAGE ScopedTypeVariables #-}
2{-# LANGUAGE CPP #-}
3{-# LANGUAGE TypeSynonymInstances #-}
4{-# LANGUAGE FlexibleInstances #-}
5{-# LANGUAGE StandaloneDeriving #-}
6{-# LANGUAGE DisambiguateRecordFields #-}
7{-# LANGUAGE NamedFieldPuns #-}
8module Verify ( module Verify
9 , module Test.QuickCheck
10 , succeeded
11 , failed
12 , result
13 , Result(..)
14 , monadicIO
15 , liftIO
16 , liftBool
17 )
18 where
20import Test.QuickCheck hiding ( Result(..) )
21import qualified Test.QuickCheck as QC
22import Test.QuickCheck.Property
23import Test.QuickCheck.Monadic ( monadicIO )
25import qualified Codec.Binary.UTF8.String as UTF8
27import Control.Monad.State.Strict
29import Data.IORef
30import Data.Word
32import Numeric ( showHex )
34import System.IO
35import System.Random
37type Test = StateT TestState IO
39data TestState = TestState
40 { results_ref :: IORef [QC.Result]
41 }
43run_test :: Test () -> IO ()
44run_test t = do
45 s <- newIORef [] >>= return . TestState
46 s' <- runStateT t s >>= return . snd
47 results <- readIORef $ results_ref s'
48 let fail_results = [ fail_result | fail_result@(QC.Failure {}) <- results ]
49 case fail_results of
50 [] -> putStrLn "state: PASS"
51 rs -> do
52 putStrLn "state: FAIL"
53 putStrLn $ "fail_count: " ++ show (length rs)
55verify :: Testable prop => String -> prop -> Test QC.Result
56verify prop_name prop = do
57 liftIO $ putStrLn $ "verify " ++ prop_name
58 get >>= \s -> do
59 r <- liftIO $ quickCheckResult prop
60 liftIO $ modifyIORef (results_ref s) (\rs -> r : rs)
61 return r
63data SingleColumnChar = SingleColumnChar Char
64 deriving (Show, Eq)
66instance Arbitrary SingleColumnChar where
67 arbitrary = elements $ map SingleColumnChar [toEnum 0x21 .. toEnum 0x7E]
69data DoubleColumnChar = DoubleColumnChar Char
70 deriving (Eq)
72instance Show DoubleColumnChar where
73 show (DoubleColumnChar c) = "(0x" ++ showHex (fromEnum c) "" ++ ") ->" ++ UTF8.encodeString [c]
75instance Arbitrary DoubleColumnChar where
76 arbitrary = elements $ map DoubleColumnChar $
77 [ toEnum 0x3040 .. toEnum 0x3098 ]
78 ++ [ toEnum 0x309B .. toEnum 0xA4CF]
81liftIOResult :: Testable prop => IO prop -> Property
82liftIOResult = morallyDubiousIOProperty
84#if __GLASGOW_HASKELL__ <= 701
85instance Random Word where
86 random g =
87 let (i :: Int, g') = random g
88 in (toEnum i, g')
89 randomR (l,h) g =
90 let (i :: Int, g') = randomR (fromEnum l,fromEnum h) g
91 in (toEnum i, g')
92#endif