@@ -1,115 +1,64 @@
1{-# LANGUAGE ScopedTypeVariables #-}
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
2module VerifyTerminal where
6module VerifyTerminal where
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
11−import Graphics.Vty.Debug
13import Verify
7import Verify
15−import qualified Data.ByteString as BS
9+import Graphics.Vty
17−import qualified Data.String.UTF8 as UTF8
19−import System.IO
11+import Verify.Graphics.Vty.Image
12+import Verify.Graphics.Vty.Terminal
21−compare_bytes out_bytes expected_bytes =
14+import Control.Monad
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
27− else return succeeded
29−unit_image_unit_bounds :: UnitImage -> Property
16+import qualified System.Console.Terminfo as Terminfo
30−unit_image_unit_bounds (UnitImage _ i) = liftIOResult $ do
17+import System.Posix.Env
31− (_,t) <- mock_terminal (DisplayRegion 1 1)
18+import System.IO
32− dc <- display_bounds t >>= display_context t
33− let pic = pic_for_image i
34− output_picture dc pic
37−unit_image_arb_bounds :: UnitImage -> MockWindow -> Property
20+tests :: IO [Test]
38−unit_image_arb_bounds (UnitImage _ i) (MockWindow w h) = liftIOResult $ do
21+tests = concat <$> forM terminals_of_interest (\term_name -> do
39− (_,t) <- mock_terminal (DisplayRegion w h)
22+ -- check if that terminfo exists
40− dc <- display_bounds t >>= display_context t
23+ putStrLn $ "testing end to end for terminal: " ++ term_name
41− let pic = pic_for_image i
24+ mti <- try $ Terminfo.setupTerm term_name
42− output_picture dc pic
25+ case mti of
43− return succeeded
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)
45−single_T_row :: MockWindow -> Property
35+smoke_test_term_non_mac :: String -> Image -> Property
46−single_T_row (MockWindow w h) = liftIOResult $ do
36+smoke_test_term_non_mac term_name i = liftIOResult $ do
47− (mock_data,t) <- mock_terminal (DisplayRegion w h)
37+ -- unset the TERM_PROGRAM environment variable if set.
48− dc <- display_bounds t >>= display_context t
38+ -- Required to execute regression test for #42 on a mac
49− -- create an image that contains just the character T repeated for a single row
39+ unsetEnv "TERM_PROGRAM"
50− let i = horiz_cat $ replicate (fromEnum w) (char def_attr 'T')
40+ smoke_test_term term_name i
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
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
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
77−many_T_rows_cropped_width :: MockWindow -> Property
42+smoke_test_term_mac :: String -> Image -> Property
78−many_T_rows_cropped_width (MockWindow w h) = liftIOResult $ do
43+smoke_test_term_mac term_name i = liftIOResult $ do
79− (mock_data,t) <- mock_terminal (DisplayRegion w h)
44+ setEnv "TERM_PROGRAM" "Apple_Terminal" True
80− dc <- display_bounds t >>= display_context t
45+ smoke_test_term term_name i
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
92−many_T_rows_cropped_height :: MockWindow -> Property
47+smoke_test_term :: String -> Image -> IO Result
93−many_T_rows_cropped_height (MockWindow w h) = liftIOResult $ do
48+smoke_test_term term_name i = do
94− (mock_data,t) <- mock_terminal (DisplayRegion w h)
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)
95− dc <- display_bounds t >>= display_context t
53+ dc <- display_context t (DisplayRegion 100 100)
96− -- create an image that contains the character 'T' repeated for all the rows
54+ -- always show the cursor to produce tests for terminals with no cursor support.
97− let i = vert_cat $ replicate (fromEnum h * 2) $ horiz_cat $ replicate (fromEnum w) (char def_attr 'T')
55+ let pic = (pic_for_image i) { pic_cursor = Cursor 0 0 }
98− pic = (pic_for_image i) { pic_background = Background 'B' def_attr }
99 output_picture dc pic
56 output_picture dc pic
100− out_bytes <- readIORef mock_data >>= return . UTF8.toRep
57+ set_cursor_pos t 0 0
101− -- The UTF8 string that represents the output bytes is h repeats of a move, 'M', followed by an
58+ when (supports_cursor_visibility t) $ do
102− -- attribute change. 'A', followed by w count 'T's
59+ hide_cursor t
103− let expected = "HD" ++ concat (replicate (fromEnum h) $ "MA" ++ replicate (fromEnum w) 'T')
60+ show_cursor t
104− expected_bytes :: BS.ByteString = UTF8.toRep $ UTF8.fromString expected
61+ release_display t
105− compare_bytes out_bytes expected_bytes
62+ release_terminal t
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