more test output improvements

This commit is contained in:
Joey Hess 2013-02-28 01:21:22 -04:00
parent c938074358
commit 741a7fc4d7

88
Test.hs
View file

@ -64,28 +64,30 @@ main = do
putStrLn "Now, some broader checks ..." putStrLn "Now, some broader checks ..."
putStrLn " (Do not be alarmed by odd output here; it's normal." putStrLn " (Do not be alarmed by odd output here; it's normal."
putStrLn " wait for the last line to see how it went.)" putStrLn " wait for the last line to see how it went.)"
divider
prepare prepare
r <- runTestTT blackbox rs <- forM hunit $ \t -> do
divider
t
cleanup tmpdir cleanup tmpdir
divider divider
propigate r qcok propigate rs qcok
where where
divider = putStrLn $ take 70 $ repeat '-' divider = putStrLn $ take 70 $ repeat '-'
propigate :: Counts -> Bool -> IO () propigate :: [Counts] -> Bool -> IO ()
propigate Counts { errors = e , failures = f } qcok propigate cs qcok
| blackboxok && qcok = putStrLn "All tests ok." | countsok && qcok = putStrLn "All tests ok."
| otherwise = do | otherwise = do
unless qcok $ unless qcok $
putStrLn "Quick check tests failed! This is a bug in git-annex." putStrLn "Quick check tests failed! This is a bug in git-annex."
unless blackboxok $ do unless countsok $ do
putStrLn "Some tests failed!" putStrLn "Some tests failed!"
putStrLn " (This could be due to a bug in git-annex, or an incompatability" putStrLn " (This could be due to a bug in git-annex, or an incompatability"
putStrLn " with utilities, such as git, installed on this system.)" putStrLn " with utilities, such as git, installed on this system.)"
exitFailure exitFailure
where where
blackboxok = e+f == 0 noerrors (Counts { errors = e , failures = f }) = e + f == 0
countsok = all noerrors cs
quickcheck :: [IO Result] quickcheck :: [IO Result]
quickcheck = quickcheck =
@ -117,41 +119,45 @@ quickcheck =
putStrLn desc putStrLn desc
quickCheckResult prop quickCheckResult prop
blackbox :: Test hunit :: [IO Counts]
blackbox = TestLabel "blackbox" $ TestList hunit =
-- test order matters, later tests may rely on state from earlier -- test order matters, later tests may rely on state from earlier
[ test_init [ check "init" test_init
, test_add , check "add" test_add
, test_reinject , check "reinject" test_reinject
, test_unannex , check "unannex" test_unannex
, test_drop , check "drop" test_drop
, test_get , check "get" test_get
, test_move , check "move" test_move
, test_copy , check "copy" test_copy
, test_lock , check "lock" test_lock
, test_edit , check "edit" test_edit
, test_fix , check "fix" test_fix
, test_trust , check "trust" test_trust
, test_fsck , check "fsck" test_fsck
, test_migrate , check "migrate" test_migrate
, test_unused , check" unused" test_unused
, test_describe , check "describe" test_describe
, test_find , check "find" test_find
, test_merge , check "merge" test_merge
, test_status , check "status" test_status
, test_version , check "version" test_version
, test_sync , check "sync" test_sync
, test_sync_regression , check "sync regression" test_sync_regression
, test_map , check "map" test_map
, test_uninit , check "uninit" test_uninit
, test_upgrade , check "upgrade" test_upgrade
, test_whereis , check "whereis" test_whereis
, test_hook_remote , check "hook remote" test_hook_remote
, test_directory_remote , check "directory remote" test_directory_remote
, test_rsync_remote , check "rsync remote" test_rsync_remote
, test_bup_remote , check "bup remote" test_bup_remote
, test_crypto , check "crypto" test_crypto
] ]
where
check desc t = do
putStrLn desc
runTestTT t
test_init :: Test test_init :: Test
test_init = "git-annex init" ~: TestCase $ innewrepo $ do test_init = "git-annex init" ~: TestCase $ innewrepo $ do