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