cleaner test dependencies

This improves the display of tests.

tasty-1.2 is in debian stable.

Sponsored-by: Dartmouth College's Datalad project
This commit is contained in:
Joey Hess 2022-03-16 12:53:08 -04:00
parent d3b7c6705c
commit be31a8a3d2
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
3 changed files with 14 additions and 18 deletions

19
Test.hs
View file

@ -107,8 +107,8 @@ runner opts = parallelTestRunner opts tests
tests :: Int -> Bool -> Bool -> TestOptions -> [TestTree] tests :: Int -> Bool -> Bool -> TestOptions -> [TestTree]
tests n crippledfilesystem adjustedbranchok opts = tests n crippledfilesystem adjustedbranchok opts =
properties properties
: withTestMode remotetestmode Nothing testRemotes : withTestMode remotetestmode testRemotes
: concatMap mkunittests testmodes : concatMap mkrepotests testmodes
where where
testmodes = catMaybes testmodes = catMaybes
[ canadjust ("v8 adjusted unlocked branch", (testMode opts (RepoVersion 8)) { adjustedUnlockedBranch = True }) [ canadjust ("v8 adjusted unlocked branch", (testMode opts (RepoVersion 8)) { adjustedUnlockedBranch = True })
@ -122,9 +122,9 @@ tests n crippledfilesystem adjustedbranchok opts =
canadjust v canadjust v
| adjustedbranchok = Just v | adjustedbranchok = Just v
| otherwise = Nothing | otherwise = Nothing
mkunittests (d, te) = map mkrepotests (d, te) = map
(\uts -> withTestMode te (Just initTests) uts) (\uts -> withTestMode te uts)
(unitTests d n) (repoTests d n)
properties :: TestTree properties :: TestTree
properties = localOption (QuickCheckTests 1000) $ testGroup "QuickCheck" $ properties = localOption (QuickCheckTests 1000) $ testGroup "QuickCheck" $
@ -244,15 +244,15 @@ testRemote testvariants remotetype setupremote =
desckeysize sz = descas ("key size " ++ show sz) desckeysize sz = descas ("key size " ++ show sz)
{- These tests set up the test environment, but also test some basic parts {- These tests set up the test environment, but also test some basic parts
- of git-annex. They are always run before the unitTests. -} - of git-annex. They are always run before the repoTests. -}
initTests :: TestTree initTests :: TestTree
initTests = testGroup "Init Tests" initTests = testGroup "Init Tests"
[ testCase "init" test_init [ testCase "init" test_init
, testCase "add" test_add , testCase "add" test_add
] ]
unitTests :: String -> Int -> [TestTree] repoTests :: String -> Int -> [TestTree]
unitTests note numparts = map (testGroup ("Unit Tests " ++ note)) $ sep repoTests note numparts = map mk $ sep
[ testCase "add dup" test_add_dup [ testCase "add dup" test_add_dup
, testCase "add extras" test_add_extras , testCase "add extras" test_add_extras
, testCase "readonly remote" test_readonly_remote , testCase "readonly remote" test_readonly_remote
@ -332,6 +332,9 @@ unitTests note numparts = map (testGroup ("Unit Tests " ++ note)) $ sep
, testCase "addurl" test_addurl , testCase "addurl" test_addurl
] ]
where where
mk l = testGroup groupname (initTests : map adddep l)
adddep = Test.Tasty.after AllSucceed (groupname ++ ".Init Tests")
groupname = "Repo Tests " ++ note
sep = sep' (replicate numparts []) sep = sep' (replicate numparts [])
sep' (p:ps) (l:ls) = sep' (ps++[l:p]) ls sep' (p:ps) (l:ls) = sep' (ps++[l:p]) ls
sep' ps [] = ps sep' ps [] = ps

View file

@ -457,19 +457,12 @@ testMode opts v = TestMode
hasUnlockedFiles :: TestMode -> Bool hasUnlockedFiles :: TestMode -> Bool
hasUnlockedFiles m = unlockedFiles m || adjustedUnlockedBranch m hasUnlockedFiles m = unlockedFiles m || adjustedUnlockedBranch m
withTestMode :: TestMode -> Maybe TestTree -> TestTree -> TestTree withTestMode :: TestMode -> TestTree -> TestTree
withTestMode testmode minittests = withResource prepare release . const withTestMode testmode = withResource prepare release . const
where where
prepare = do prepare = do
setTestMode testmode setTestMode testmode
setmainrepodir =<< newmainrepodir setmainrepodir =<< newmainrepodir
case minittests of
Just inittests ->
case tryIngredients [consoleTestReporter] mempty inittests of
Nothing -> error "No tests found!?"
Just act -> unlessM act $
error "init tests failed! cannot continue"
Nothing -> return ()
release _ = noop release _ = noop
setTestMode :: TestMode -> IO () setTestMode :: TestMode -> IO ()

View file

@ -374,7 +374,7 @@ Executable git-annex
attoparsec (>= 0.13.2.2), attoparsec (>= 0.13.2.2),
concurrent-output (>= 1.10), concurrent-output (>= 1.10),
QuickCheck (>= 2.10.0), QuickCheck (>= 2.10.0),
tasty (>= 0.7), tasty (>= 1.2),
tasty-hunit, tasty-hunit,
tasty-quickcheck, tasty-quickcheck,
tasty-rerun, tasty-rerun,