git.iko.soy/vty
on 00a6a4f help sign in
vty/test/VerifyOutput.hs
63 lines 2.3 kB history raw
1{- We setup the environment to envoke certain terminals of interest.
2 - This assumes appropriate definitions exist in the current environment for the terminals of
3 - interest.
4 -}
5module VerifyOutput where
6import Verify
8import Graphics.Vty
10import Verify.Graphics.Vty.Image
11import Verify.Graphics.Vty.Output
13import Control.Monad
15import qualified System.Console.Terminfo as Terminfo
16import System.Posix.Env
17import System.IO
19tests :: IO [Test]
20tests = concat <$> forM terminals_of_interest (\term_name -> do
21 -- check if that terminfo exists
22 putStrLn $ "testing end to end for terminal: " ++ term_name
23 mti <- try $ Terminfo.setupTerm term_name
24 case mti of
25 Left (_ :: SomeException) -> return []
26 Right _ -> return [ verify ("verify " ++ term_name ++ " could output a picture")
27 (smoke_test_term_non_mac term_name)
28 -- this is excessive.
29 , verify ("verify " ++ term_name ++ " could output a picture on a Mac.")
30 (smoke_test_term_mac term_name)
31 ]
32 )
34smoke_test_term_non_mac :: String -> Image -> Property
35smoke_test_term_non_mac term_name i = liftIOResult $ do
36 -- unset the TERM_PROGRAM environment variable if set.
37 -- Required to execute regression test for #42 on a mac
38 unsetEnv "TERM_PROGRAM"
39 smoke_test_term term_name i
41smoke_test_term_mac :: String -> Image -> Property
42smoke_test_term_mac term_name i = liftIOResult $ do
43 setEnv "TERM_PROGRAM" "Apple_Terminal" True
44 smoke_test_term term_name i
46smoke_test_term :: String -> Image -> IO Result
47smoke_test_term term_name i = do
48 null_out <- openFile "/dev/null" WriteMode
49 t <- output_for_name_and_io term_name null_out
50 putStrLn $ "context color count: " ++ show (context_color_count t)
51 reserve_display t
52 dc <- display_context t (100,100)
53 -- always show the cursor to produce tests for terminals with no cursor support.
54 let pic = (pic_for_image i) { pic_cursor = Cursor 0 0 }
55 output_picture dc pic
56 set_cursor_pos t 0 0
57 when (supports_cursor_visibility t) $ do
58 hide_cursor t
59 show_cursor t
60 release_display t
61 release_terminal t
62 return succeeded