@@ -1,3 +1,4 @@
1+{-# LANGUAGE BangPatterns #-}
12{-# LANGUAGE ScopedTypeVariables #-}
23{-# LANGUAGE NamedFieldPuns #-}
34module Main where
@@ -6,6 +7,7 @@ import Data.Marshalling
67
78import Data.Terminfo.Eval
89import Data.Terminfo.Parse
10+import Control.DeepSeq
911
1012import qualified System.Console.Terminfo as Terminfo
1113
@@ -87,6 +89,7 @@ from_capname ti name = fromJust $ Terminfo.getCapability ti (Terminfo.tiGetStr n
8789
8890main = do
8991 run_test $ do
92+ eval_buffer :: Ptr Word8 <- liftIO $ mallocBytes (1024 * 1024) -- Should be big enough for all termcaps ;-)
9093 forM_ terminals_of_interest $ \term_name -> do
9194 liftIO $ putStrLn $ "testing parsing of caps for terminal: " ++ term_name
9295 mti <- liftIO $ try $ Terminfo.setupTerm term_name
@@ -98,32 +101,33 @@ main = do
98101 liftIO $ putStrLn $ "\tevaluating cap: " ++ cap_name
99102 case Terminfo.getCapability ti (Terminfo.tiGetStr cap_name) of
100103 Just cap_def -> do
101− _ <- verify ( "\teval cap " ++ cap_name ++ " -> " ++ show cap_def )
102− ( verify_eval_cap cap_def )
104+ let parse_result = parse_cap_expression cap_def
105+ let test_name = "\teval cap " ++ cap_name ++ " -> " ++ show cap_def
106+ _ <- case parse_result of
107+ Left error -> verify test_name ( liftResult $ failed { reason = "prase error " ++ show error } )
108+ Right !cap_expr -> verify test_name ( verify_eval_cap eval_buffer cap_expr )
103109 return ()
104110 Nothing -> do
105111 return ()
106112 return ()
107113 return ()
108114
109−verify_eval_cap cap_string
110− = case parse_cap_expression cap_string of
111− Left error ->
112− liftResult $ failed { reason = "parse error " ++ show error }
113− Right expr ->
114− forAll (vector 9) $ \input_values ->
115− let byte_count = cap_expression_required_bytes expr input_values
116− in liftIOResult $ do
117− start_ptr :: Ptr Word8 <- mallocBytes (fromEnum byte_count)
118− end_ptr <- serialize_cap_expression expr input_values start_ptr
119− free start_ptr
120− case end_ptr `minusPtr` start_ptr of
121− count | count < 0 ->
122− return $ failed { reason = "End pointer before start pointer." }
123− | toEnum count > byte_count ->
124− return $ failed { reason = "End pointer past end of buffer by "
125− ++ show (toEnum count - byte_count)
126− }
127− | otherwise ->
128− return succeeded
115+{-# NOINLINE verify_eval_cap #-}
116+verify_eval_cap :: Ptr Word8 -> CapExpression -> Int -> Property
117+verify_eval_cap eval_buffer expr !junk_int = do
118+ forAll (vector 9) $ \input_values ->
119+ let !byte_count = cap_expression_required_bytes expr input_values
120+ in liftIOResult $ do
121+ let start_ptr :: Ptr Word8 = eval_buffer
122+ forM_ [0..100] $ \i -> serialize_cap_expression expr input_values start_ptr
123+ end_ptr <- serialize_cap_expression expr input_values start_ptr
124+ case end_ptr `minusPtr` start_ptr of
125+ count | count < 0 ->
126+ return $ failed { reason = "End pointer before start pointer." }
127+ | toEnum count > byte_count ->
128+ return $ failed { reason = "End pointer past end of buffer by "
129+ ++ show (toEnum count - byte_count)
130+ }
131+ | otherwise ->
132+ return succeeded
129133