git.iko.soy/vty
on 5.3 help sign in
vty/test/VerifyEvalTerminfoCaps.hs
90 lines 3.2 kB history raw
1{-# LANGUAGE BangPatterns #-}
2{-# LANGUAGE NamedFieldPuns #-}
3module VerifyEvalTerminfoCaps where
5import Blaze.ByteString.Builder.Internal.Write (runWrite, getBound)
6import Data.Terminfo.Eval
7import Data.Terminfo.Parse
8import Control.DeepSeq
10import qualified System.Console.Terminfo as Terminfo
12import Verify
13import Verify.Graphics.Vty.Output
15import Control.Applicative ( (<$>) )
16import Control.Exception ( try, SomeException(..) )
18import Control.Monad ( mapM_, forM, forM_ )
20import Data.Maybe ( fromJust )
21import Data.Word
23import Foreign.Marshal.Alloc (mallocBytes)
24import Foreign.Ptr (Ptr, minusPtr)
25import Numeric
27-- If a terminal defines one of the caps then it's expected to be parsable.
28capsOfInterest =
29 [ "cup"
30 , "sc"
31 , "rc"
32 , "setf"
33 , "setb"
34 , "setaf"
35 , "setab"
36 , "op"
37 , "cnorm"
38 , "civis"
39 , "smcup"
40 , "rmcup"
41 , "clear"
42 , "hpa"
43 , "vpa"
44 , "sgr"
45 , "sgr0"
46 ]
48fromCapname ti name = fromJust $ Terminfo.getCapability ti (Terminfo.tiGetStr name)
50tests :: IO [Test]
51tests = do
52 evalBuffer :: Ptr Word8 <- mallocBytes (1024 * 1024) -- Should be big enough for any termcaps ;-)
53 fmap concat $ forM terminalsOfInterest $ \termName -> do
54 putStrLn $ "adding tests for terminal: " ++ termName
55 mti <- try $ Terminfo.setupTerm termName
56 case mti of
57 Left (_e :: SomeException)
58 -> return []
59 Right ti -> do
60 fmap concat $ forM capsOfInterest $ \capName -> do
61 case Terminfo.getCapability ti (Terminfo.tiGetStr capName) of
62 Just capDef -> do
63 putStrLn $ "\tadding test for cap: " ++ capName
64 let testName = termName ++ "(" ++ capName ++ ")"
65 case parseCapExpression capDef of
66 Left error -> return [verify testName (failed {reason = "parse error " ++ show error})]
67 Right !cap_expr -> return [verify testName (verifyEvalCap evalBuffer cap_expr)]
68 Nothing -> do
69 return []
71{-# NOINLINE verifyEvalCap #-}
72verifyEvalCap :: Ptr Word8 -> CapExpression -> Int -> Property
73verifyEvalCap evalBuffer expr !junkInt = do
74 forAll (vector 9) $ \inputValues ->
75 let write = writeCapExpr expr inputValues
76 !byteCount = getBound write
77 in liftIOResult $ do
78 let startPtr :: Ptr Word8 = evalBuffer
79 forM_ [0..100] $ \i -> runWrite write startPtr
80 endPtr <- runWrite write startPtr
81 case endPtr `minusPtr` startPtr of
82 count | count < 0 ->
83 return $ failed { reason = "End pointer before start pointer." }
84 | toEnum count > byteCount ->
85 return $ failed { reason = "End pointer past end of buffer by "
86 ++ show (toEnum count - byteCount)
87 }
88 | otherwise ->
89 return succeeded