4b6f75b · vty · git.iko.soy

git.iko.soy/vty

implement a test for all terminfo based terminals this should support

commit4b6f75b9892693cbb8a88eca1e6d06bdba6b46e7 authorCorey O'Connor <coreyoconnor@gmail.com> dateSun 7 Jul 2013, 23:31 (13 years ago) parentfd3df90

11 files changed+140−32

compare with master

unifiedsplit

src/Graphics/Vty.hs+2−1 src/Graphics/Vty/Terminal.hs+3−3 src/Graphics/Vty/Terminal/Interface.hs+1−1 src/Graphics/Vty/Terminal/Mock.hs+1−1 src/Graphics/Vty/Terminal/TerminfoBased.hs+1−1 src/Graphics/Vty/Terminal/XTermColor.hs+2−2 test/Verify.hs+7 test/VerifyParseTerminfoCaps.hs−4 test/VerifyTerminfoBased.hs+73−3 test/interactive_terminal_test.hs+16−16 vty.cabal+34

src/Graphics/Vty.hs+2−1

@@ -78,13 +78,14 @@ mkVty = mkVtyEscDelay 0

7878-- | Set up the state object for using vty. At most one state object should be

7979-- created at a time. The delay, in microseconds, specifies the period of time to wait for a key

8080-- following reading ESC from the terminal before considering the ESC key press as a discrete event.

81+-- \todo move input init into terminal interface

8182mkVtyEscDelay :: Int -> IO Vty

8283mkVtyEscDelay escDelay = do

8384 term_info <- Terminfo.setupTermFromEnv

8485 t <- current_terminal

8586 reserve_display t

8687 (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

8889

8990intMkVty :: IO Event -> IO () -> Terminal -> IO Vty

9091intMkVty kvar fend t = do

src/Graphics/Vty/Terminal.hs+3−3

@@ -88,10 +88,10 @@ current_terminal :: ( Applicative m, MonadIO m ) => m Terminal

8888current_terminal = do

8989 term_type <- liftIO $ getEnv "TERM"

9090 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

9292

93−terminal_for_type_and_io :: (Applicative m, MonadIO m) => String -> Handle -> m Terminal

94−terminal_for_type_and_io term_type out_handle = do

93+terminal_with_name_and_io :: (Applicative m, MonadIO m) => String -> Handle -> m Terminal

94+terminal_with_name_and_io term_type out_handle = do

9595 t <- if "xterm" `isPrefixOf` term_type

9696 then do

9797 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

2929data Terminal = Terminal

3030 { -- | Text identifier for the terminal. Used for debugging.

3131 terminal_ID :: String

32− , release_device :: MonadIO m => m ()

32+ , release_terminal :: MonadIO m => m ()

3333 -- | Clear the display and initialize the terminal to some initial display state.

3434 --

3535 -- 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

4040 new_assumed_state_ref <- newIORef initial_assumed_state

4141 return $ (,) out_ref $ Terminal

4242 { terminal_ID = "mock terminal"

43− , release_device = return ()

43+ , release_terminal = return ()

4444 , reserve_display = return ()

4545 , release_display = return ()

4646 , 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

8686 new_assumed_state_ref <- newIORef initial_assumed_state

8787 return $ Terminal

8888 { terminal_ID = in_ID

89− , release_device = liftIO $ do

89+ , release_terminal = liftIO $ do

9090 send_cap set_default_attr []

9191 send_cap cnorm []

9292 hClose out_handle

src/Graphics/Vty/Terminal/XTermColor.hs+2−2

@@ -31,9 +31,9 @@ reserve_terminal variant out_handle = liftIO $ do

3131 t <- TerminfoBased.reserve_terminal variant' out_handle

3232 return $ t

3333 { terminal_ID = terminal_ID t ++ " (xterm-color)"

34− , release_device = do

34+ , release_terminal = do

3535 liftIO $ flushed_put set_default_char_set

36− release_device t

36+ release_terminal t

3737 , mk_display_context = \self -> return $ self

3838 { inline_hack = xterm_inline_hack t

3939 }

test/Verify.hs+7

@@ -8,7 +8,10 @@

88{-# LANGUAGE DisambiguateRecordFields #-}

99{-# LANGUAGE NamedFieldPuns #-}

1010module Verify ( module Verify

11+ , module Control.Applicative

1112 , module Control.DeepSeq

13+ , module Control.Exception

14+ , module Control.Monad

1215 , module Test.QuickCheck

1316 , module Test.QuickCheck.Modifiers

1417 , succeeded

@@ -22,6 +25,8 @@ module Verify ( module Verify

2225 )

2326 where

2427

28+import Control.Exception ( bracket, try, SomeException(..) )

29+

2530import Distribution.TestSuite hiding ( Result(..) )

2631import qualified Distribution.TestSuite as TS

2732

@@ -34,7 +39,9 @@ import Test.QuickCheck.Monadic ( monadicIO )

3439

3540import qualified Codec.Binary.UTF8.String as UTF8

3641

42+import Control.Applicative hiding ( (<|>) )

3743import Control.DeepSeq

44+import Control.Monad ( forM, mapM, mapM_, forM_ )

3845import Control.Monad.State.Strict

3946

4047import Data.IORef

test/VerifyParseTerminfoCaps.hs−4

@@ -9,10 +9,6 @@ import qualified System.Console.Terminfo as Terminfo

99import Verify.Data.Terminfo.Parse

1010import Verify

1111

12−import Control.Applicative ( (<$>) )

13−import Control.Exception ( try, SomeException(..) )

14−import Control.Monad ( mapM_, forM, forM_ )

15−

1612import Data.Maybe ( catMaybes, fromJust )

1713import Data.Word

1814

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+ -}

16module VerifyTerminfoBased where

27import Verify

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+ ]

554

655tests :: IO [Test]

7−tests = return

8− []

56+tests = concat <$> forM terminals_of_interest (\term_name -> do

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".

8282 let results_txt = show env_attributes ++ "\n"

8383 ++ terminal_ID t ++ "\n"

8484 ++ show results ++ "\n"

85− release_device t

85+ release_terminal t

8686 writeFile output_file_path results_txt

8787

8888wait_for_return = do

@@ -188,7 +188,7 @@ reserve_output_test = Test

188188 hFlush stdout

189189 getLine

190190 release_display t

191− release_device t

191+ release_terminal t

192192 return ()

193193 , print_summary = do

194194 putStr $ [s|

@@ -223,7 +223,7 @@ display_bounds_test_0 = Test

223223 hFlush stdout

224224 getLine

225225 release_display t

226− release_device t

226+ release_terminal t

227227 return ()

228228 , print_summary = display_bounds_test_summary True

229229 , confirm_results = generic_output_match_confirm

@@ -252,7 +252,7 @@ display_bounds_test_1 = Test

252252 hFlush stdout

253253 getLine

254254 release_display t

255− release_device t

255+ release_terminal t

256256 return ()

257257 , print_summary = display_bounds_test_summary True

258258 , confirm_results = generic_output_match_confirm

@@ -275,7 +275,7 @@ display_bounds_test_2 = Test

275275 output_picture d pic

276276 getLine

277277 release_display t

278− release_device t

278+ release_terminal t

279279 return ()

280280 , print_summary = display_bounds_test_summary True

281281 , confirm_results = generic_output_match_confirm

@@ -306,7 +306,7 @@ display_bounds_test_3 = Test

306306 getLine

307307 show_cursor t

308308 release_display t

309− release_device t

309+ release_terminal t

310310 return ()

311311 , print_summary = display_bounds_test_summary False

312312 , confirm_results = generic_output_match_confirm

@@ -406,7 +406,7 @@ unicode_single_width_0 = Test

406406 hFlush stdout

407407 getLine

408408 release_display t

409− release_device t

409+ release_terminal t

410410 return ()

411411 , print_summary = unicode_single_width_summary

412412 , confirm_results = generic_output_match_confirm

@@ -426,7 +426,7 @@ unicode_single_width_1 = Test

426426 output_picture d pic

427427 getLine

428428 release_display t

429− release_device t

429+ release_terminal t

430430 return ()

431431 , print_summary = unicode_single_width_summary

432432 , confirm_results = generic_output_match_confirm

@@ -488,7 +488,7 @@ unicode_double_width_0 = Test

488488 hFlush stdout

489489 getLine

490490 release_display t

491− release_device t

491+ release_terminal t

492492 return ()

493493 , print_summary = unicode_double_width_summary

494494 , confirm_results = generic_output_match_confirm

@@ -508,7 +508,7 @@ unicode_double_width_1 = Test

508508 output_picture d pic

509509 getLine

510510 release_display t

511− release_device t

511+ release_terminal t

512512 return ()

513513 , print_summary = unicode_double_width_summary

514514 , confirm_results = generic_output_match_confirm

@@ -564,7 +564,7 @@ attributes_test_0 = Test

564564 output_picture d pic

565565 getLine

566566 release_display t

567− release_device t

567+ release_terminal t

568568 return ()

569569 , print_summary = do

570570 putStr $ [s|

@@ -610,7 +610,7 @@ attributes_test_1 = Test

610610 output_picture d pic

611611 getLine

612612 release_display t

613− release_device t

613+ release_terminal t

614614 return ()

615615 , print_summary = do

616616 putStr $ [s|

@@ -667,7 +667,7 @@ attributes_test_2 = Test

667667 output_picture d pic

668668 getLine

669669 release_display t

670− release_device t

670+ release_terminal t

671671 return ()

672672 , print_summary = do

673673 putStr $ [s|

@@ -726,7 +726,7 @@ attributes_test_3 = Test

726726 output_picture d pic

727727 getLine

728728 release_display t

729− release_device t

729+ release_terminal t

730730 return ()

731731 , print_summary = do

732732 putStr $ [s|

@@ -802,7 +802,7 @@ attributes_test_4 = Test

802802 output_picture d pic

803803 getLine

804804 release_display t

805− release_device t

805+ release_terminal t

806806 return ()

807807 , print_summary = do

808808 putStr $ [s|

@@ -853,7 +853,7 @@ attributes_test_5 = Test

853853 output_picture d pic

854854 getLine

855855 release_display t

856− release_device t

856+ release_terminal t

857857 return ()

858858 , print_summary = do

859859 putStr $ [s|

vty.cabal+34

@@ -155,6 +155,40 @@ test-suite verify-terminal

155155 utf8-string >= 0.3 && < 0.4,

156156 vector >= 0.7

157157

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

158192

159193test-suite verify-display-attributes

160194 default-language: Haskell2010