git.iko.soy/vty
on simplify-attr help sign in
vty/test/VerifyEvalTerminfoCaps.hs
91 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
28-- parsable.
29capsOfInterest =
30 [ "cup"
31 , "sc"
32 , "rc"
33 , "setf"
34 , "setb"
35 , "setaf"
36 , "setab"
37 , "op"
38 , "cnorm"
39 , "civis"
40 , "smcup"
41 , "rmcup"
42 , "clear"
43 , "hpa"
44 , "vpa"
45 , "sgr"
46 , "sgr0"
47 ]
49fromCapname ti name = fromJust $ Terminfo.getCapability ti (Terminfo.tiGetStr name)
51tests :: IO [Test]
52tests = do
53 -- 1 MB should be big enough for any termcaps ;-)
54 evalBuffer :: Ptr Word8 <- mallocBytes (1024 * 1024)
55 fmap concat $ forM terminalsOfInterest $ \termName -> do
56 putStrLn $ "adding tests for terminal: " ++ termName
57 mti <- try $ Terminfo.setupTerm termName
58 case mti of
59 Left (_e :: SomeException)
60 -> return []
61 Right ti -> do
62 fmap concat $ forM capsOfInterest $ \capName -> do
63 case Terminfo.getCapability ti (Terminfo.tiGetStr capName) of
64 Just capDef -> do
65 putStrLn $ "\tadding test for cap: " ++ capName
66 let testName = termName ++ "(" ++ capName ++ ")"
67 case parseCapExpression capDef of
68 Left error -> return [verify testName (failed {reason = "parse error " ++ show error})]
69 Right !cap_expr -> return [verify testName (verifyEvalCap evalBuffer cap_expr)]
70 Nothing -> do
71 return []
73{-# NOINLINE verifyEvalCap #-}
74verifyEvalCap :: Ptr Word8 -> CapExpression -> Int -> Property
75verifyEvalCap evalBuffer expr !junkInt = do
76 forAll (vector 9) $ \inputValues ->
77 let write = writeCapExpr expr inputValues
78 !byteCount = getBound write
79 in liftIOResult $ do
80 let startPtr :: Ptr Word8 = evalBuffer
81 forM_ [0..100] $ \i -> runWrite write startPtr
82 endPtr <- runWrite write startPtr
83 case endPtr `minusPtr` startPtr of
84 count | count < 0 ->
85 return $ failed { reason = "End pointer before start pointer." }
86 | toEnum count > byteCount ->
87 return $ failed { reason = "End pointer past end of buffer by "
88 ++ show (toEnum count - byteCount)
89 }
90 | otherwise ->
91 return succeeded