summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--GitAnnex.hs75
-rw-r--r--debian/changelog2
-rw-r--r--git-annex.hs66
-rw-r--r--test.hs42
4 files changed, 99 insertions, 86 deletions
diff --git a/GitAnnex.hs b/GitAnnex.hs
new file mode 100644
index 000000000..05e98d3c3
--- /dev/null
+++ b/GitAnnex.hs
@@ -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 ..]"
diff --git a/debian/changelog b/debian/changelog
index d9aa1e4de..0aaaa75e6 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -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
diff --git a/git-annex.hs b/git-annex.hs
index dff67f9d8..f95181784 100644
--- a/git-annex.hs
+++ b/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
diff --git a/test.hs b/test.hs
index b6b0c2740..74cce4142 100644
--- a/test.hs
+++ b/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