make test suite link in git-annex's commands and run directly
this way, test coverage works
This commit is contained in:
Joey Hess
parent
901cdbde78
commit
2533d826fc
4 changed files with 99 additions and 86 deletions
75
GitAnnex.hs
Normal file
75
GitAnnex.hs
Normal file
|
|
@ -0,0 +1,75 @@
|
|||
{- git-annex main program
|
||||
-
|
||||
- Copyright 2010 Joey Hess <joey@kitenet.net>
|
||||
-
|
||||
- Licensed under the GNU GPL version 3 or higher.
|
||||
-}
|
||||
|
||||
module GitAnnex where
|
||||
|
||||
import System.Console.GetOpt
|
||||
|
||||
import Command
|
||||
import Options
|
||||
|
||||
import qualified Command.Add
|
||||
import qualified Command.Unannex
|
||||
import qualified Command.Drop
|
||||
import qualified Command.Move
|
||||
import qualified Command.Copy
|
||||
import qualified Command.Get
|
||||
import qualified Command.FromKey
|
||||
import qualified Command.DropKey
|
||||
import qualified Command.SetKey
|
||||
import qualified Command.Fix
|
||||
import qualified Command.Init
|
||||
import qualified Command.Fsck
|
||||
import qualified Command.Unused
|
||||
import qualified Command.DropUnused
|
||||
import qualified Command.Unlock
|
||||
import qualified Command.Lock
|
||||
import qualified Command.PreCommit
|
||||
import qualified Command.Find
|
||||
import qualified Command.Uninit
|
||||
import qualified Command.Trust
|
||||
import qualified Command.Untrust
|
||||
|
||||
cmds :: [Command]
|
||||
cmds = concat
|
||||
[ Command.Add.command
|
||||
, Command.Get.command
|
||||
, Command.Drop.command
|
||||
, Command.Move.command
|
||||
, Command.Copy.command
|
||||
, Command.Unlock.command
|
||||
, Command.Lock.command
|
||||
, Command.Init.command
|
||||
, Command.Unannex.command
|
||||
, Command.Uninit.command
|
||||
, Command.PreCommit.command
|
||||
, Command.Trust.command
|
||||
, Command.Untrust.command
|
||||
, Command.FromKey.command
|
||||
, Command.DropKey.command
|
||||
, Command.SetKey.command
|
||||
, Command.Fix.command
|
||||
, Command.Fsck.command
|
||||
, Command.Unused.command
|
||||
, Command.DropUnused.command
|
||||
, Command.Find.command
|
||||
]
|
||||
|
||||
options :: [Option]
|
||||
options = commonOptions ++
|
||||
[ Option ['k'] ["key"] (ReqArg (storeOptString "key") paramKey)
|
||||
"specify a key to use"
|
||||
, Option ['t'] ["to"] (ReqArg (storeOptString "torepository") paramRemote)
|
||||
"specify to where to transfer content"
|
||||
, Option ['f'] ["from"] (ReqArg (storeOptString "fromrepository") paramRemote)
|
||||
"specify from where to transfer content"
|
||||
, Option ['x'] ["exclude"] (ReqArg (storeOptString "exclude") paramGlob)
|
||||
"skip files matching the glob pattern"
|
||||
]
|
||||
|
||||
header :: String
|
||||
header = "Usage: git-annex command [option ..]"
|
||||
2
debian/changelog
vendored
2
debian/changelog
vendored
|
|
@ -8,7 +8,7 @@ git-annex (0.16) UNRELEASED; urgency=low
|
|||
significant problem, since the remote *did* record that it had the file.
|
||||
* Also, add a general guard to detect attempts to record information
|
||||
about repositories with missing UUIDs.
|
||||
* Test suite improvements.
|
||||
* Test suite improvements. Current top-level test coverage: 43%
|
||||
|
||||
-- Joey Hess <joeyh@debian.org> Tue, 04 Jan 2011 17:33:42 -0400
|
||||
|
||||
|
|
|
|||
66
git-annex.hs
66
git-annex.hs
|
|
@ -6,74 +6,10 @@
|
|||
-}
|
||||
|
||||
import System.Environment
|
||||
import System.Console.GetOpt
|
||||
|
||||
import qualified GitRepo as Git
|
||||
import CmdLine
|
||||
import Command
|
||||
import Options
|
||||
|
||||
import qualified Command.Add
|
||||
import qualified Command.Unannex
|
||||
import qualified Command.Drop
|
||||
import qualified Command.Move
|
||||
import qualified Command.Copy
|
||||
import qualified Command.Get
|
||||
import qualified Command.FromKey
|
||||
import qualified Command.DropKey
|
||||
import qualified Command.SetKey
|
||||
import qualified Command.Fix
|
||||
import qualified Command.Init
|
||||
import qualified Command.Fsck
|
||||
import qualified Command.Unused
|
||||
import qualified Command.DropUnused
|
||||
import qualified Command.Unlock
|
||||
import qualified Command.Lock
|
||||
import qualified Command.PreCommit
|
||||
import qualified Command.Find
|
||||
import qualified Command.Uninit
|
||||
import qualified Command.Trust
|
||||
import qualified Command.Untrust
|
||||
|
||||
cmds :: [Command]
|
||||
cmds = concat
|
||||
[ Command.Add.command
|
||||
, Command.Get.command
|
||||
, Command.Drop.command
|
||||
, Command.Move.command
|
||||
, Command.Copy.command
|
||||
, Command.Unlock.command
|
||||
, Command.Lock.command
|
||||
, Command.Init.command
|
||||
, Command.Unannex.command
|
||||
, Command.Uninit.command
|
||||
, Command.PreCommit.command
|
||||
, Command.Trust.command
|
||||
, Command.Untrust.command
|
||||
, Command.FromKey.command
|
||||
, Command.DropKey.command
|
||||
, Command.SetKey.command
|
||||
, Command.Fix.command
|
||||
, Command.Fsck.command
|
||||
, Command.Unused.command
|
||||
, Command.DropUnused.command
|
||||
, Command.Find.command
|
||||
]
|
||||
|
||||
options :: [Option]
|
||||
options = commonOptions ++
|
||||
[ Option ['k'] ["key"] (ReqArg (storeOptString "key") paramKey)
|
||||
"specify a key to use"
|
||||
, Option ['t'] ["to"] (ReqArg (storeOptString "torepository") paramRemote)
|
||||
"specify to where to transfer content"
|
||||
, Option ['f'] ["from"] (ReqArg (storeOptString "fromrepository") paramRemote)
|
||||
"specify from where to transfer content"
|
||||
, Option ['x'] ["exclude"] (ReqArg (storeOptString "exclude") paramGlob)
|
||||
"skip files matching the glob pattern"
|
||||
]
|
||||
|
||||
header :: String
|
||||
header = "Usage: git-annex command [option ..]"
|
||||
import GitAnnex
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
|
|
|
|||
42
test.hs
42
test.hs
|
|
@ -10,35 +10,30 @@ import Test.HUnit.Tools
|
|||
import System.Directory
|
||||
import System.Posix.Directory (changeWorkingDirectory)
|
||||
import System.Posix.Files
|
||||
import System.Posix.Env
|
||||
import IO (bracket_, bracket)
|
||||
import Control.Monad (unless, when)
|
||||
import Data.List
|
||||
import System.IO.Error
|
||||
|
||||
import qualified GitRepo as Git
|
||||
import Locations
|
||||
import Utility
|
||||
import TypeInternals
|
||||
import qualified Locations
|
||||
import qualified Utility
|
||||
import qualified TypeInternals
|
||||
import qualified GitAnnex
|
||||
import qualified CmdLine
|
||||
|
||||
main :: IO (Counts, Int)
|
||||
main = do
|
||||
-- Add current directory to the from of PATH, so git-annex etc will
|
||||
-- be used, no matter where it is run from.
|
||||
cwd <- getCurrentDirectory
|
||||
p <- getEnvDefault "PATH" ""
|
||||
setEnv "PATH" (cwd++":"++p) True
|
||||
runVerboseTests $ TestList [quickchecks, toplevels]
|
||||
main = runVerboseTests $ TestList [quickchecks, toplevels]
|
||||
|
||||
quickchecks :: Test
|
||||
quickchecks = TestLabel "quickchecks" $ TestList
|
||||
[ qctest "prop_idempotent_deencode" Git.prop_idempotent_deencode
|
||||
, qctest "prop_idempotent_fileKey" prop_idempotent_fileKey
|
||||
, qctest "prop_idempotent_key_read_show" prop_idempotent_key_read_show
|
||||
, qctest "prop_idempotent_shellEscape" prop_idempotent_shellEscape
|
||||
, qctest "prop_idempotent_shellEscape_multiword" prop_idempotent_shellEscape_multiword
|
||||
, qctest "prop_parentDir_basics" prop_parentDir_basics
|
||||
, qctest "prop_relPathDirToDir_basics" prop_relPathDirToDir_basics
|
||||
, qctest "prop_idempotent_fileKey" Locations.prop_idempotent_fileKey
|
||||
, qctest "prop_idempotent_key_read_show" TypeInternals.prop_idempotent_key_read_show
|
||||
, qctest "prop_idempotent_shellEscape" Utility.prop_idempotent_shellEscape
|
||||
, qctest "prop_idempotent_shellEscape_multiword" Utility.prop_idempotent_shellEscape_multiword
|
||||
, qctest "prop_parentDir_basics" Utility.prop_parentDir_basics
|
||||
, qctest "prop_relPathDirToDir_basics" Utility.prop_relPathDirToDir_basics
|
||||
]
|
||||
|
||||
toplevels :: Test
|
||||
|
|
@ -79,7 +74,14 @@ test_add = TestLabel "git-annex add" $ TestCase $ inannex $ do
|
|||
content = "foo file content"
|
||||
|
||||
git_annex :: String -> [String] -> IO Bool
|
||||
git_annex command params = boolSystem "git-annex" (command:params)
|
||||
git_annex command params = do
|
||||
gitrepo <- Git.repoFromCwd
|
||||
r <- try $
|
||||
CmdLine.dispatch gitrepo (command:params)
|
||||
GitAnnex.cmds GitAnnex.options GitAnnex.header
|
||||
case r of
|
||||
Right _ -> return True
|
||||
Left _ -> return False
|
||||
|
||||
inannex :: Assertion -> Assertion
|
||||
inannex a = ingitrepo $ do
|
||||
|
|
@ -103,7 +105,7 @@ withgitrepo = bracket setup cleanup
|
|||
setup = do
|
||||
cleanup True
|
||||
createDirectory tmpdir
|
||||
ok <- boolSystem "git" ["init", "-q", repodir]
|
||||
ok <- Utility.boolSystem "git" ["init", "-q", repodir]
|
||||
unless ok $
|
||||
assertFailure "git init failed"
|
||||
return $ Git.repoFromPath repodir
|
||||
|
|
@ -113,5 +115,5 @@ withgitrepo = bracket setup cleanup
|
|||
-- git-annex prevents annexed file content
|
||||
-- from being removed with permissions
|
||||
-- bits; undo
|
||||
_ <- boolSystem "chmod" ["+rw", "-R", tmpdir]
|
||||
_ <- Utility.boolSystem "chmod" ["+rw", "-R", tmpdir]
|
||||
removeDirectoryRecursive tmpdir
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue