@@ -23,7 +23,6 @@ import Control.Monad
2323
2424import System.Console.Terminfo
2525import System.IO
26−import System.Posix.Env
2726
2827import Test.Framework.Providers.SmallCheck
2928import Test.Framework
@@ -36,6 +35,7 @@ max_bytes_size = 16
3635data InputEvent
3736 = Bytes String -- | input sequence encoded as a string. Regardless, the input is read a byte at a time.
3837 | Delay Int -- | millisecond delay
38+ deriving Show
3939
4040type InputSpec = [InputEvent]
4141
@@ -49,46 +49,38 @@ exec_input_spec input out_handle = forM_ input f
4949
5050assert_events_from_input_block :: ClassifyTable -> InputSpec -> ExpectedSpec -> IO Bool
5151assert_events_from_input_block table input_spec expected_events = do
52+ print input_spec
5253 let classifier = classify table
5354 input <- newChan
5455 output <- newChan
55− forkIO $ write_input_spec_to_chan input input_spec
56− inputToEventThread classifier input output
57− -- H: all events are available in output channel
58− -- TODO: switch to using explicit control events. Currently the channel is passing around a
59− -- magic FFFX characters
56+ read_complete <- newEmptyMVar
57+ write_complete <- newEmptyMVar
58+ _ <- forkIO $ write_input_spec_to_chan input input_spec
59+ `finally` putMVar write_complete ()
60+ _ <- forkIO $ inputToEventThread classifier input output
61+ `finally` putMVar read_complete ()
62+ () <- takeMVar write_complete
63+ () <- takeMVar read_complete
6064 -- TODO: use STM channel
61− let collect_events = handle (\(e :: BlockedIndefinitelyOnMVar) -> return [])
62− ((:) <$> readChan output <*> collect_events)
63− out_events <- collect_events
65+ -- assures the next line does not block.
66+ writeList2Chan output $ replicate (length expected_events) undefined
67+ out_events <- take (length expected_events) <$> getChanContents output
6468 return $ out_events == expected_events
6569
6670write_input_spec_to_chan :: Chan Char -> InputSpec -> IO ()
67−write_input_spec_to_chan chan [] = writeChan chan '\xFFFD'
68−write_input_spec_to_chan chan (Bytes str : input_spec')
69− = writeList2Chan chan str >> write_input_spec_to_chan chan input_spec'
70−write_input_spec_to_chan chan (Delay t : input_spec')
71− = writeChan chan '\xFFFE' >> write_input_spec_to_chan chan input_spec'
72−
73−{-
74−
75−tests :: IO [Test]
76−tests = do
77− mappend
78− <$> pure [ verify "basic block generated from single ansi chars to event translation" ]
79− <*> mapM terminals_of_interest
80− verify_simple_input_block_to_event
81− , verify "keys from caps table are parsed to the same key"
82− verify_keys_from_caps_table
83− ]
84−-}
85−
86−-- how to make this data dependent?
71+write_input_spec_to_chan chan [] = do
72+ writeChan chan '\xFFFD'
73+write_input_spec_to_chan chan (Bytes str : input_spec') = do
74+ writeList2Chan chan str
75+ write_input_spec_to_chan chan input_spec'
76+write_input_spec_to_chan chan (Delay _t : input_spec') = do
77+ writeChan chan '\xFFFE'
78+ write_input_spec_to_chan chan input_spec'
8779
8880newtype EventBlock event = EventBlock ([(String,event)] -> [(String, event)])
8981
9082instance Show (EventBlock event) where
91− show (EventBlock g) = "EventBlock(* -> *)"
83+ show (EventBlock g) = "EventBlock(*->*)"
9284
9385instance Monad m => Serial m (EventBlock event) where
9486 series = do
@@ -106,12 +98,12 @@ verify_keys_from_caps_table_block_to_event :: Property IO
10698verify_keys_from_caps_table_block_to_event = forAll $ \(EventBlock block_gen) ->
10799 over (generate (\n -> take n terminals_of_interest)) $ \term_name -> monadic $ do
108100 terminal <- setupTerm term_name
109− let caps_seq :: [(String, Event)] = block_gen keys_from_caps_table
110− let bytes_seq = caps_classify_table terminal caps_seq
111− input = [Bytes s | (s,_) <- bytes_seq]
112− escaped_sequence = intersperse (Delay defaultEscDelay) input
113− return True :: IO Bool
114− -- cap <- elements keys_from_caps_table
101+ let table = caps_classify_table terminal keys_from_caps_table
102+ input_seq :: [(String, Event)] = block_gen table
103+ input_bytes = [Bytes s | (s,_) <- input_seq]
104+ input = intersperse (Delay defaultEscDelay) input_bytes
105+ events = [e | (_,e) <- input_seq]
106+ assert_events_from_input_block (map_to_legacy_table table) input events
115107
116108main = defaultMain
117109 [ testProperty "basic block generated from a single ansi chars to event translation"