starting to work on test suite for v6
This commit is contained in:
parent
7d0e79b9e1
commit
7800125783
2 changed files with 41 additions and 24 deletions
58
Test.hs
58
Test.hs
|
@ -38,6 +38,7 @@ import Common
|
|||
import qualified Utility.SafeCommand
|
||||
import qualified Annex
|
||||
import qualified Annex.UUID
|
||||
import qualified Annex.Version
|
||||
import qualified Backend
|
||||
import qualified Git.CurrentRepo
|
||||
import qualified Git.Filename
|
||||
|
@ -118,18 +119,17 @@ ingredients =
|
|||
]
|
||||
|
||||
tests :: TestTree
|
||||
tests = testGroup "Tests"
|
||||
-- Test both direct and indirect mode.
|
||||
-- Windows is only going to use direct mode, so don't test twice.
|
||||
[ properties
|
||||
tests = testGroup "Tests" $ properties :
|
||||
map (\(d, te) -> withTestMode te (unitTests d)) testmodes
|
||||
where
|
||||
testmodes =
|
||||
[ ("v5", TestMode { forceDirect = False, annexVersion = "5" })
|
||||
-- Windows will only use direct mode, so don't test twice.
|
||||
#ifndef mingw32_HOST_OS
|
||||
, withTestEnv True $ unitTests "(direct)"
|
||||
, withTestEnv False $ unitTests "(indirect)"
|
||||
#else
|
||||
, withTestEnv False $ unitTests ""
|
||||
, ("v5 direct", TestMode { forceDirect = True, annexVersion = "5" })
|
||||
, ("v6", TestMode { forceDirect = False, annexVersion = "6" })
|
||||
]
|
||||
#endif
|
||||
]
|
||||
|
||||
|
||||
properties :: TestTree
|
||||
properties = localOption (QuickCheckTests 1000) $ testGroup "QuickCheck"
|
||||
|
@ -244,7 +244,7 @@ unitTests note = testGroup ("Unit Tests " ++ note)
|
|||
test_init :: Assertion
|
||||
test_init = innewrepo $ do
|
||||
git_annex "init" [reponame] @? "init failed"
|
||||
handleforcedirect
|
||||
setupTestMode
|
||||
where
|
||||
reponame = "test repo"
|
||||
|
||||
|
@ -1506,7 +1506,7 @@ intmpclonerepoInDirect a = intmpclonerepo $
|
|||
)
|
||||
where
|
||||
isdirect = annexeval $ do
|
||||
Annex.Init.initialize Nothing
|
||||
Annex.Init.initialize Nothing Nothing
|
||||
Config.isDirect
|
||||
|
||||
checkRepo :: Types.Annex a -> FilePath -> IO a
|
||||
|
@ -1589,7 +1589,7 @@ clonerepo old new cfg = do
|
|||
git_annex "init" ["-q", new] @? "git annex init failed"
|
||||
unless (bareClone cfg) $
|
||||
indir new $
|
||||
handleforcedirect
|
||||
setupTestMode
|
||||
return new
|
||||
|
||||
configrepo :: FilePath -> IO ()
|
||||
|
@ -1600,10 +1600,6 @@ configrepo dir = indir dir $ do
|
|||
-- avoid signed commits by test suite
|
||||
boolSystem "git" [Param "config", Param "commit.gpgsign", Param "false"] @? "git config failed"
|
||||
|
||||
handleforcedirect :: IO ()
|
||||
handleforcedirect = whenM ((==) "1" <$> Utility.Env.getEnvDefault "FORCEDIRECT" "") $
|
||||
git_annex "direct" ["-q"] @? "git annex direct failed"
|
||||
|
||||
ensuretmpdir :: IO ()
|
||||
ensuretmpdir = do
|
||||
e <- doesDirectoryExist tmpdir
|
||||
|
@ -1722,11 +1718,16 @@ annexed_present = runchecks
|
|||
unannexed :: FilePath -> Assertion
|
||||
unannexed = runchecks [checkregularfile, checkcontent, checkwritable]
|
||||
|
||||
withTestEnv :: Bool -> TestTree -> TestTree
|
||||
withTestEnv forcedirect = withResource prepare release . const
|
||||
data TestMode = TestMode
|
||||
{ forceDirect :: Bool
|
||||
, annexVersion :: String
|
||||
} deriving (Read, Show)
|
||||
|
||||
withTestMode :: TestMode -> TestTree -> TestTree
|
||||
withTestMode testmode = withResource prepare release . const
|
||||
where
|
||||
prepare = do
|
||||
setTestEnv forcedirect
|
||||
setTestMode testmode
|
||||
case tryIngredients [consoleTestReporter] mempty initTests of
|
||||
Nothing -> error "No tests found!?"
|
||||
Just act -> unlessM act $
|
||||
|
@ -1734,8 +1735,8 @@ withTestEnv forcedirect = withResource prepare release . const
|
|||
return ()
|
||||
release _ = cleanup' True tmpdir
|
||||
|
||||
setTestEnv :: Bool -> IO ()
|
||||
setTestEnv forcedirect = do
|
||||
setTestMode :: TestMode -> IO ()
|
||||
setTestMode testmode = do
|
||||
whenM (doesDirectoryExist tmpdir) $
|
||||
error $ "The temporary directory " ++ tmpdir ++ " already exists; cannot run test suite."
|
||||
|
||||
|
@ -1755,9 +1756,20 @@ setTestEnv forcedirect = do
|
|||
, ("GIT_COMMITTER_NAME", "git-annex test")
|
||||
-- force gpg into batch mode for the tests
|
||||
, ("GPG_BATCH", "1")
|
||||
, ("FORCEDIRECT", if forcedirect then "1" else "")
|
||||
, ("TESTMODE", show testmode)
|
||||
]
|
||||
|
||||
getTestMode :: IO TestMode
|
||||
getTestMode = Prelude.read <$> Utility.Env.getEnvDefault "TESTMODE" ""
|
||||
|
||||
setupTestMode :: IO ()
|
||||
setupTestMode = do
|
||||
testmode <- getTestMode
|
||||
annexeval $
|
||||
Annex.Version.setVersion (annexVersion testmode)
|
||||
when (forceDirect testmode) $
|
||||
git_annex "direct" ["-q"] @? "git annex direct failed"
|
||||
|
||||
changeToTmpDir :: FilePath -> IO ()
|
||||
changeToTmpDir t = do
|
||||
topdir <- Utility.Env.getEnvDefault "TOPDIR" (error "TOPDIR not set")
|
||||
|
|
|
@ -321,7 +321,12 @@ files to be unlocked, while the indirect upgrades don't touch the files.
|
|||
|
||||
#### implementation todo list
|
||||
|
||||
* Test suite should have a pass that runs with files unlocked.
|
||||
* Test suite should have passes for:
|
||||
v5 indirect
|
||||
v5 direct
|
||||
v6 locked
|
||||
v6 unlocked
|
||||
Currently, the test suite fails horribly.
|
||||
* assistant: In v6 mode, adds files in unlocked mode, so they can
|
||||
continue to be modified. TODO
|
||||
* When the webapp creates a repo, it forces it into direct mode. But that
|
||||
|
|
Loading…
Reference in a new issue