mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

test suite partially converted to use tasty test framework

Browse source 
This is a win. Will need to wait for tasty getting into Debian,
and do a trivial conversion of the remainder of the hunit tests.
This commit is contained in:
Joey Hess 2013-08-06 00:12:06 -04:00
parent a613117b82
commit 8189738b13
2 changed files with 94 additions and 112 deletions
Download patch file Download diff file Expand all files Collapse all files

204
Test.hs
View file

@ -9,12 +9,15 @@
module Test where module Test where
import Test.Tasty
import Test.Tasty.Runners
import Test.Tasty.HUnit
import Test.Tasty.QuickCheck
import Test.HUnit import Test.HUnit
import Test.QuickCheck
import Test.QuickCheck.Test
import System.PosixCompat.Files import System.PosixCompat.Files
import Control.Exception.Extensible import Control.Exception.Extensible
import Data.Monoid
import qualified Data.Map as M import qualified Data.Map as M
import System.IO.HVFS (SystemFS(..)) import System.IO.HVFS (SystemFS(..))
import qualified Text.JSON import qualified Text.JSON
@ -66,83 +69,57 @@ type TestEnv = M.Map String String
main :: IO () main :: IO ()
main = do main = do
divider
putStrLn "First, some automated quick checks of properties ..."
divider
qcok <- all isSuccess <$> sequence quickcheck
divider
putStrLn "Now, some broader checks ..."
putStrLn " (Do not be alarmed by odd output here; it's normal."
putStrLn " wait for the last line to see how it went.)"
rs <- runhunit =<< prepare False
#ifndef mingw32_HOST_OS #ifndef mingw32_HOST_OS
directrs <- runhunit =<< prepare True indirectenv <- prepare False
directenv <- prepare True
let tests = testGroup "Tests"
[ properties
, unitTests indirectenv "(indirect)"
, unitTests directenv "(direct)"
]
#else #else
-- Windows is only going to use direct mode, so don't test twice. -- Windows is only going to use direct mode, so don't test twice.
let directrs = [] env <- prepare False
let tests = testGroup "Tests"
[properties, unitTests env ""]
#endif #endif
divider runUI mempty tests =<< launchTestTree mempty tests
propigate (rs++directrs) qcok
where
divider = putStrLn $ replicate 70 '-'
runhunit env = do
r <- forM hunit $ \t -> do
divider
t env
cleanup tmpdir
return r
propigate :: [Counts] -> Bool -> IO () properties :: TestTree
propigate cs qcok properties = testGroup "QuickCheck"
| countsok && qcok = putStrLn "All tests ok." [ testProperty "prop_idempotent_deencode_git" Git.Filename.prop_idempotent_deencode
| otherwise = do , testProperty "prop_idempotent_deencode" Utility.Format.prop_idempotent_deencode
unless qcok $ , testProperty "prop_idempotent_fileKey" Locations.prop_idempotent_fileKey
putStrLn "Quick check tests failed! This is a bug in git-annex." , testProperty "prop_idempotent_key_encode" Types.Key.prop_idempotent_key_encode
unless countsok $ do , testProperty "prop_idempotent_shellEscape" Utility.SafeCommand.prop_idempotent_shellEscape
putStrLn "Some tests failed!" , testProperty "prop_idempotent_shellEscape_multiword" Utility.SafeCommand.prop_idempotent_shellEscape_multiword
putStrLn " (This could be due to a bug in git-annex, or an incompatability" , testProperty "prop_idempotent_configEscape" Logs.Remote.prop_idempotent_configEscape
putStrLn " with utilities, such as git, installed on this system.)" , testProperty "prop_parse_show_Config" Logs.Remote.prop_parse_show_Config
exitFailure , testProperty "prop_parentDir_basics" Utility.Path.prop_parentDir_basics
where , testProperty "prop_relPathDirToFile_basics" Utility.Path.prop_relPathDirToFile_basics
noerrors (Counts { errors = e , failures = f }) = e + f == 0 , testProperty "prop_relPathDirToFile_regressionTest" Utility.Path.prop_relPathDirToFile_regressionTest
countsok = all noerrors cs , testProperty "prop_cost_sane" Config.Cost.prop_cost_sane
, testProperty "prop_matcher_sane" Utility.Matcher.prop_matcher_sane
quickcheck :: [IO Result] , testProperty "prop_HmacSha1WithCipher_sane" Crypto.prop_HmacSha1WithCipher_sane
quickcheck = , testProperty "prop_TimeStamp_sane" Logs.UUIDBased.prop_TimeStamp_sane
[ check "prop_idempotent_deencode_git" Git.Filename.prop_idempotent_deencode , testProperty "prop_addLog_sane" Logs.UUIDBased.prop_addLog_sane
, check "prop_idempotent_deencode" Utility.Format.prop_idempotent_deencode , testProperty "prop_verifiable_sane" Utility.Verifiable.prop_verifiable_sane
, check "prop_idempotent_fileKey" Locations.prop_idempotent_fileKey , testProperty "prop_segment_regressionTest" Utility.Misc.prop_segment_regressionTest
, check "prop_idempotent_key_encode" Types.Key.prop_idempotent_key_encode , testProperty "prop_read_write_transferinfo" Logs.Transfer.prop_read_write_transferinfo
, check "prop_idempotent_shellEscape" Utility.SafeCommand.prop_idempotent_shellEscape , testProperty "prop_read_show_inodecache" Utility.InodeCache.prop_read_show_inodecache
, check "prop_idempotent_shellEscape_multiword" Utility.SafeCommand.prop_idempotent_shellEscape_multiword , testProperty "prop_parse_show_log" Logs.Presence.prop_parse_show_log
, check "prop_idempotent_configEscape" Logs.Remote.prop_idempotent_configEscape , testProperty "prop_read_show_TrustLevel" Types.TrustLevel.prop_read_show_TrustLevel
, check "prop_parse_show_Config" Logs.Remote.prop_parse_show_Config , testProperty "prop_parse_show_TrustLog" Logs.Trust.prop_parse_show_TrustLog
, check "prop_parentDir_basics" Utility.Path.prop_parentDir_basics
, check "prop_relPathDirToFile_basics" Utility.Path.prop_relPathDirToFile_basics
, check "prop_relPathDirToFile_regressionTest" Utility.Path.prop_relPathDirToFile_regressionTest
, check "prop_cost_sane" Config.Cost.prop_cost_sane
, check "prop_matcher_sane" Utility.Matcher.prop_matcher_sane
, check "prop_HmacSha1WithCipher_sane" Crypto.prop_HmacSha1WithCipher_sane
, check "prop_TimeStamp_sane" Logs.UUIDBased.prop_TimeStamp_sane
, check "prop_addLog_sane" Logs.UUIDBased.prop_addLog_sane
, check "prop_verifiable_sane" Utility.Verifiable.prop_verifiable_sane
, check "prop_segment_regressionTest" Utility.Misc.prop_segment_regressionTest
, check "prop_read_write_transferinfo" Logs.Transfer.prop_read_write_transferinfo
, check "prop_read_show_inodecache" Utility.InodeCache.prop_read_show_inodecache
, check "prop_parse_show_log" Logs.Presence.prop_parse_show_log
, check "prop_read_show_TrustLevel" Types.TrustLevel.prop_read_show_TrustLevel
, check "prop_parse_show_TrustLog" Logs.Trust.prop_parse_show_TrustLog
] ]
where
check desc prop = do
putStrLn desc
quickCheckResult prop
hunit :: [TestEnv -> IO Counts] unitTests :: TestEnv -> String -> TestTree
hunit = unitTests env note = testGroup ("Unit Tests " ++ note)
-- test order matters, later tests may rely on state from earlier -- test order matters, later tests may rely on state from earlier
[ check "init" test_init [ check "init" test_init
, check "add" test_add , check "add" test_add
, check "add sha1dup" test_add_sha1dup
, check "add subdirs" test_add_subdirs
{-
, check "reinject" test_reinject , check "reinject" test_reinject
, check "unannex" test_unannex , check "unannex" test_unannex
, check "drop" test_drop , check "drop" test_drop
@ -174,57 +151,62 @@ hunit =
, check "bup remote" test_bup_remote , check "bup remote" test_bup_remote
, check "crypto" test_crypto , check "crypto" test_crypto
, check "preferred content" test_preferred_content , check "preferred content" test_preferred_content
-}
, check "global cleanup" test_global_cleanup
] ]
where where
check desc t env = do check desc t = testCase desc (t env)
putStrLn desc
runTestTT (t env)
test_init :: TestEnv -> Test test_global_cleanup :: TestEnv -> Assertion
test_init env = "git-annex init" ~: TestCase $ innewrepo env $ do test_global_cleanup env = cleanup tmpdir
test_init :: TestEnv -> Assertion
test_init env = innewrepo env $ do
git_annex env "init" [reponame] @? "init failed" git_annex env "init" [reponame] @? "init failed"
handleforcedirect env handleforcedirect env
where where
reponame = "test repo" reponame = "test repo"
test_add :: TestEnv -> Test -- this test case runs in the main repo, to set up a basic
test_add env = "git-annex add" ~: TestList [basic, sha1dup, subdirs] -- annexed file that later tests will use
where test_add :: TestEnv -> Assertion
-- this test case runs in the main repo, to set up a basic test_add env = inmainrepo env $ do
-- annexed file that later tests will use writeFile annexedfile $ content annexedfile
basic = TestCase $ inmainrepo env $ do git_annex env "add" [annexedfile] @? "add failed"
writeFile annexedfile $ content annexedfile annexed_present annexedfile
git_annex env "add" [annexedfile] @? "add failed" writeFile sha1annexedfile $ content sha1annexedfile
annexed_present annexedfile git_annex env "add" [sha1annexedfile, "--backend=SHA1"] @? "add with SHA1 failed"
writeFile sha1annexedfile $ content sha1annexedfile annexed_present sha1annexedfile
git_annex env "add" [sha1annexedfile, "--backend=SHA1"] @? "add with SHA1 failed" checkbackend sha1annexedfile backendSHA1
annexed_present sha1annexedfile writeFile wormannexedfile $ content wormannexedfile
checkbackend sha1annexedfile backendSHA1 git_annex env "add" [wormannexedfile, "--backend=WORM"] @? "add with WORM failed"
writeFile wormannexedfile $ content wormannexedfile annexed_present wormannexedfile
git_annex env "add" [wormannexedfile, "--backend=WORM"] @? "add with WORM failed" checkbackend wormannexedfile backendWORM
annexed_present wormannexedfile boolSystem "git" [Params "rm --force -q", File wormannexedfile] @? "git rm failed"
checkbackend wormannexedfile backendWORM writeFile ingitfile $ content ingitfile
boolSystem "git" [Params "rm --force -q", File wormannexedfile] @? "git rm failed" boolSystem "git" [Param "add", File ingitfile] @? "git add failed"
writeFile ingitfile $ content ingitfile boolSystem "git" [Params "commit -q -m commit"] @? "git commit failed"
boolSystem "git" [Param "add", File ingitfile] @? "git add failed" git_annex env "add" [ingitfile] @? "add ingitfile should be no-op"
boolSystem "git" [Params "commit -q -m commit"] @? "git commit failed" unannexed ingitfile
git_annex env "add" [ingitfile] @? "add ingitfile should be no-op"
unannexed ingitfile test_add_sha1dup :: TestEnv -> Assertion
sha1dup = TestCase $ intmpclonerepo env $ do test_add_sha1dup env = intmpclonerepo env $ do
writeFile sha1annexedfiledup $ content sha1annexedfiledup writeFile sha1annexedfiledup $ content sha1annexedfiledup
git_annex env "add" [sha1annexedfiledup, "--backend=SHA1"] @? "add of second file with same SHA1 failed" git_annex env "add" [sha1annexedfiledup, "--backend=SHA1"] @? "add of second file with same SHA1 failed"
annexed_present sha1annexedfiledup annexed_present sha1annexedfiledup
annexed_present sha1annexedfile annexed_present sha1annexedfile
subdirs = TestCase $ intmpclonerepo env $ do
createDirectory "dir" test_add_subdirs :: TestEnv -> Assertion
writeFile ("dir" </> "foo") $ content annexedfile test_add_subdirs env = intmpclonerepo env $ do
git_annex env "add" ["dir"] @? "add of subdir failed" createDirectory "dir"
createDirectory "dir2" writeFile ("dir" </> "foo") $ content annexedfile
writeFile ("dir2" </> "foo") $ content annexedfile git_annex env "add" ["dir"] @? "add of subdir failed"
createDirectory "dir2"
writeFile ("dir2" </> "foo") $ content annexedfile
#ifndef mingw32_HOST_OS #ifndef mingw32_HOST_OS
{- This does not work on Windows, for whatever reason. -} {- This does not work on Windows, for whatever reason. -}
setCurrentDirectory "dir" setCurrentDirectory "dir"
git_annex env "add" [".." </> "dir2"] @? "add of ../subdir failed" git_annex env "add" [".." </> "dir2"] @? "add of ../subdir failed"
#endif #endif
test_reinject :: TestEnv -> Test test_reinject :: TestEnv -> Test

2
git-annex.cabal
View file

@ -97,7 +97,7 @@ Executable git-annex
Build-Depends: unix Build-Depends: unix
if flag(TestSuite) if flag(TestSuite)
Build-Depends: HUnit Build-Depends: HUnit, tasty, tasty-hunit, tasty-quickcheck
CPP-Options: -DWITH_TESTSUITE CPP-Options: -DWITH_TESTSUITE
if flag(TDFA) if flag(TDFA)