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