git.iko.soy/vty
on master help sign in
implement a test for all terminfo based terminals this should support
4b6f75bCorey O'Connor
src/Graphics/Vty.hs+2−1
compare with master
unifiedsplit
@@ -78,13 +78,14 @@ mkVty = mkVtyEscDelay 0
78-- | Set up the state object for using vty. At most one state object should be
78-- | Set up the state object for using vty. At most one state object should be
79-- created at a time. The delay, in microseconds, specifies the period of time to wait for a key
79-- created at a time. The delay, in microseconds, specifies the period of time to wait for a key
80-- following reading ESC from the terminal before considering the ESC key press as a discrete event.
80-- following reading ESC from the terminal before considering the ESC key press as a discrete event.
81+-- \todo move input init into terminal interface
81mkVtyEscDelay :: Int -> IO Vty
82mkVtyEscDelay :: Int -> IO Vty
82mkVtyEscDelay escDelay = do
83mkVtyEscDelay escDelay = do
83 term_info <- Terminfo.setupTermFromEnv
84 term_info <- Terminfo.setupTermFromEnv
84 t <- current_terminal
85 t <- current_terminal
85 reserve_display t
86 reserve_display t
86 (kvar, endi) <- initTermInput escDelay term_info
87 (kvar, endi) <- initTermInput escDelay term_info
87− intMkVty kvar ( endi >> release_display t >> release_device t ) t
88+ intMkVty kvar ( endi >> release_display t >> release_terminal t ) t
88
89
89intMkVty :: IO Event -> IO () -> Terminal -> IO Vty
90intMkVty :: IO Event -> IO () -> Terminal -> IO Vty
90intMkVty kvar fend t = do
91intMkVty kvar fend t = do
src/Graphics/Vty/Terminal.hs+3−3
@@ -88,10 +88,10 @@ current_terminal :: ( Applicative m, MonadIO m ) => m Terminal
88current_terminal = do
88current_terminal = do
89 term_type <- liftIO $ getEnv "TERM"
89 term_type <- liftIO $ getEnv "TERM"
90 out_handle <- liftIO $ hDuplicate stdout
90 out_handle <- liftIO $ hDuplicate stdout
91− terminal_for_type_and_io term_type out_handle
91+ terminal_with_name_and_io term_type out_handle
92
92
93−terminal_for_type_and_io :: (Applicative m, MonadIO m) => String -> Handle -> m Terminal
93+terminal_with_name_and_io :: (Applicative m, MonadIO m) => String -> Handle -> m Terminal
94−terminal_for_type_and_io term_type out_handle = do
94+terminal_with_name_and_io term_type out_handle = do
95 t <- if "xterm" `isPrefixOf` term_type
95 t <- if "xterm" `isPrefixOf` term_type
96 then do
96 then do
97 maybe_terminal_app <- get_env "TERM_PROGRAM"
97 maybe_terminal_app <- get_env "TERM_PROGRAM"
src/Graphics/Vty/Terminal/Interface.hs+1−1
@@ -29,7 +29,7 @@ import qualified Data.Vector as Vector
29data Terminal = Terminal
29data Terminal = Terminal
30 { -- | Text identifier for the terminal. Used for debugging.
30 { -- | Text identifier for the terminal. Used for debugging.
31 terminal_ID :: String
31 terminal_ID :: String
32− , release_device :: MonadIO m => m ()
32+ , release_terminal :: MonadIO m => m ()
33 -- | Clear the display and initialize the terminal to some initial display state.
33 -- | Clear the display and initialize the terminal to some initial display state.
34 --
34 --
35 -- The expectation of a program is that the display starts in some initial state.
35 -- The expectation of a program is that the display starts in some initial state.
src/Graphics/Vty/Terminal/Mock.hs+1−1
@@ -40,7 +40,7 @@ mock_terminal r = liftIO $ do
40 new_assumed_state_ref <- newIORef initial_assumed_state
40 new_assumed_state_ref <- newIORef initial_assumed_state
41 return $ (,) out_ref $ Terminal
41 return $ (,) out_ref $ Terminal
42 { terminal_ID = "mock terminal"
42 { terminal_ID = "mock terminal"
43− , release_device = return ()
43+ , release_terminal = return ()
44 , reserve_display = return ()
44 , reserve_display = return ()
45 , release_display = return ()
45 , release_display = return ()
46 , display_bounds = return r
46 , display_bounds = return r
src/Graphics/Vty/Terminal/TerminfoBased.hs+1−1
@@ -86,7 +86,7 @@ reserve_terminal in_ID out_handle = liftIO $ mfix $ \self -> do
86 new_assumed_state_ref <- newIORef initial_assumed_state
86 new_assumed_state_ref <- newIORef initial_assumed_state
87 return $ Terminal
87 return $ Terminal
88 { terminal_ID = in_ID
88 { terminal_ID = in_ID
89− , release_device = liftIO $ do
89+ , release_terminal = liftIO $ do
90 send_cap set_default_attr []
90 send_cap set_default_attr []
91 send_cap cnorm []
91 send_cap cnorm []
92 hClose out_handle
92 hClose out_handle
src/Graphics/Vty/Terminal/XTermColor.hs+2−2
@@ -31,9 +31,9 @@ reserve_terminal variant out_handle = liftIO $ do
31 t <- TerminfoBased.reserve_terminal variant' out_handle
31 t <- TerminfoBased.reserve_terminal variant' out_handle
32 return $ t
32 return $ t
33 { terminal_ID = terminal_ID t ++ " (xterm-color)"
33 { terminal_ID = terminal_ID t ++ " (xterm-color)"
34− , release_device = do
34+ , release_terminal = do
35 liftIO $ flushed_put set_default_char_set
35 liftIO $ flushed_put set_default_char_set
36− release_device t
36+ release_terminal t
37 , mk_display_context = \self -> return $ self
37 , mk_display_context = \self -> return $ self
38 { inline_hack = xterm_inline_hack t
38 { inline_hack = xterm_inline_hack t
39 }
39 }
test/Verify.hs+7
@@ -8,7 +8,10 @@
8{-# LANGUAGE DisambiguateRecordFields #-}
8{-# LANGUAGE DisambiguateRecordFields #-}
9{-# LANGUAGE NamedFieldPuns #-}
9{-# LANGUAGE NamedFieldPuns #-}
10module Verify ( module Verify
10module Verify ( module Verify
11+ , module Control.Applicative
11 , module Control.DeepSeq
12 , module Control.DeepSeq
13+ , module Control.Exception
14+ , module Control.Monad
12 , module Test.QuickCheck
15 , module Test.QuickCheck
13 , module Test.QuickCheck.Modifiers
16 , module Test.QuickCheck.Modifiers
14 , succeeded
17 , succeeded
@@ -22,6 +25,8 @@ module Verify ( module Verify
22 )
25 )
23 where
26 where
24
27
28+import Control.Exception ( bracket, try, SomeException(..) )
29+
25import Distribution.TestSuite hiding ( Result(..) )
30import Distribution.TestSuite hiding ( Result(..) )
26import qualified Distribution.TestSuite as TS
31import qualified Distribution.TestSuite as TS
27
32
@@ -34,7 +39,9 @@ import Test.QuickCheck.Monadic ( monadicIO )
34
39
35import qualified Codec.Binary.UTF8.String as UTF8
40import qualified Codec.Binary.UTF8.String as UTF8
36
41
42+import Control.Applicative hiding ( (<|>) )
37import Control.DeepSeq
43import Control.DeepSeq
44+import Control.Monad ( forM, mapM, mapM_, forM_ )
38import Control.Monad.State.Strict
45import Control.Monad.State.Strict
39
46
40import Data.IORef
47import Data.IORef
test/VerifyParseTerminfoCaps.hs−4
@@ -9,10 +9,6 @@ import qualified System.Console.Terminfo as Terminfo
9import Verify.Data.Terminfo.Parse
9import Verify.Data.Terminfo.Parse
10import Verify
10import Verify
11
11
12−import Control.Applicative ( (<$>) )
13−import Control.Exception ( try, SomeException(..) )
14−import Control.Monad ( mapM_, forM, forM_ )
15−
16import Data.Maybe ( catMaybes, fromJust )
12import Data.Maybe ( catMaybes, fromJust )
17import Data.Word
13import Data.Word
18
14
test/VerifyTerminfoBased.hs+73−3
@@ -1,8 +1,78 @@
1+{-# LANGUAGE ScopedTypeVariables #-}
2+{- We setup the environment to envoke certain terminals of interest.
3+ - This assumes appropriate definitions exist in the current environment for the terminals of
4+ - interest.
5+ -}
1module VerifyTerminfoBased where
6module VerifyTerminfoBased where
2import Verify
7import Verify
3
8
4−import Graphics.Vty.Terminal.TerminfoBased
9+import Graphics.Vty
10+import Graphics.Vty.Terminal.TerminfoBased as TerminfoBased
11+
12+import Verify.Graphics.Vty.Image
13+
14+import qualified System.Console.Terminfo as Terminfo
15+import System.IO
16+
17+-- A list of terminals that should be supported.
18+-- This started with a list of terminals ubuntu supported. Then those terminals that really could
19+-- not be supported were removed.
20+terminals_of_interest =
21+ [ "vt100"
22+ , "vt220"
23+ , "vt102"
24+ , "xterm-r5"
25+ , "xterm-xfree86"
26+ , "xterm-r6"
27+ , "xterm-256color"
28+ , "xterm-vt220"
29+ , "xterm-debian"
30+ , "xterm-mono"
31+ , "xterm-color"
32+ , "xterm"
33+ , "mach"
34+ , "mach-bold"
35+ , "mach-color"
36+ , "linux"
37+ , "ansi"
38+ , "hurd"
39+ , "Eterm"
40+ , "pcansi"
41+ , "screen-256color"
42+ , "screen-bce"
43+ , "screen-s"
44+ , "screen-w"
45+ , "screen"
46+ , "screen-256color-bce"
47+ , "sun"
48+ , "rxvt"
49+ , "rxvt-unicode"
50+ , "rxvt-basic"
51+ , "cygwin"
52+ , "dumb"
53+ ]
5
54
6tests :: IO [Test]
55tests :: IO [Test]
7−tests = return
56+tests = concat <$> forM terminals_of_interest (\term_name -> do
8− []
57+ -- check if that terminfo exists
58+ putStrLn $ "testing end to end for terminal: " ++ term_name
59+ mti <- try $ Terminfo.setupTerm term_name
60+ case mti of
61+ Left (_ :: SomeException) -> return []
62+ Right _ -> return [ verify ("verify " ++ term_name ++ " could output a picture")
63+ (smoke_test_term term_name)
64+ ]
65+ )
66+
67+smoke_test_term :: String -> SingleAttrSingleSpanStack -> Property
68+smoke_test_term term_name (SingleAttrSingleSpanStack i _ _ _) = liftIOResult $ do
69+ null_out <- openFile "/dev/null" WriteMode
70+ t <- TerminfoBased.reserve_terminal term_name null_out
71+ reserve_display t
72+ dc <- display_context t (DisplayRegion 100 100)
73+ let pic = pic_for_image i
74+ output_picture dc pic
75+ release_display t
76+ release_terminal t
77+ return succeeded
78+
test/interactive_terminal_test.hs+16−16
@@ -82,7 +82,7 @@ failure".
82 let results_txt = show env_attributes ++ "\n"
82 let results_txt = show env_attributes ++ "\n"
83 ++ terminal_ID t ++ "\n"
83 ++ terminal_ID t ++ "\n"
84 ++ show results ++ "\n"
84 ++ show results ++ "\n"
85− release_device t
85+ release_terminal t
86 writeFile output_file_path results_txt
86 writeFile output_file_path results_txt
87
87
88wait_for_return = do
88wait_for_return = do
@@ -188,7 +188,7 @@ reserve_output_test = Test
188 hFlush stdout
188 hFlush stdout
189 getLine
189 getLine
190 release_display t
190 release_display t
191− release_device t
191+ release_terminal t
192 return ()
192 return ()
193 , print_summary = do
193 , print_summary = do
194 putStr $ [s|
194 putStr $ [s|
@@ -223,7 +223,7 @@ display_bounds_test_0 = Test
223 hFlush stdout
223 hFlush stdout
224 getLine
224 getLine
225 release_display t
225 release_display t
226− release_device t
226+ release_terminal t
227 return ()
227 return ()
228 , print_summary = display_bounds_test_summary True
228 , print_summary = display_bounds_test_summary True
229 , confirm_results = generic_output_match_confirm
229 , confirm_results = generic_output_match_confirm
@@ -252,7 +252,7 @@ display_bounds_test_1 = Test
252 hFlush stdout
252 hFlush stdout
253 getLine
253 getLine
254 release_display t
254 release_display t
255− release_device t
255+ release_terminal t
256 return ()
256 return ()
257 , print_summary = display_bounds_test_summary True
257 , print_summary = display_bounds_test_summary True
258 , confirm_results = generic_output_match_confirm
258 , confirm_results = generic_output_match_confirm
@@ -275,7 +275,7 @@ display_bounds_test_2 = Test
275 output_picture d pic
275 output_picture d pic
276 getLine
276 getLine
277 release_display t
277 release_display t
278− release_device t
278+ release_terminal t
279 return ()
279 return ()
280 , print_summary = display_bounds_test_summary True
280 , print_summary = display_bounds_test_summary True
281 , confirm_results = generic_output_match_confirm
281 , confirm_results = generic_output_match_confirm
@@ -306,7 +306,7 @@ display_bounds_test_3 = Test
306 getLine
306 getLine
307 show_cursor t
307 show_cursor t
308 release_display t
308 release_display t
309− release_device t
309+ release_terminal t
310 return ()
310 return ()
311 , print_summary = display_bounds_test_summary False
311 , print_summary = display_bounds_test_summary False
312 , confirm_results = generic_output_match_confirm
312 , confirm_results = generic_output_match_confirm
@@ -406,7 +406,7 @@ unicode_single_width_0 = Test
406 hFlush stdout
406 hFlush stdout
407 getLine
407 getLine
408 release_display t
408 release_display t
409− release_device t
409+ release_terminal t
410 return ()
410 return ()
411 , print_summary = unicode_single_width_summary
411 , print_summary = unicode_single_width_summary
412 , confirm_results = generic_output_match_confirm
412 , confirm_results = generic_output_match_confirm
@@ -426,7 +426,7 @@ unicode_single_width_1 = Test
426 output_picture d pic
426 output_picture d pic
427 getLine
427 getLine
428 release_display t
428 release_display t
429− release_device t
429+ release_terminal t
430 return ()
430 return ()
431 , print_summary = unicode_single_width_summary
431 , print_summary = unicode_single_width_summary
432 , confirm_results = generic_output_match_confirm
432 , confirm_results = generic_output_match_confirm
@@ -488,7 +488,7 @@ unicode_double_width_0 = Test
488 hFlush stdout
488 hFlush stdout
489 getLine
489 getLine
490 release_display t
490 release_display t
491− release_device t
491+ release_terminal t
492 return ()
492 return ()
493 , print_summary = unicode_double_width_summary
493 , print_summary = unicode_double_width_summary
494 , confirm_results = generic_output_match_confirm
494 , confirm_results = generic_output_match_confirm
@@ -508,7 +508,7 @@ unicode_double_width_1 = Test
508 output_picture d pic
508 output_picture d pic
509 getLine
509 getLine
510 release_display t
510 release_display t
511− release_device t
511+ release_terminal t
512 return ()
512 return ()
513 , print_summary = unicode_double_width_summary
513 , print_summary = unicode_double_width_summary
514 , confirm_results = generic_output_match_confirm
514 , confirm_results = generic_output_match_confirm
@@ -564,7 +564,7 @@ attributes_test_0 = Test
564 output_picture d pic
564 output_picture d pic
565 getLine
565 getLine
566 release_display t
566 release_display t
567− release_device t
567+ release_terminal t
568 return ()
568 return ()
569 , print_summary = do
569 , print_summary = do
570 putStr $ [s|
570 putStr $ [s|
@@ -610,7 +610,7 @@ attributes_test_1 = Test
610 output_picture d pic
610 output_picture d pic
611 getLine
611 getLine
612 release_display t
612 release_display t
613− release_device t
613+ release_terminal t
614 return ()
614 return ()
615 , print_summary = do
615 , print_summary = do
616 putStr $ [s|
616 putStr $ [s|
@@ -667,7 +667,7 @@ attributes_test_2 = Test
667 output_picture d pic
667 output_picture d pic
668 getLine
668 getLine
669 release_display t
669 release_display t
670− release_device t
670+ release_terminal t
671 return ()
671 return ()
672 , print_summary = do
672 , print_summary = do
673 putStr $ [s|
673 putStr $ [s|
@@ -726,7 +726,7 @@ attributes_test_3 = Test
726 output_picture d pic
726 output_picture d pic
727 getLine
727 getLine
728 release_display t
728 release_display t
729− release_device t
729+ release_terminal t
730 return ()
730 return ()
731 , print_summary = do
731 , print_summary = do
732 putStr $ [s|
732 putStr $ [s|
@@ -802,7 +802,7 @@ attributes_test_4 = Test
802 output_picture d pic
802 output_picture d pic
803 getLine
803 getLine
804 release_display t
804 release_display t
805− release_device t
805+ release_terminal t
806 return ()
806 return ()
807 , print_summary = do
807 , print_summary = do
808 putStr $ [s|
808 putStr $ [s|
@@ -853,7 +853,7 @@ attributes_test_5 = Test
853 output_picture d pic
853 output_picture d pic
854 getLine
854 getLine
855 release_display t
855 release_display t
856− release_device t
856+ release_terminal t
857 return ()
857 return ()
858 , print_summary = do
858 , print_summary = do
859 putStr $ [s|
859 putStr $ [s|
vty.cabal+34
@@ -155,6 +155,40 @@ test-suite verify-terminal
155 utf8-string >= 0.3 && < 0.4,
155 utf8-string >= 0.3 && < 0.4,
156 vector >= 0.7
156 vector >= 0.7
157
157
158+test-suite verify-terminfo-based
159+ default-language: Haskell2010
160+
161+ type: detailed-0.9
162+
163+ hs-source-dirs: test
164+
165+ test-module: VerifyTerminfoBased
166+
167+ other-modules: Verify
168+ Verify.Graphics.Vty.Attributes
169+ Verify.Graphics.Vty.DisplayRegion
170+ Verify.Graphics.Vty.Picture
171+ Verify.Graphics.Vty.Image
172+ Verify.Graphics.Vty.Span
173+
174+ build-depends: vty,
175+ Cabal == 1.17.*,
176+ QuickCheck >= 2.4,
177+ random == 1.0.*,
178+ base >= 4 && < 5,
179+ bytestring,
180+ containers,
181+ deepseq >= 1.1 && < 1.4,
182+ ghc-prim,
183+ lens,
184+ mtl >= 1.1.1.0 && < 2.2,
185+ parallel >= 2.2 && < 3.3,
186+ parsec >= 2 && < 4,
187+ terminfo >= 0.3 && < 0.4,
188+ text >= 0.11.3,
189+ unix,
190+ utf8-string >= 0.3 && < 0.4,
191+ vector >= 0.7
158
192
159test-suite verify-display-attributes
193test-suite verify-display-attributes
160 default-language: Haskell2010
194 default-language: Haskell2010