@@ -1,115 +1,64 @@
11{-# 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+ -}
26module VerifyTerminal where
3−
4−import Verify.Graphics.Vty.DisplayRegion
5−import Verify.Graphics.Vty.Picture
6−import Verify.Graphics.Vty.Image
7−import Verify.Graphics.Vty.Span
8−import Graphics.Vty.Terminal
9−import Graphics.Vty.Terminal.Mock
10−
11−import Graphics.Vty.Debug
12−
137import Verify
148
15−import qualified Data.ByteString as BS
16−import Data.IORef
17−import qualified Data.String.UTF8 as UTF8
9+import Graphics.Vty
1810
19−import System.IO
11+import Verify.Graphics.Vty.Image
12+import Verify.Graphics.Vty.Terminal
2013
21−compare_bytes out_bytes expected_bytes =
22− if out_bytes /= expected_bytes
23− then return $ failed { reason = "bytes\n" ++ show out_bytes
24− ++ "\nare not the expected bytes\n"
25− ++ show expected_bytes
26− }
27− else return succeeded
14+import Control.Monad
2815
29−unit_image_unit_bounds :: UnitImage -> Property
30−unit_image_unit_bounds (UnitImage _ i) = liftIOResult $ do
31− (_,t) <- mock_terminal (DisplayRegion 1 1)
32− dc <- display_bounds t >>= display_context t
33− let pic = pic_for_image i
34− output_picture dc pic
35− return succeeded
16+import qualified System.Console.Terminfo as Terminfo
17+import System.Posix.Env
18+import System.IO
3619
37−unit_image_arb_bounds :: UnitImage -> MockWindow -> Property
38−unit_image_arb_bounds (UnitImage _ i) (MockWindow w h) = liftIOResult $ do
39− (_,t) <- mock_terminal (DisplayRegion w h)
40− dc <- display_bounds t >>= display_context t
41− let pic = pic_for_image i
42− output_picture dc pic
43− return succeeded
20+tests :: IO [Test]
21+tests = concat <$> forM terminals_of_interest (\term_name -> do
22+ -- check if that terminfo exists
23+ putStrLn $ "testing end to end for terminal: " ++ term_name
24+ mti <- try $ Terminfo.setupTerm term_name
25+ case mti of
26+ Left (_ :: SomeException) -> return []
27+ Right _ -> return [ verify ("verify " ++ term_name ++ " could output a picture")
28+ (smoke_test_term_non_mac term_name)
29+ -- this is excessive.
30+ , verify ("verify " ++ term_name ++ " could output a picture on a Mac.")
31+ (smoke_test_term_mac term_name)
32+ ]
33+ )
4434
45−single_T_row :: MockWindow -> Property
46−single_T_row (MockWindow w h) = liftIOResult $ do
47− (mock_data,t) <- mock_terminal (DisplayRegion w h)
48− dc <- display_bounds t >>= display_context t
49− -- create an image that contains just the character T repeated for a single row
50− let i = horiz_cat $ replicate (fromEnum w) (char def_attr 'T')
51− pic = (pic_for_image i) { pic_background = Background 'B' def_attr }
52− output_picture dc pic
53− out_bytes <- readIORef mock_data >>= return . UTF8.toRep
54− -- The UTF8 string that represents the output bytes a single line containing the T string:
55− let expected = "HD" ++ "MA" ++ replicate (fromEnum w) 'T'
56− -- Followed by h - 1 lines of a change to the background attribute and then the background
57− -- character
58− ++ concat (replicate (fromEnum h - 1) $ "MA" ++ replicate (fromEnum w) 'B')
59− expected_bytes :: BS.ByteString = UTF8.toRep $ UTF8.fromString expected
60− compare_bytes out_bytes expected_bytes
61−
62−many_T_rows :: MockWindow -> Property
63−many_T_rows (MockWindow w h) = liftIOResult $ do
64− (mock_data, t) <- mock_terminal (DisplayRegion w h)
65− dc <- display_bounds t >>= display_context t
66− -- create an image that contains the character 'T' repeated for all the rows
67− let i = vert_cat $ replicate (fromEnum h) $ horiz_cat $ replicate (fromEnum w) (char def_attr 'T')
68− pic = (pic_for_image i) { pic_background = Background 'B' def_attr }
69− output_picture dc pic
70− out_bytes <- readIORef mock_data >>= return . UTF8.toRep
71− -- The UTF8 string that represents the output bytes is h repeats of a move, 'M', followed by an
72− -- attribute change. 'A', followed by w 'T's
73− let expected = "HD" ++ concat (replicate (fromEnum h) $ "MA" ++ replicate (fromEnum w) 'T')
74− expected_bytes :: BS.ByteString = UTF8.toRep $ UTF8.fromString expected
75− compare_bytes out_bytes expected_bytes
35+smoke_test_term_non_mac :: String -> Image -> Property
36+smoke_test_term_non_mac term_name i = liftIOResult $ do
37+ -- unset the TERM_PROGRAM environment variable if set.
38+ -- Required to execute regression test for #42 on a mac
39+ unsetEnv "TERM_PROGRAM"
40+ smoke_test_term term_name i
7641
77−many_T_rows_cropped_width :: MockWindow -> Property
78−many_T_rows_cropped_width (MockWindow w h) = liftIOResult $ do
79− (mock_data,t) <- mock_terminal (DisplayRegion w h)
80− dc <- display_bounds t >>= display_context t
81− -- create an image that contains the character 'T' repeated for all the rows
82− let i = vert_cat $ replicate (fromEnum h) $ horiz_cat $ replicate (fromEnum w * 2) (char def_attr 'T')
83− pic = (pic_for_image i) { pic_background = Background 'B' def_attr }
84− output_picture dc pic
85− out_bytes <- readIORef mock_data >>= return . UTF8.toRep
86− -- The UTF8 string that represents the output bytes is h repeats of a move, 'M', followed by an
87− -- attribute change. 'A', followed by w 'T's
88− let expected = "HD" ++ concat (replicate (fromEnum h) $ "MA" ++ replicate (fromEnum w) 'T')
89− expected_bytes :: BS.ByteString = UTF8.toRep $ UTF8.fromString expected
90− compare_bytes out_bytes expected_bytes
42+smoke_test_term_mac :: String -> Image -> Property
43+smoke_test_term_mac term_name i = liftIOResult $ do
44+ setEnv "TERM_PROGRAM" "Apple_Terminal" True
45+ smoke_test_term term_name i
9146
92−many_T_rows_cropped_height :: MockWindow -> Property
93−many_T_rows_cropped_height (MockWindow w h) = liftIOResult $ do
94− (mock_data,t) <- mock_terminal (DisplayRegion w h)
95− dc <- display_bounds t >>= display_context t
96− -- create an image that contains the character 'T' repeated for all the rows
97− let i = vert_cat $ replicate (fromEnum h * 2) $ horiz_cat $ replicate (fromEnum w) (char def_attr 'T')
98− pic = (pic_for_image i) { pic_background = Background 'B' def_attr }
47+smoke_test_term :: String -> Image -> IO Result
48+smoke_test_term term_name i = do
49+ null_out <- openFile "/dev/null" WriteMode
50+ t <- terminal_with_name_and_io term_name null_out
51+ putStrLn $ "context color count: " ++ show (context_color_count t)
52+ reserve_display t
53+ dc <- display_context t (DisplayRegion 100 100)
54+ -- always show the cursor to produce tests for terminals with no cursor support.
55+ let pic = (pic_for_image i) { pic_cursor = Cursor 0 0 }
9956 output_picture dc pic
100− out_bytes <- readIORef mock_data >>= return . UTF8.toRep
101− -- The UTF8 string that represents the output bytes is h repeats of a move, 'M', followed by an
102− -- attribute change. 'A', followed by w count 'T's
103− let expected = "HD" ++ concat (replicate (fromEnum h) $ "MA" ++ replicate (fromEnum w) 'T')
104− expected_bytes :: BS.ByteString = UTF8.toRep $ UTF8.fromString expected
105− compare_bytes out_bytes expected_bytes
106−
107−tests :: IO [Test]
108−tests = return [ verify "unit_image_unit_bounds" unit_image_unit_bounds
109− , verify "unit_image_arb_bounds" unit_image_arb_bounds
110− , verify "single_T_row" single_T_row
111− , verify "many_T_rows" many_T_rows
112− , verify "many_T_rows_cropped_width" many_T_rows_cropped_width
113− , verify "many_T_rows_cropped_height" many_T_rows_cropped_height
114− ]
57+ set_cursor_pos t 0 0
58+ when (supports_cursor_visibility t) $ do
59+ hide_cursor t
60+ show_cursor t
61+ release_display t
62+ release_terminal t
63+ return succeeded
11564