ilyakooo0/vty
1
0
Fork 0
mirror of https://github.com/ilyakooo0/vty.git synced 2024-11-29 16:54:42 +03:00
Code Issues Projects Releases Wiki Activity

latter entries in the table have precedence. the mock input tests was not reflecting this.

Browse Source
This commit is contained in:
Corey O'Connor 2014-05-31 01:52:29 -07:00
parent aa67f22b38
commit 7d434d3104
1 changed files with 8 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
test/VerifyUsingMockInput.hs
View File

@ -7,8 +7,6 @@ module Main where
import Verify.Graphics.Vty.Output import Verify.Graphics.Vty.Output
import Data.List (intersperse)
import Graphics.Vty hiding (resize) import Graphics.Vty hiding (resize)
import Graphics.Vty.Input.Events import Graphics.Vty.Input.Events
import Graphics.Vty.Input.Loop import Graphics.Vty.Input.Loop
@ -22,6 +20,7 @@ import Control.Monad
import Data.Default import Data.Default
import Data.IORef import Data.IORef
import Data.List (intersperse, reverse, nubBy)
import System.Console.Terminfo import System.Console.Terminfo
import System.Posix.IO import System.Posix.IO
@ -140,7 +139,9 @@ instance Show (InputBlocksUsingTable event) where
instance Monad m => Serial m (InputBlocksUsingTable event) where instance Monad m => Serial m (InputBlocksUsingTable event) where
series = do series = do
n :: Int <- localDepth (const maxTableSize) series n :: Int <- localDepth (const maxTableSize) series
return $ InputBlocksUsingTable $ \table -> concat (take n (selections table)) return $ InputBlocksUsingTable $ \raw_table ->
let table = reverse $ nubBy (\(s0,_) (s1,_) -> s0 == s1) $ reverse raw_table
in concat (take n (selections table))
where where
selections [] = [] selections [] = []
selections (x:xs) = let z = selections xs in [x] : (z ++ map ((:) x) z) selections (x:xs) = let z = selections xs in [x] : (z ++ map ((:) x) z)
@ -159,7 +160,7 @@ verifyCapsSynInputToEvent = forAll $ \(InputBlocksUsingTable gen) ->
forEachOf terminalsOfInterest $ \termName -> monadic $ do forEachOf terminalsOfInterest $ \termName -> monadic $ do
term <- setupTerm termName term <- setupTerm termName
let table = capsClassifyTable term keysFromCapsTable let table = capsClassifyTable term keysFromCapsTable
inputSeq = gen table inputSeq = gen table
events = map snd inputSeq events = map snd inputSeq
keydowns = map (Bytes . fst) inputSeq keydowns = map (Bytes . fst) inputSeq
input = intersperse (Delay testKeyDelay) keydowns ++ [Delay testKeyDelay] input = intersperse (Delay testKeyDelay) keydowns ++ [Delay testKeyDelay]
@ -168,7 +169,7 @@ verifyCapsSynInputToEvent = forAll $ \(InputBlocksUsingTable gen) ->
verifySpecialSynInputToEvent :: Property IO verifySpecialSynInputToEvent :: Property IO
verifySpecialSynInputToEvent = forAll $ \(InputBlocksUsingTable gen) -> monadic $ do verifySpecialSynInputToEvent = forAll $ \(InputBlocksUsingTable gen) -> monadic $ do
let table = specialSupportKeys let table = specialSupportKeys
inputSeq = gen table inputSeq = gen table
events = map snd inputSeq events = map snd inputSeq
keydowns = map (Bytes . fst) inputSeq keydowns = map (Bytes . fst) inputSeq
input = intersperse (Delay testKeyDelay) keydowns ++ [Delay testKeyDelay] input = intersperse (Delay testKeyDelay) keydowns ++ [Delay testKeyDelay]
@ -179,7 +180,7 @@ verifyFullSynInputToEvent = forAll $ \(InputBlocksUsingTable gen) ->
forEachOf terminalsOfInterest $ \termName -> monadic $ do forEachOf terminalsOfInterest $ \termName -> monadic $ do
term <- setupTerm termName term <- setupTerm termName
let table = classifyTableForTerm termName term let table = classifyTableForTerm termName term
inputSeq = gen table inputSeq = gen table
events = map snd inputSeq events = map snd inputSeq
keydowns = map (Bytes . fst) inputSeq keydowns = map (Bytes . fst) inputSeq
input = intersperse (Delay testKeyDelay) keydowns ++ [Delay testKeyDelay] input = intersperse (Delay testKeyDelay) keydowns ++ [Delay testKeyDelay]
@ -190,7 +191,7 @@ verifyFullSynInputToEvent_2x = forAll $ \(InputBlocksUsingTable gen) ->
forEachOf terminalsOfInterest $ \termName -> monadic $ do forEachOf terminalsOfInterest $ \termName -> monadic $ do
term <- setupTerm termName term <- setupTerm termName
let table = classifyTableForTerm termName term let table = classifyTableForTerm termName term
inputSeq = gen table inputSeq = gen table
events = concatMap ((\s -> [s,s]) . snd) inputSeq events = concatMap ((\s -> [s,s]) . snd) inputSeq
keydowns = map (Bytes . (\s -> s ++ s) . fst) inputSeq keydowns = map (Bytes . (\s -> s ++ s) . fst) inputSeq
input = intersperse (Delay testKeyDelay) keydowns ++ [Delay testKeyDelay] input = intersperse (Delay testKeyDelay) keydowns ++ [Delay testKeyDelay]