mask output from quickcheck. need to be replaced with one that reports output via Progress values

This commit is contained in:
Corey O'Connor 2014-05-31 01:52:55 -07:00
parent 7d434d3104
commit 4aceef7a7f
3 changed files with 7 additions and 9 deletions

View File

@ -50,13 +50,11 @@ navKeys3 =
-- | encoding for shift plus function keys -- | encoding for shift plus function keys
-- --
-- TODO: I suspect this should be generated by interpretting the terminals use of meta mode: -- According to
-- "If the terminal has a ``meta key'' which acts as a shift key, setting the 8th bit of any
-- character transmitted, this fact can be indicated with km. Other- wise, software will
-- assume that the 8th bit is parity and it will usually be cleared. If strings exist to turn this
-- ``meta mode'' on and off, they can be given as smm and rmm."
-- --
-- That is more complex than below. I cannot fault the original author for just hard coding a table. -- * http://aperiodic.net/phil/archives/Geekery/term-function-keys.html
--
-- This encoding depends on the terminal.
functionKeys1 :: ClassifyTable functionKeys1 :: ClassifyTable
functionKeys1 = functionKeys1 =
let f ff nrs m = [ ("\ESC["++show n++"~",EvKey (KFun $ n-(nrs!!0)+ff) m) | n <- nrs ] in let f ff nrs m = [ ("\ESC["++show n++"~",EvKey (KFun $ n-(nrs!!0)+ff) m) | n <- nrs ] in

View File

@ -53,7 +53,7 @@ verify :: Testable t => String -> t -> Test
verify testName p = Test $ TestInstance verify testName p = Test $ TestInstance
{ name = testName { name = testName
, run = do , run = do
qcResult <- quickCheckResult p qcResult <- quickCheckWithResult (stdArgs {chatty = False}) p
case qcResult of case qcResult of
QC.Success {..} -> return $ Finished TS.Pass QC.Success {..} -> return $ Finished TS.Pass
QC.Failure {numShrinks,reason} -> return $ Finished QC.Failure {numShrinks,reason} -> return $ Finished

View File

@ -19,7 +19,7 @@ import System.IO
tests :: IO [Test] tests :: IO [Test]
tests = concat <$> forM terminalsOfInterest (\termName -> do tests = concat <$> forM terminalsOfInterest (\termName -> do
-- check if that terminfo exists -- check if that terminfo exists
putStrLn $ "testing end to end for terminal: " ++ termName -- putStrLn $ "testing end to end for terminal: " ++ termName
mti <- try $ Terminfo.setupTerm termName mti <- try $ Terminfo.setupTerm termName
case mti of case mti of
Left (_ :: SomeException) -> return [] Left (_ :: SomeException) -> return []
@ -47,7 +47,7 @@ smokeTestTerm :: String -> Image -> IO Result
smokeTestTerm termName i = do smokeTestTerm termName i = do
nullOut <- openFile "/dev/null" WriteMode nullOut <- openFile "/dev/null" WriteMode
t <- outputForNameAndIO termName nullOut t <- outputForNameAndIO termName nullOut
putStrLn $ "context color count: " ++ show (contextColorCount t) -- putStrLn $ "context color count: " ++ show (contextColorCount t)
reserveDisplay t reserveDisplay t
dc <- displayContext t (100,100) dc <- displayContext t (100,100)
-- always show the cursor to produce tests for terminals with no cursor support. -- always show the cursor to produce tests for terminals with no cursor support.