diff options
| -rw-r--r-- | Annex/Ssh.hs | 1 | ||||
| -rw-r--r-- | Assistant/Install.hs | 10 | ||||
| -rw-r--r-- | Assistant/Threads/RemoteControl.hs | 1 | ||||
| -rw-r--r-- | Assistant/TransferrerPool.hs | 1 | ||||
| -rw-r--r-- | Assistant/XMPP/Git.hs | 9 | ||||
| -rw-r--r-- | Command/Status.hs | 4 | ||||
| -rw-r--r-- | Command/Uninit.hs | 4 | ||||
| -rw-r--r-- | Command/WebApp.hs | 1 | ||||
| -rw-r--r-- | Git/CheckAttr.hs | 10 | ||||
| -rw-r--r-- | Git/Command.hs | 2 | ||||
| -rw-r--r-- | Git/Config.hs | 1 | ||||
| -rw-r--r-- | Git/CurrentRepo.hs | 8 | ||||
| -rw-r--r-- | Git/Fsck.hs | 1 | ||||
| -rw-r--r-- | Git/LsFiles.hs | 4 | ||||
| -rw-r--r-- | Git/Queue.hs | 3 | ||||
| -rw-r--r-- | Git/UpdateIndex.hs | 1 | ||||
| -rw-r--r-- | Locations.hs | 4 | ||||
| -rw-r--r-- | Remote/External.hs | 1 | ||||
| -rw-r--r-- | Remote/Git.hs | 9 | ||||
| -rw-r--r-- | Remote/Glacier.hs | 2 | ||||
| -rw-r--r-- | Remote/Hook.hs | 16 | ||||
| -rw-r--r-- | RemoteDaemon/Transport/Ssh.hs | 1 | ||||
| -rw-r--r-- | Test.hs | 816 | ||||
| -rw-r--r-- | Utility/Batch.hs | 1 | ||||
| -rw-r--r-- | Utility/CoProcess.hs | 4 | ||||
| -rw-r--r-- | Utility/ExternalSHA.hs | 1 | ||||
| -rw-r--r-- | Utility/Process.hs | 2 | ||||
| -rw-r--r-- | Utility/SafeCommand.hs | 1 |
28 files changed, 449 insertions, 470 deletions
diff --git a/Annex/Ssh.hs b/Annex/Ssh.hs index 21bb83e28..7b32c6196 100644 --- a/Annex/Ssh.hs +++ b/Annex/Ssh.hs @@ -22,7 +22,6 @@ module Annex.Ssh ( import qualified Data.Map as M import Data.Hash.MD5 -import System.Process (cwd) import System.Exit import Common.Annex diff --git a/Assistant/Install.hs b/Assistant/Install.hs index afbe5b9c0..89025cdae 100644 --- a/Assistant/Install.hs +++ b/Assistant/Install.hs @@ -122,15 +122,15 @@ installNautilus _ = noop cleanEnvironment :: IO (Maybe [(String, String)]) cleanEnvironment = clean <$> getEnvironment where - clean env + clean environ | null vars = Nothing - | otherwise = Just $ catMaybes $ map (restoreorig env) env + | otherwise = Just $ catMaybes $ map (restoreorig environ) environ | otherwise = Nothing where vars = words $ fromMaybe "" $ - lookup "GIT_ANNEX_STANDLONE_ENV" env - restoreorig oldenv p@(k, _v) - | k `elem` vars = case lookup ("ORIG_" ++ k) oldenv of + lookup "GIT_ANNEX_STANDLONE_ENV" environ + restoreorig oldenviron p@(k, _v) + | k `elem` vars = case lookup ("ORIG_" ++ k) oldenviron of (Just v') | not (null v') -> Just (k, v') _ -> Nothing diff --git a/Assistant/Threads/RemoteControl.hs b/Assistant/Threads/RemoteControl.hs index 317efe412..5af4fddcd 100644 --- a/Assistant/Threads/RemoteControl.hs +++ b/Assistant/Threads/RemoteControl.hs @@ -22,7 +22,6 @@ import qualified Types.Remote as Remote import Control.Concurrent import Control.Concurrent.Async -import System.Process (std_in, std_out) import Network.URI import qualified Data.Map as M import qualified Data.Set as S diff --git a/Assistant/TransferrerPool.hs b/Assistant/TransferrerPool.hs index cfd6e01fa..3ac9f3452 100644 --- a/Assistant/TransferrerPool.hs +++ b/Assistant/TransferrerPool.hs @@ -15,7 +15,6 @@ import Utility.Batch import qualified Command.TransferKeys as T import Control.Concurrent.STM hiding (check) -import System.Process (create_group, std_in, std_out) import Control.Exception (throw) import Control.Concurrent diff --git a/Assistant/XMPP/Git.hs b/Assistant/XMPP/Git.hs index 36ada5c08..301aa7185 100644 --- a/Assistant/XMPP/Git.hs +++ b/Assistant/XMPP/Git.hs @@ -38,7 +38,6 @@ import Utility.Env import Network.Protocol.XMPP import qualified Data.Text as T import System.Posix.Types -import System.Process (std_in, std_out, std_err) import Control.Concurrent import System.Timeout import qualified Data.ByteString as B @@ -112,15 +111,15 @@ xmppPush cid gitpush = do tmpdir <- gettmpdir installwrapper tmpdir - env <- liftIO getEnvironment + environ <- liftIO getEnvironment path <- liftIO getSearchPath - let myenv = addEntries + let myenviron = addEntries [ ("PATH", intercalate [searchPathSeparator] $ tmpdir:path) , (relayIn, show inf) , (relayOut, show outf) , (relayControl, show controlf) ] - env + environ inh <- liftIO $ fdToHandle readpush outh <- liftIO $ fdToHandle writepush @@ -132,7 +131,7 @@ xmppPush cid gitpush = do {- This can take a long time to run, so avoid running it in the - Annex monad. Also, override environment. -} g <- liftAnnex gitRepo - r <- liftIO $ gitpush $ g { gitEnv = Just myenv } + r <- liftIO $ gitpush $ g { gitEnv = Just myenviron } liftIO $ do mapM_ killThread [t1, t2] diff --git a/Command/Status.hs b/Command/Status.hs index cd6c25983..9d184c33b 100644 --- a/Command/Status.hs +++ b/Command/Status.hs @@ -28,9 +28,9 @@ start :: [FilePath] -> CommandStart start [] = do -- Like git status, when run without a directory, behave as if -- given the path to the top of the repository. - cwd <- liftIO getCurrentDirectory + currdir <- liftIO getCurrentDirectory top <- fromRepo Git.repoPath - start' [relPathDirToFile cwd top] + start' [relPathDirToFile currdir top] start locs = start' locs start' :: [FilePath] -> CommandStart diff --git a/Command/Uninit.hs b/Command/Uninit.hs index 0f0628156..76022df26 100644 --- a/Command/Uninit.hs +++ b/Command/Uninit.hs @@ -27,8 +27,8 @@ check = do when (b == Annex.Branch.name) $ error $ "cannot uninit when the " ++ Git.fromRef b ++ " branch is checked out" top <- fromRepo Git.repoPath - cwd <- liftIO getCurrentDirectory - whenM ((/=) <$> liftIO (absPath top) <*> liftIO (absPath cwd)) $ + currdir <- liftIO getCurrentDirectory + whenM ((/=) <$> liftIO (absPath top) <*> liftIO (absPath currdir)) $ error "can only run uninit from the top of the git repository" where current_branch = Git.Ref . Prelude.head . lines <$> revhead diff --git a/Command/WebApp.hs b/Command/WebApp.hs index e8d657052..e329582e3 100644 --- a/Command/WebApp.hs +++ b/Command/WebApp.hs @@ -34,7 +34,6 @@ import Annex.Version import Control.Concurrent import Control.Concurrent.STM -import System.Process (env, std_out, std_err, cwd) import Network.Socket (HostName) import System.Environment (getArgs) diff --git a/Git/CheckAttr.hs b/Git/CheckAttr.hs index 94ead5b4c..6b5e3bf62 100644 --- a/Git/CheckAttr.hs +++ b/Git/CheckAttr.hs @@ -23,9 +23,9 @@ type Attr = String - values and returns a handle. -} checkAttrStart :: [Attr] -> Repo -> IO CheckAttrHandle checkAttrStart attrs repo = do - cwd <- getCurrentDirectory + currdir <- getCurrentDirectory h <- CoProcess.rawMode =<< gitCoProcessStart True params repo - return (h, attrs, cwd) + return (h, attrs, currdir) where params = [ Param "check-attr" @@ -38,7 +38,7 @@ checkAttrStop (h, _, _) = CoProcess.stop h {- Gets an attribute of a file. -} checkAttr :: CheckAttrHandle -> Attr -> FilePath -> IO String -checkAttr (h, attrs, cwd) want file = do +checkAttr (h, attrs, currdir) want file = do pairs <- CoProcess.query h send (receive "") let vals = map snd $ filter (\(attr, _) -> attr == want) pairs case vals of @@ -83,8 +83,8 @@ checkAttr (h, attrs, cwd) want file = do - so use relative filenames. -} oldgit = Git.BuildVersion.older "1.7.7" file' - | oldgit = absPathFrom cwd file - | otherwise = relPathDirToFile cwd $ absPathFrom cwd file + | oldgit = absPathFrom currdir file + | otherwise = relPathDirToFile currdir $ absPathFrom currdir file oldattrvalue attr l = end bits !! 0 where bits = split sep l diff --git a/Git/Command.hs b/Git/Command.hs index a0c7c4b2a..39a3c6849 100644 --- a/Git/Command.hs +++ b/Git/Command.hs @@ -9,8 +9,6 @@ module Git.Command where -import System.Process (std_out, env) - import Common import Git import Git.Types diff --git a/Git/Config.hs b/Git/Config.hs index b5c1be04a..d998fd1e2 100644 --- a/Git/Config.hs +++ b/Git/Config.hs @@ -9,7 +9,6 @@ module Git.Config where import qualified Data.Map as M import Data.Char -import System.Process (cwd, env) import Control.Exception.Extensible import Common diff --git a/Git/CurrentRepo.hs b/Git/CurrentRepo.hs index ee91a6b81..23ebbbcad 100644 --- a/Git/CurrentRepo.hs +++ b/Git/CurrentRepo.hs @@ -37,8 +37,8 @@ get = do case wt of Nothing -> return r Just d -> do - cwd <- getCurrentDirectory - unless (d `dirContains` cwd) $ + curr <- getCurrentDirectory + unless (d `dirContains` curr) $ setCurrentDirectory d return $ addworktree wt r where @@ -57,8 +57,8 @@ get = do configure Nothing (Just r) = Git.Config.read r configure (Just d) _ = do absd <- absPath d - cwd <- getCurrentDirectory - r <- newFrom $ Local { gitdir = absd, worktree = Just cwd } + curr <- getCurrentDirectory + r <- newFrom $ Local { gitdir = absd, worktree = Just curr } Git.Config.read r configure Nothing Nothing = error "Not in a git repository." diff --git a/Git/Fsck.hs b/Git/Fsck.hs index 80f76dd90..c6002f681 100644 --- a/Git/Fsck.hs +++ b/Git/Fsck.hs @@ -23,7 +23,6 @@ import Utility.Batch import qualified Git.Version import qualified Data.Set as S -import System.Process (std_out, std_err) import Control.Concurrent.Async type MissingObjects = S.Set Sha diff --git a/Git/LsFiles.hs b/Git/LsFiles.hs index e1558456f..2aa05ba7f 100644 --- a/Git/LsFiles.hs +++ b/Git/LsFiles.hs @@ -132,8 +132,8 @@ typeChanged' ps l repo = do -- git diff returns filenames relative to the top of the git repo; -- convert to filenames relative to the cwd, like git ls-files. let top = repoPath repo - cwd <- getCurrentDirectory - return (map (\f -> relPathDirToFile cwd $ top </> f) fs, cleanup) + currdir <- getCurrentDirectory + return (map (\f -> relPathDirToFile currdir $ top </> f) fs, cleanup) where prefix = [Params "diff --name-only --diff-filter=T -z"] suffix = Param "--" : (if null l then [File "."] else map File l) diff --git a/Git/Queue.hs b/Git/Queue.hs index 5f7b142c0..606a04157 100644 --- a/Git/Queue.hs +++ b/Git/Queue.hs @@ -24,9 +24,6 @@ import Git.Command import qualified Git.UpdateIndex import qualified Data.Map as M -#ifndef mingw32_HOST_OS -import System.Process -#endif {- Queable actions that can be performed in a git repository. -} diff --git a/Git/UpdateIndex.hs b/Git/UpdateIndex.hs index 4ecd77363..7de2f1be3 100644 --- a/Git/UpdateIndex.hs +++ b/Git/UpdateIndex.hs @@ -30,7 +30,6 @@ import Git.FilePath import Git.Sha import Control.Exception (bracket) -import System.Process (std_in) {- Streamers are passed a callback and should feed it lines in the form - read by update-index, and generated by ls-tree. -} diff --git a/Locations.hs b/Locations.hs index 5bff63eaf..95aba169c 100644 --- a/Locations.hs +++ b/Locations.hs @@ -142,8 +142,8 @@ gitAnnexLocation' key r crippled {- Calculates a symlink to link a file to an annexed object. -} gitAnnexLink :: FilePath -> Key -> Git.Repo -> IO FilePath gitAnnexLink file key r = do - cwd <- getCurrentDirectory - let absfile = fromMaybe whoops $ absNormPathUnix cwd file + currdir <- getCurrentDirectory + let absfile = fromMaybe whoops $ absNormPathUnix currdir file loc <- gitAnnexLocation' key r False return $ relPathDirToFile (parentDir absfile) loc where diff --git a/Remote/External.hs b/Remote/External.hs index 9be9175c7..464e9b57e 100644 --- a/Remote/External.hs +++ b/Remote/External.hs @@ -28,7 +28,6 @@ import Annex.Exception import Creds import Control.Concurrent.STM -import System.Process (std_in, std_out, std_err) import System.Log.Logger (debugM) import qualified Data.Map as M import qualified Data.ByteString.Lazy as L diff --git a/Remote/Git.hs b/Remote/Git.hs index da702730a..5dcd3bf15 100644 --- a/Remote/Git.hs +++ b/Remote/Git.hs @@ -55,7 +55,6 @@ import Creds import Control.Concurrent import Control.Concurrent.MSampleVar -import System.Process (std_in, std_err) import qualified Data.Map as M import Control.Exception.Extensible @@ -467,12 +466,12 @@ fsckOnRemote r params | otherwise = return $ do program <- readProgramFile r' <- Git.Config.read r - env <- getEnvironment - let env' = addEntries + environ <- getEnvironment + let environ' = addEntries [ ("GIT_WORK_TREE", Git.repoPath r') , ("GIT_DIR", Git.localGitDir r') - ] env - batchCommandEnv program (Param "fsck" : params) $ Just env' + ] environ + batchCommandEnv program (Param "fsck" : params) $ Just environ' {- The passed repair action is run in the Annex monad of the remote. -} repairRemote :: Git.Repo -> Annex Bool -> Annex (IO Bool) diff --git a/Remote/Glacier.hs b/Remote/Glacier.hs index eb274714b..00be9e1a9 100644 --- a/Remote/Glacier.hs +++ b/Remote/Glacier.hs @@ -27,8 +27,6 @@ import Annex.Content import Annex.UUID import Utility.Env -import System.Process - type Vault = String type Archive = FilePath diff --git a/Remote/Hook.hs b/Remote/Hook.hs index 3735c228c..74641f5aa 100644 --- a/Remote/Hook.hs +++ b/Remote/Hook.hs @@ -79,15 +79,15 @@ hookEnv :: Action -> Key -> Maybe FilePath -> IO (Maybe [(String, String)]) hookEnv action k f = Just <$> mergeenv (fileenv f ++ keyenv) where mergeenv l = addEntries l <$> getEnvironment - env s v = ("ANNEX_" ++ s, v) + envvar s v = ("ANNEX_" ++ s, v) keyenv = catMaybes - [ Just $ env "KEY" (key2file k) - , Just $ env "ACTION" action - , env "HASH_1" <$> headMaybe hashbits - , env "HASH_2" <$> headMaybe (drop 1 hashbits) + [ Just $ envvar "KEY" (key2file k) + , Just $ envvar "ACTION" action + , envvar "HASH_1" <$> headMaybe hashbits + , envvar "HASH_2" <$> headMaybe (drop 1 hashbits) ] fileenv Nothing = [] - fileenv (Just file) = [env "FILE" file] + fileenv (Just file) = [envvar "FILE" file] hashbits = map takeDirectory $ splitPath $ hashDirMixed k lookupHook :: HookName -> Action -> Annex (Maybe String) @@ -155,5 +155,5 @@ checkPresent r h k = do findkey s = key2file k `elem` lines s check Nothing = error $ action ++ " hook misconfigured" check (Just hook) = do - env <- hookEnv action k Nothing - findkey <$> readProcessEnv "sh" ["-c", hook] env + environ <- hookEnv action k Nothing + findkey <$> readProcessEnv "sh" ["-c", hook] environ diff --git a/RemoteDaemon/Transport/Ssh.hs b/RemoteDaemon/Transport/Ssh.hs index ba03a2589..65c313852 100644 --- a/RemoteDaemon/Transport/Ssh.hs +++ b/RemoteDaemon/Transport/Ssh.hs @@ -20,7 +20,6 @@ import Utility.ThreadScheduler import Control.Concurrent.Chan import Control.Concurrent.Async -import System.Process (std_in, std_out, std_err) transport :: Transport transport r url h@(TransportHandle g s) ichan ochan = do @@ -176,15 +176,15 @@ properties = localOption (QuickCheckTests 1000) $ testGroup "QuickCheck" {- These tests set up the test environment, but also test some basic parts - of git-annex. They are always run before the unitTests. -} initTests :: TestEnv -> TestTree -initTests env = testGroup "Init Tests" +initTests testenv = testGroup "Init Tests" [ check "init" test_init , check "add" test_add ] where - check desc t = testCase desc (t env) + check desc t = testCase desc (t testenv) unitTests :: String -> IO TestEnv -> TestTree -unitTests note getenv = testGroup ("Unit Tests " ++ note) +unitTests note gettestenv = testGroup ("Unit Tests " ++ note) [ check "add sha1dup" test_add_sha1dup , check "add extras" test_add_extras , check "reinject" test_reinject @@ -236,25 +236,25 @@ unitTests note getenv = testGroup ("Unit Tests " ++ note) , check "add subdirs" test_add_subdirs ] where - check desc t = testCase desc (getenv >>= t) + check desc t = testCase desc (gettestenv >>= t) -- this test case create the main repo test_init :: TestEnv -> Assertion -test_init env = innewrepo env $ do - git_annex env "init" [reponame] @? "init failed" - handleforcedirect env +test_init testenv = innewrepo testenv $ do + git_annex testenv "init" [reponame] @? "init failed" + handleforcedirect testenv where reponame = "test repo" -- this test case runs in the main repo, to set up a basic -- annexed file that later tests will use test_add :: TestEnv -> Assertion -test_add env = inmainrepo env $ do +test_add testenv = inmainrepo testenv $ do writeFile annexedfile $ content annexedfile - git_annex env "add" [annexedfile] @? "add failed" + git_annex testenv "add" [annexedfile] @? "add failed" annexed_present annexedfile writeFile sha1annexedfile $ content sha1annexedfile - git_annex env "add" [sha1annexedfile, "--backend=SHA1"] @? "add with SHA1 failed" + git_annex testenv "add" [sha1annexedfile, "--backend=SHA1"] @? "add with SHA1 failed" annexed_present sha1annexedfile checkbackend sha1annexedfile backendSHA1 ifM (annexeval Config.isDirect) @@ -262,223 +262,223 @@ test_add env = inmainrepo env $ do writeFile ingitfile $ content ingitfile not <$> boolSystem "git" [Param "add", File ingitfile] @? "git add failed to fail in direct mode" nukeFile ingitfile - git_annex env "sync" [] @? "sync failed" + git_annex testenv "sync" [] @? "sync failed" , do writeFile ingitfile $ content ingitfile boolSystem "git" [Param "add", File ingitfile] @? "git add failed" boolSystem "git" [Params "commit -q -m commit"] @? "git commit failed" - git_annex env "add" [ingitfile] @? "add ingitfile should be no-op" + git_annex testenv "add" [ingitfile] @? "add ingitfile should be no-op" unannexed ingitfile ) test_add_sha1dup :: TestEnv -> Assertion -test_add_sha1dup env = intmpclonerepo env $ do +test_add_sha1dup testenv = intmpclonerepo testenv $ do writeFile sha1annexedfiledup $ content sha1annexedfiledup - git_annex env "add" [sha1annexedfiledup, "--backend=SHA1"] @? "add of second file with same SHA1 failed" + git_annex testenv "add" [sha1annexedfiledup, "--backend=SHA1"] @? "add of second file with same SHA1 failed" annexed_present sha1annexedfiledup annexed_present sha1annexedfile test_add_extras :: TestEnv -> Assertion -test_add_extras env = intmpclonerepo env $ do +test_add_extras testenv = intmpclonerepo testenv $ do writeFile wormannexedfile $ content wormannexedfile - git_annex env "add" [wormannexedfile, "--backend=WORM"] @? "add with WORM failed" + git_annex testenv "add" [wormannexedfile, "--backend=WORM"] @? "add with WORM failed" annexed_present wormannexedfile checkbackend wormannexedfile backendWORM test_reinject :: TestEnv -> Assertion -test_reinject env = intmpclonerepoInDirect env $ do - git_annex env "drop" ["--force", sha1annexedfile] @? "drop failed" +test_reinject testenv = intmpclonerepoInDirect testenv $ do + git_annex testenv "drop" ["--force", sha1annexedfile] @? "drop failed" writeFile tmp $ content sha1annexedfile r <- annexeval $ Types.Backend.getKey backendSHA1 Types.KeySource.KeySource { Types.KeySource.keyFilename = tmp, Types.KeySource.contentLocation = tmp, Types.KeySource.inodeCache = Nothing } let key = Types.Key.key2file $ fromJust r - git_annex env "reinject" [tmp, sha1annexedfile] @? "reinject failed" - git_annex env "fromkey" [key, sha1annexedfiledup] @? "fromkey failed for dup" + git_annex testenv "reinject" [tmp, sha1annexedfile] @? "reinject failed" + git_annex testenv "fromkey" [key, sha1annexedfiledup] @? "fromkey failed for dup" annexed_present sha1annexedfiledup where tmp = "tmpfile" test_unannex_nocopy :: TestEnv -> Assertion -test_unannex_nocopy env = intmpclonerepo env $ do +test_unannex_nocopy testenv = intmpclonerepo testenv $ do annexed_notpresent annexedfile - git_annex env "unannex" [annexedfile] @? "unannex failed with no copy" + git_annex testenv "unannex" [annexedfile] @? "unannex failed with no copy" annexed_notpresent annexedfile test_unannex_withcopy :: TestEnv -> Assertion -test_unannex_withcopy env = intmpclonerepo env $ do - git_annex env "get" [annexedfile] @? "get failed" +test_unannex_withcopy testenv = intmpclonerepo testenv $ do + git_annex testenv "get" [annexedfile] @? "get failed" annexed_present annexedfile - git_annex env "unannex" [annexedfile, sha1annexedfile] @? "unannex failed" + git_annex testenv "unannex" [annexedfile, sha1annexedfile] @? "unannex failed" unannexed annexedfile - git_annex env "unannex" [annexedfile] @? "unannex failed on non-annexed file" + git_annex testenv "unannex" [annexedfile] @? "unannex failed on non-annexed file" unannexed annexedfile unlessM (annexeval Config.isDirect) $ do - git_annex env "unannex" [ingitfile] @? "unannex ingitfile should be no-op" + git_annex testenv "unannex" [ingitfile] @? "unannex ingitfile should be no-op" unannexed ingitfile test_drop_noremote :: TestEnv -> Assertion -test_drop_noremote env = intmpclonerepo env $ do - git_annex env "get" [annexedfile] @? "get failed" +test_drop_noremote testenv = intmpclonerepo testenv $ do + git_annex testenv "get" [annexedfile] @? "get failed" boolSystem "git" [Params "remote rm origin"] @? "git remote rm origin failed" - not <$> git_annex env "drop" [annexedfile] @? "drop wrongly succeeded with no known copy of file" + not <$> git_annex testenv "drop" [annexedfile] @? "drop wrongly succeeded with no known copy of file" annexed_present annexedfile - git_annex env "drop" ["--force", annexedfile] @? "drop --force failed" + git_annex testenv "drop" ["--force", annexedfile] @? "drop --force failed" annexed_notpresent annexedfile - git_annex env "drop" [annexedfile] @? "drop of dropped file failed" + git_annex testenv "drop" [annexedfile] @? "drop of dropped file failed" unlessM (annexeval Config.isDirect) $ do - git_annex env "drop" [ingitfile] @? "drop ingitfile should be no-op" + git_annex testenv "drop" [ingitfile] @? "drop ingitfile should be no-op" unannexed ingitfile test_drop_withremote :: TestEnv -> Assertion -test_drop_withremote env = intmpclonerepo env $ do - git_annex env "get" [annexedfile] @? "get failed" +test_drop_withremote testenv = intmpclonerepo testenv $ do + git_annex testenv "get" [annexedfile] @? "get failed" annexed_present annexedfile - git_annex env "numcopies" ["2"] @? "numcopies config failed" - not <$> git_annex env "drop" [annexedfile] @? "drop succeeded although numcopies is not satisfied" - git_annex env "numcopies" ["1"] @? "numcopies config failed" - git_annex env "drop" [annexedfile] @? "drop failed though origin has copy" + git_annex testenv "numcopies" ["2"] @? "numcopies config failed" + not <$> git_annex testenv "drop" [annexedfile] @? "drop succeeded although numcopies is not satisfied" + git_annex testenv "numcopies" ["1"] @? "numcopies config failed" + git_annex testenv "drop" [annexedfile] @? "drop failed though origin has copy" annexed_notpresent annexedfile - inmainrepo env $ annexed_present annexedfile + inmainrepo testenv $ annexed_present annexedfile test_drop_untrustedremote :: TestEnv -> Assertion -test_drop_untrustedremote env = intmpclonerepo env $ do - git_annex env "untrust" ["origin"] @? "untrust of origin failed" - git_annex env "get" [annexedfile] @? "get failed" +test_drop_untrustedremote testenv = intmpclonerepo testenv $ do + git_annex testenv "untrust" ["origin"] @? "untrust of origin failed" + git_annex testenv "get" [annexedfile] @? "get failed" annexed_present annexedfile - not <$> git_annex env "drop" [annexedfile] @? "drop wrongly suceeded with only an untrusted copy of the file" + not <$> git_annex testenv "drop" [annexedfile] @? "drop wrongly suceeded with only an untrusted copy of the file" annexed_present annexedfile - inmainrepo env $ annexed_present annexedfile + inmainrepo testenv $ annexed_present annexedfile test_get :: TestEnv -> Assertion -test_get env = intmpclonerepo env $ do - inmainrepo env $ annexed_present annexedfile +test_get testenv = intmpclonerepo testenv $ do + inmainrepo testenv $ annexed_present annexedfile annexed_notpresent annexedfile - git_annex env "get" [annexedfile] @? "get of file failed" - inmainrepo env $ annexed_present annexedfile + git_annex testenv "get" [annexedfile] @? "get of file failed" + inmainrepo testenv $ annexed_present annexedfile annexed_present annexedfile - git_annex env "get" [annexedfile] @? "get of file already here failed" - inmainrepo env $ annexed_present annexedfile + git_annex testenv "get" [annexedfile] @? "get of file already here failed" + inmainrepo testenv $ annexed_present annexedfile annexed_present annexedfile unlessM (annexeval Config.isDirect) $ do - inmainrepo env $ unannexed ingitfile + inmainrepo testenv $ unannexed ingitfile unannexed ingitfile - git_annex env "get" [ingitfile] @? "get ingitfile should be no-op" - inmainrepo env $ unannexed ingitfile + git_annex testenv "get" [ingitfile] @? "get ingitfile should be no-op" + inmainrepo testenv $ unannexed ingitfile unannexed ingitfile test_move :: TestEnv -> Assertion -test_move env = intmpclonerepo env $ do +test_move testenv = intmpclonerepo testenv $ do annexed_notpresent annexedfile - inmainrepo env $ annexed_present annexedfile - git_annex env "move" ["--from", "origin", annexedfile] @? "move --from of file failed" + inmainrepo testenv $ annexed_present annexedfile + git_annex testenv "move" ["--from", "origin", annexedfile] @? "move --from of file failed" annexed_present annexedfile - inmainrepo env $ annexed_notpresent annexedfile - git_annex env "move" ["--from", "origin", annexedfile] @? "move --from of file already here failed" + inmainrepo testenv $ annexed_notpresent annexedfile + git_annex testenv "move" ["--from", "origin", annexedfile] @? "move --from of file already here failed" annexed_present annexedfile - inmainrepo env $ annexed_notpresent annexedfile - git_annex env "move" ["--to", "origin", annexedfile] @? "move --to of file failed" - inmainrepo env $ annexed_present annexedfile + inmainrepo testenv $ annexed_notpresent annexedfile + git_annex testenv "move" ["--to", "origin", annexedfile] @? "move --to of file failed" + inmainrepo testenv $ annexed_present annexedfile annexed_notpresent annexedfile - git_annex env "move" ["--to", "origin", annexedfile] @? "move --to of file already there failed" - inmainrepo env $ annexed_present annexedfile + git_annex testenv "move" ["--to", "origin", annexedfile] @? "move --to of file already there failed" + inmainrepo testenv $ annexed_present annexedfile annexed_notpresent annexedfile unlessM (annexeval Config.isDirect) $ do unannexed ingitfile - inmainrepo env $ unannexed ingitfile - git_annex env "move" ["--to", "origin", ingitfile] @? "move of ingitfile should be no-op" + inmainrepo testenv $ unannexed ingitfile + git_annex testenv "move" ["--to", "origin", ingitfile] @? "move of ingitfile should be no-op" unannexed ingitfile - inmainrepo env $ unannexed ingitfile - git_annex env "move" ["--from", "origin", ingitfile] @? "move of ingitfile should be no-op" + inmainrepo testenv $ unannexed ingitfile + git_annex testenv "move" ["--from", "origin", ingitfile] @? "move of ingitfile should be no-op" unannexed ingitfile - inmainrepo env $ unannexed ingitfile + inmainrepo testenv $ unannexed ingitfile test_copy :: TestEnv -> Assertion -test_copy env = intmpclonerepo env $ do +test_copy testenv = intmpclonerepo testenv $ do annexed_notpresent annexedfile - inmainrepo env $ annexed_present annexedfile - git_annex env "copy" ["--from", "origin", annexedfile] @? "copy --from of file failed" + inmainrepo testenv $ annexed_present annexedfile + git_annex testenv "copy" ["--from", "origin", annexedfile] @? "copy --from of file failed" annexed_present annexedfile - inmainrepo env $ annexed_present annexedfile - git_annex env "copy" ["--from", "origin", annexedfile] @? "copy --from of file already here failed" + inmainrepo testenv $ annexed_present annexedfile + git_annex testenv "copy" ["--from", "origin", annexedfile] @? "copy --from of file already here failed" annexed_present annexedfile - inmainrepo env $ annexed_present annexedfile - git_annex env "copy" ["--to", "origin", annexedfile] @? "copy --to of file already there failed" + inmainrepo testenv $ annexed_present annexedfile + git_annex testenv "copy" ["--to", "origin", annexedfile] @? "copy --to of file already there failed" annexed_present annexedfile - inmainrepo env $ annexed_present annexedfile - git_annex env "move" ["--to", "origin", annexedfile] @? "move --to of file already there failed" + inmainrepo testenv $ annexed_present annexedfile + git_annex testenv "move" ["--to", "origin", annexedfile] @? "move --to of file already there failed" annexed_notpresent annexedfile - inmainrepo env $ annexed_present annexedfile + inmainrepo testenv $ annexed_present annexedfile unlessM (annexeval Config.isDirect) $ do unannexed ingitfile - inmainrepo env $ unannexed ingitfile - git_annex env "copy" ["--to", "origin", ingitfile] @? "copy of ingitfile should be no-op" + inmainrepo testenv $ unannexed ingitfile + git_annex testenv "copy" ["--to", "origin", ingitfile] @? "copy of ingitfile should be no-op" unannexed ingitfile - inmainrepo env $ unannexed ingitfile - git_annex env "copy" ["--from", "origin", ingitfile] @? "copy of ingitfile should be no-op" + inmainrepo testenv $ unannexed ingitfile + git_annex testenv "copy" ["--from", "origin", ingitfile] @? "copy of ingitfile should be no-op" checkregularfile ingitfile checkcontent ingitfile test_preferred_content :: TestEnv -> Assertion -test_preferred_content env = intmpclonerepo env $ do +test_preferred_content testenv = intmpclonerepo testenv $ do annexed_notpresent annexedfile -- get --auto only looks at numcopies when preferred content is not -- set, and with 1 copy existing, does not get the file. - git_annex env "get" ["--auto", annexedfile] @? "get --auto of file failed with default preferred content" + git_annex testenv "get" ["--auto", annexedfile] @? "get --auto of file failed with default preferred content" annexed_notpresent annexedfile - git_annex env "wanted" [".", "standard"] @? "set expression to standard failed" - git_annex env "group" [".", "client"] @? "set group to standard failed" - git_annex env "get" ["--auto", annexedfile] @? "get --auto of file failed for client" + git_annex testenv "wanted" [".", "standard"] @? "set expression to standard failed" + git_annex testenv "group" [".", "client"] @? "set group to standard failed" + git_annex testenv "get" ["--auto", annexedfile] @? "get --auto of file failed for client" annexed_present annexedfile - git_annex env "ungroup" [".", "client"] @? "ungroup failed" + git_annex testenv "ungroup" [".", "client"] @? "ungroup failed" - git_annex env "wanted" [".", "standard"] @? "set expression to standard failed" - git_annex env "group" [".", "manual"] @? "set group to manual failed" + git_annex testenv "wanted" [".", "standard"] @? "set expression to standard failed" + git_annex testenv "group" [".", "manual"] @? "set group to manual failed" -- drop --auto with manual leaves the file where it is - git_annex env "drop" ["--auto", annexedfile] @? "drop --auto of file failed with manual preferred content" + git_annex testenv "drop" ["--auto", annexedfile] @? "drop --auto of file failed with manual preferred content" annexed_present annexedfile - git_annex env "drop" [annexedfile] @? "drop of file failed" + git_annex testenv "drop" [annexedfile] @? "drop of file failed" annexed_notpresent annexedfile -- get --auto with manual does not get the file - git_annex env "get" ["--auto", annexedfile] @? "get --auto of file failed with manual preferred content" + git_annex testenv "get" ["--auto", annexedfile] @? "get --auto of file failed with manual preferred content" annexed_notpresent annexedfile - git_annex env "ungroup" [".", "client"] @? "ungroup failed" + git_annex testenv "ungroup" [".", "client"] @? "ungroup failed" - git_annex env "wanted" [".", "exclude=*"] @? "set expression to exclude=* failed" - git_annex env "get" [annexedfile] @? "get of file failed" + git_annex testenv "wanted" [".", "exclude=*"] @? "set expression to exclude=* failed" + git_annex testenv "get" [annexedfile] @? "get of file failed" annexed_present annexedfile - git_annex env "drop" ["--auto", annexedfile] @? "drop --auto of file failed with exclude=*" + git_annex testenv "drop" ["--auto", annexedfile] @? "drop --auto of file failed with exclude=*" annexed_notpresent annexedfile - git_annex env "get" ["--auto", annexedfile] @? "get --auto of file failed with exclude=*" + git_annex testenv "get" ["--auto", annexedfile] @? "get --auto of file failed with exclude=*" annexed_notpresent annexedfile test_lock :: TestEnv -> Assertion -test_lock env = intmpclonerepoInDirect env $ do +test_lock testenv = intmpclonerepoInDirect testenv $ do -- regression test: unlock of not present file should skip it annexed_notpresent annexedfile - not <$> git_annex env "unlock" [annexedfile] @? "unlock failed to fail with not present file" + not <$> git_annex testenv "unlock" [annexedfile] @? "unlock failed to fail with not present file" annexed_notpresent annexedfile - git_annex env "get" [annexedfile] @? "get of file failed" + git_annex testenv "get" [annexedfile] @? "get of file failed" annexed_present annexedfile - git_annex env "unlock" [annexedfile] @? "unlock failed" + git_annex testenv "unlock" [annexedfile] @? "unlock failed" unannexed annexedfile -- write different content, to verify that lock -- throws it away changecontent annexedfile writeFile annexedfile $ content annexedfile ++ "foo" - not <$> git_annex env "lock" [annexedfile] @? "lock failed to fail without --force" - git_annex env "lock" ["--force", annexedfile] @? "lock --force failed" + not <$> git_annex testenv "lock" [annexedfile] @? "lock failed to fail without --force" + git_annex testenv "lock" ["--force", annexedfile] @? "lock --force failed" annexed_present annexedfile - git_annex env "unlock" [annexedfile] @? "unlock failed" + git_annex testenv "unlock" [annexedfile] @? "unlock failed" unannexed annexedfile changecontent annexedfile - git_annex env "add" [annexedfile] @? "add of modified file failed" + git_annex testenv "add" [annexedfile] @? "add of modified file failed" runchecks [checklink, checkunwritable] annexedfile c <- readFile annexedfile assertEqual "content of modified file" c (changedcontent annexedfile) - r' <- git_annex env "drop" [annexedfile] + r' <- git_annex testenv "drop" [annexedfile] not r' @? "drop wrongly succeeded with no known copy of modified file" test_edit :: TestEnv -> Assertion @@ -488,37 +488,37 @@ test_edit_precommit :: TestEnv -> Assertion test_edit_precommit = test_edit' True test_edit' :: Bool -> TestEnv -> Assertion -test_edit' precommit env = intmpclonerepoInDirect env $ do - git_annex env "get" [annexedfile] @? "get of file failed" +test_edit' precommit testenv = intmpclonerepoInDirect testenv $ do + git_annex testenv "get" [annexedfile] @? "get of file failed" annexed_present annexedfile - git_annex env "edit" [annexedfile] @? "edit failed" + git_annex testenv "edit" [annexedfile] @? "edit failed" unannexed annexedfile changecontent annexedfile boolSystem "git" [Param "add", File annexedfile] @? "git add of edited file failed" if precommit - then git_annex env "pre-commit" [] + then git_annex testenv "pre-commit" [] @? "pre-commit failed" else boolSystem "git" [Params "commit -q -m contentchanged"] @? "git commit of edited file failed" runchecks [checklink, checkunwritable] annexedfile c <- readFile annexedfile assertEqual "content of modified file" c (changedcontent annexedfile) - not <$> git_annex env "drop" [annexedfile] @? "drop wrongly succeeded with no known copy of modified file" + not <$> git_annex testenv "drop" [annexedfile] @? "drop wrongly succeeded with no known copy of modified file" test_fix :: TestEnv -> Assertion -test_fix env = intmpclonerepoInDirect env $ do +test_fix testenv = intmpclonerepoInDirect testenv $ do annexed_notpresent annexedfile - git_annex env "fix" [annexedfile] @? "fix of not present failed" + git_annex testenv "fix" [annexedfile] @? "fix of not present failed" annexed_notpresent annexedfile - git_annex env "get" [annexedfile] @? "get of file failed" + git_annex testenv "get" [annexedfile] @? "get of file failed" annexed_present annexedfile - git_annex env "fix" [annexedfile] @? "fix of present file failed" + git_annex testenv "fix" [annexedfile] @? "fix of present file failed" annexed_present annexedfile createDirectory subdir boolSystem "git" [Param "mv", File annexedfile, File subdir] @? "git mv failed" - git_annex env "fix" [newfile] @? "fix of moved file failed" + git_annex testenv "fix" [newfile] @? "fix of moved file failed" runchecks [checklink, checkunwritable] newfile c <- readFile newfile assertEqual "content of moved file" c (content annexedfile) @@ -527,22 +527,22 @@ test_fix env = intmpclonerepoInDirect env $ do newfile = subdir ++ "/" ++ annexedfile test_trust :: TestEnv -> Assertion -test_trust env = intmpclonerepo env $ do - git_annex env "trust" [repo] @? "trust failed" +test_trust testenv = intmpclonerepo testenv $ do + git_annex testenv "trust" [repo] @? "trust failed" trustcheck Logs.Trust.Trusted "trusted 1" - git_annex env "trust" [repo] @? "trust of trusted failed" + git_annex testenv "trust" [repo] @? "trust of trusted failed" trustcheck Logs.Trust.Trusted "trusted 2" - git_annex env "untrust" [repo] @? "untrust failed" + git_annex testenv "untrust" [repo] @? "untrust failed" trustcheck Logs.Trust.UnTrusted "untrusted 1" - git_annex env "untrust" [repo] @? "untrust of untrusted failed" + git_annex testenv "untrust" [repo] @? "untrust of untrusted failed" trustcheck Logs.Trust.UnTrusted "untrusted 2" - git_annex env "dead" [repo] @? "dead failed" + git_annex testenv "dead" [repo] @? "dead failed" trustcheck Logs.Trust.DeadTrusted "deadtrusted 1" - git_annex env "dead" [repo] @? "dead of dead failed" + git_annex testenv "dead" [repo] @? "dead of dead failed" trustcheck Logs.Trust.DeadTrusted "deadtrusted 2" - git_annex env "semitrust" [repo] @? "semitrust failed" + git_annex testenv "semitrust" [repo] @? "semitrust failed" trustcheck Logs.Trust.SemiTrusted "semitrusted 1" - git_annex env "semitrust" [repo] @? "semitrust of semitrusted failed" + git_annex testenv "semitrust" [repo] @? "semitrust of semitrusted failed" trustcheck Logs.Trust.SemiTrusted "semitrusted 2" where repo = "origin" @@ -554,48 +554,48 @@ test_trust env = intmpclonerepo env $ do assertBool msg present test_fsck_basic :: TestEnv -> Assertion -test_fsck_basic env = intmpclonerepo env $ do - git_annex env "fsck" [] @? "fsck failed" - git_annex env "numcopies" ["2"] @? "numcopies config failed" - fsck_should_fail env "numcopies unsatisfied" - git_annex env "numcopies" ["1"] @? "numcopies config failed" +test_fsck_basic testenv = intmpclonerepo testenv $ do + git_annex testenv "fsck" [] @? "fsck failed" + git_annex testenv "numcopies" ["2"] @? "numcopies config failed" + fsck_should_fail testenv "numcopies unsatisfied" + git_annex testenv "numcopies" ["1"] @? "numcopies config failed" corrupt annexedfile corrupt sha1annexedfile where corrupt f = do - git_annex env "get" [f] @? "get of file failed" + git_annex testenv "get" [f] @? "get of file failed" Utility.FileMode.allowWrite f writeFile f (changedcontent f) ifM (annexeval Config.isDirect) - ( git_annex env "fsck" [] @? "fsck failed in direct mode with changed file content" - , not <$> git_annex env "fsck" [] @? "fsck failed to fail with corrupted file content" + ( git_annex testenv "fsck" [] @? "fsck failed in direct mode with changed file content" + , not <$> git_annex testenv "fsck" [] @? "fsck failed to fail with corrupted file content" ) - git_annex env "fsck" [] @? "fsck unexpectedly failed again; previous one did not fix problem with " ++ f + git_annex testenv "fsck" [] @? "fsck unexpectedly failed again; previous one did not fix problem with " ++ f test_fsck_bare :: TestEnv -> Assertion -test_fsck_bare env = intmpbareclonerepo env $ - git_annex env "fsck" [] @? "fsck failed" +test_fsck_bare testenv = intmpbareclonerepo testenv $ + git_annex testenv "fsck" [] @? "fsck failed" test_fsck_localuntrusted :: TestEnv -> Assertion -test_fsck_localuntrusted env = intmpclonerepo env $ do - git_annex env "get" [annexedfile] @? "get failed" - git_annex env "untrust" ["origin"] @? "untrust of origin repo failed" - git_annex env "untrust" ["."] @? "untrust of current repo failed" - fsck_should_fail env "content only available in untrusted (current) repository" - git_annex env "trust" ["."] @? "trust of current repo failed" - git_annex env "fsck" [annexedfile] @? "fsck failed on file present in trusted repo" +test_fsck_localuntrusted testenv = intmpclonerepo testenv $ do + git_annex testenv "get" [annexedfile] @? "get failed" + git_annex testenv "untrust" ["origin"] @? "untrust of origin repo failed" + git_annex testenv "untrust" ["."] @? "untrust of current repo failed" + fsck_should_fail testenv "content only available in untrusted (current) repository" + git_annex testenv "trust" ["."] @? "trust of current repo failed" + git_annex testenv "fsck" [annexedfile] @? "fsck failed on file present in trusted repo" test_fsck_remoteuntrusted :: TestEnv -> Assertion -test_fsck_remoteuntrusted env = intmpclonerepo env $ do - git_annex env "numcopies" ["2"] @? "numcopies config failed" - git_annex env "get" [annexedfile] @? "get failed" - git_annex env "get" [sha1annexedfile] @? "get failed" - git_annex env "fsck" [] @? "fsck failed with numcopies=2 and 2 copies" - git_annex env "untrust" ["origin"] @? "untrust of origin failed" - fsck_should_fail env "content not replicated to enough non-untrusted repositories" +test_fsck_remoteuntrusted testenv = intmpclonerepo testenv $ do + git_annex testenv "numcopies" ["2"] @? "numcopies config failed" + git_annex testenv "get" [annexedfile] @? "get failed" + git_annex testenv "get" [sha1annexedfile] @? "get failed" + git_annex testenv "fsck" [] @? "fsck failed with numcopies=2 and 2 copies" + git_annex testenv "untrust" ["origin"] @? "untrust of origin failed" + fsck_should_fail testenv "content not replicated to enough non-untrusted repositories" fsck_should_fail :: TestEnv -> String -> Assertion -fsck_should_fail env m = not <$> git_annex env "fsck" [] +fsck_should_fail testenv m = not <$> git_annex testenv "fsck" [] @? "fsck failed to fail with " ++ m test_migrate :: TestEnv -> Assertion @@ -605,26 +605,26 @@ test_migrate_via_gitattributes :: TestEnv -> Assertion test_migrate_via_gitattributes = test_migrate' True test_migrate' :: Bool -> TestEnv -> Assertion -test_migrate' usegitattributes env = intmpclonerepoInDirect env $ do +test_migrate' usegitattributes testenv = intmpclonerepoInDirect testenv $ do annexed_notpresent annexedfile annexed_notpresent sha1annexedfile - git_annex env "migrate" [annexedfile] @? "migrate of not present failed" - git_annex env "migrate" [sha1annexedfile] @? "migrate of not present failed" - git_annex env "get" [annexedfile] @? "get of file failed" - git_annex env "get" [sha1annexedfile] @? "get of file failed" + git_annex testenv "migrate" [annexedfile] @? "migrate of not present failed" + git_annex testenv "migrate" [sha1annexedfile] @? "migrate of not present failed" + git_annex testenv "get" [annexedfile] @? "get of file failed" + git_annex testenv "get" [sha1annexedfile] @? "get of file failed" annexed_present annexedfile annexed_present sha1annexedfile if usegitattributes then do writeFile ".gitattributes" "* annex.backend=SHA1" - git_annex env "migrate" [sha1annexedfile] + git_annex testenv "migrate" [sha1annexedfile] @? "migrate sha1annexedfile failed" - git_annex env "migrate" [annexedfile] + git_annex testenv "migrate" [annexedfile] @? "migrate annexedfile failed" else do - git_annex env "migrate" [sha1annexedfile, "--backend", "SHA1"] + git_annex testenv "migrate" [sha1annexedfile, "--backend", "SHA1"] @? "migrate sha1annexedfile failed" - git_annex env "migrate" [annexedfile, "--backend", "SHA1"] + git_annex testenv "migrate" [annexedfile, "--backend", "SHA1"] @? "migrate annexedfile failed" annexed_present annexedfile annexed_present sha1annexedfile @@ -633,9 +633,9 @@ test_migrate' usegitattributes env = intmpclonerepoInDirect env $ do -- check that reversing a migration works writeFile ".gitattributes" "* annex.backend=SHA256" - git_annex env "migrate" [sha1annexedfile] + git_annex testenv "migrate" [sha1annexedfile] @? "migrate sha1annexedfile failed" - git_annex env "migrate" [annexedfile] + git_annex testenv "migrate" [annexedfile] @? "migrate annexedfile failed" annexed_present annexedfile annexed_present sha1annexedfile @@ -644,12 +644,12 @@ test_migrate' usegitattributes env = intmpclonerepoInDirect env $ do test_unused :: TestEnv -> Assertion -- This test is broken in direct mode -test_unused env = intmpclonerepoInDirect env $ do +test_unused testenv = intmpclonerepoInDirect testenv $ do -- keys have to be looked up before files are removed annexedfilekey <- annexeval $ findkey annexedfile sha1annexedfilekey <- annexeval $ findkey sha1annexedfile - git_annex env "get" [annexedfile] @? "get of file failed" - git_annex env "get" [sha1annexedfile] @? "get of file failed" + git_annex testenv "get" [annexedfile] @? "get of file failed" + git_annex testenv "get" [sha1annexedfile] @? "get of file failed" checkunused [] "after get" boolSystem "git" [Params "rm -fq", File annexedfile] @? "git rm failed" checkunused [] "after rm" @@ -663,19 +663,19 @@ test_unused env = intmpclonerepoInDirect env $ do checkunused [annexedfilekey, sha1annexedfilekey] "after rm sha1annexedfile" -- good opportunity to test dropkey also - git_annex env "dropkey" ["--force", Types.Key.key2file annexedfilekey] + git_annex testenv "dropkey" ["--force", Types.Key.key2file annexedfilekey] @? "dropkey failed" checkunused [sha1annexedfilekey] ("after dropkey --force " ++ Types.Key.key2file annexedfilekey) - not <$> git_annex env "dropunused" ["1"] @? "dropunused failed to fail without --force" - git_annex env "dropunused" ["--force", "1"] @? "dropunused failed" + not <$> git_annex testenv "dropunused" ["1"] @? "dropunused failed to fail without --force" + git_annex testenv "dropunused" ["--force", "1"] @? "dropunused failed" checkunused [] "after dropunused" - not <$> git_annex env "dropunused" ["--force", "10", "501"] @? "dropunused failed to fail on bogus numbers" + not <$> git_annex testenv "dropunused" ["--force", "10", "501"] @? "dropunused failed to fail on bogus numbers" -- unused used to miss symlinks that were not staged and pointed -- at annexed content, and think that content was unused writeFile "unusedfile" "unusedcontent" - git_annex env "add" ["unusedfile"] @? "add of unusedfile failed" + git_annex testenv "add" ["unusedfile"] @? "add of unusedfile failed" unusedfilekey <- annexeval $ findkey "unusedfile" renameFile "unusedfile" "unusedunstagedfile" boolSystem "git" [Params "rm -qf", File "unusedfile"] @? "git rm failed" @@ -686,7 +686,7 @@ test_unused env = intmpclonerepoInDirect env $ do -- unused used to miss symlinks that were deleted or modified -- manually, but commited as such. writeFile "unusedfile" "unusedcontent" - git_annex env "add" ["unusedfile"] @? "add of unusedfile failed" + git_annex testenv "add" ["unusedfile"] @? "add of unusedfile failed" boolSystem "git" [Param "add", File "unusedfile"] @? "git add failed" unusedfilekey' <- annexeval $ findkey "unusedfile" checkunused [] "with staged deleted link" @@ -696,7 +696,7 @@ test_unused env = intmpclonerepoInDirect env $ do -- unused used to miss symlinks that were deleted or modified -- manually, but not staged as such. writeFile "unusedfile" "unusedcontent" - git_annex env "add" ["unusedfile"] @? "add of unusedfile failed" + git_annex testenv "add" ["unusedfile"] @? "add of unusedfile failed" boolSystem "git" [Param "add", File "unusedfile"] @? "git add failed" unusedfilekey'' <- annexeval $ findkey "unusedfile" checkunused [] "with unstaged deleted link" @@ -705,7 +705,7 @@ test_unused env = intmpclonerepoInDirect env $ do where checkunused expectedkeys desc = do - git_annex env "unused" [] @? "unused failed" + git_annex testenv "unused" [] @? "unused failed" unusedmap <- annexeval $ Logs.Unused.readUnusedMap "" let unusedkeys = M.elems unusedmap assertEqual ("unused keys differ " ++ desc) @@ -715,109 +715,109 @@ test_unused env = intmpclonerepoInDirect env $ do return $ fromJust r test_describe :: TestEnv -> Assertion -test_describe env = intmpclonerepo env $ do - git_annex env "describe" [".", "this repo"] @? "describe 1 failed" - git_annex env "describe" ["origin", "origin repo"] @? "describe 2 failed" +test_describe testenv = intmpclonerepo testenv $ do + git_annex testenv "describe" [".", "this repo"] @? "describe 1 failed" + git_annex testenv "describe" ["origin", "origin repo"] @? "describe 2 failed" test_find :: TestEnv -> Assertion -test_find env = intmpclonerepo env $ do +test_find testenv = intmpclonerepo testenv $ do annexed_notpresent annexedfile - git_annex_expectoutput env "find" [] [] - git_annex env "get" [annexedfile] @? "get failed" + git_annex_expectoutput testenv "find" [] [] + git_annex testenv "get" [annexedfile] @? "get failed" annexed_present annexedfile annexed_notpresent sha1annexedfile - git_annex_expectoutput env "find" [] [annexedfile] - git_annex_expectoutput env "find" ["--exclude", annexedfile, "--and", "--exclude", sha1annexedfile] [] - git_annex_expectoutput env "find" ["--include", annexedfile] [annexedfile] - git_annex_expectoutput env "find" ["--not", "--in", "origin"] [] - git_annex_expectoutput env "find" ["--copies", "1", "--and", "--not", "--copies", "2"] [sha1annexedfile] - git_annex_expectoutput env "find" ["--inbackend", "SHA1"] [sha1annexedfile] - git_annex_expectoutput env "find" ["--inbackend", "WORM"] [] + git_annex_expectoutput testenv "find" [] [annexedfile] + git_annex_expectoutput testenv "find" ["--exclude", annexedfile, "--and", "--exclude", sha1annexedfile] [] + git_annex_expectoutput testenv "find" ["--include", annexedfile] [annexedfile] + git_annex_expectoutput testenv "find" ["--not", "--in", "origin"] [] + git_annex_expectoutput testenv "find" ["--copies", "1", "--and", "--not", "--copies", "2"] [sha1annexedfile] + git_annex_expectoutput testenv "find" ["--inbackend", "SHA1"] [sha1annexedfile] + git_annex_expectoutput testenv "find" ["--inbackend", "WORM"] [] {- --include=* should match files in subdirectories too, - and --exclude=* should exclude them. -} createDirectory "dir" writeFile "dir/subfile" "subfile" - git_annex env "add" ["dir"] @? "add of subdir failed" - git_annex_expectoutput env "find" ["--include", "*", "--exclude", annexedfile, "--exclude", sha1annexedfile] ["dir/subfile"] - git_annex_expectoutput env "find" ["--exclude", "*"] [] + git_annex testenv "add" ["dir"] @? "add of subdir failed" + git_annex_expectoutput testenv "find" ["--include", "*", "--exclude", annexedfile, "--exclude", sha1annexedfile] ["dir/subfile"] + git_annex_expectoutput testenv "find" ["--exclude", "*"] [] test_merge :: TestEnv -> Assertion -test_merge env = intmpclonerepo env $ - git_annex env "merge" [] @? "merge failed" +test_merge testenv = intmpclonerepo testenv $ + git_annex testenv "merge" [] @? "merge failed" test_info :: TestEnv -> Assertion -test_info env = intmpclonerepo env $ do - json <- git_annex_output env "info" ["--json"] +test_info testenv = intmpclonerepo testenv $ do + json <- git_annex_output testenv "info" ["--json"] case Text.JSON.decodeStrict json :: Text.JSON.Result (Text.JSON.JSObject Text.JSON.JSValue) of Text.JSON.Ok _ -> return () Text.JSON.Error e -> assertFailure e test_version :: TestEnv -> Assertion -test_version env = intmpclonerepo env $ - git_annex env "version" [] @? "version failed" +test_version testenv = intmpclonerepo testenv $ + git_annex testenv "version" [] @? "version failed" test_sync :: TestEnv -> Assertion -test_sync env = intmpclonerepo env $ do - git_annex env "sync" [] @? "sync failed" +test_sync testenv = intmpclonerepo testenv $ do + git_annex testenv "sync" [] @? "sync failed" {- Regression test for bug fixed in - 7b0970b340d7faeb745c666146c7f701ec71808f, where in direct mode - sync committed the symlink standin file to the annex. -} - git_annex_expectoutput env "find" ["--in", "."] [] + git_annex_expectoutput testenv "find" ["--in", "."] [] {- Regression test for union merge bug fixed in - 0214e0fb175a608a49b812d81b4632c081f63027 -} test_union_merge_regression :: TestEnv -> Assertion -test_union_merge_regression env = +test_union_merge_regression testenv = {- We need 3 repos to see this bug. -} - withtmpclonerepo env False $ \r1 -> - withtmpclonerepo env False $ \r2 -> - withtmpclonerepo env False $ \r3 -> do - forM_ [r1, r2, r3] $ \r -> indir env r $ do + withtmpclonerepo testenv False $ \r1 -> + withtmpclonerepo testenv False $ \r2 -> + withtmpclonerepo testenv False $ \r3 -> do + forM_ [r1, r2, r3] $ \r -> indir testenv r $ do when (r /= r1) $ boolSystem "git" [Params "remote add r1", File ("../../" ++ r1)] @? "remote add" when (r /= r2) $ boolSystem "git" [Params "remote add r2", File ("../../" ++ r2)] @? "remote add" when (r /= r3) $ boolSystem "git" [Params "remote add r3", File ("../../" ++ r3)] @? "remote add" - git_annex env "get" [annexedfile] @? "get failed" + git_annex testenv "get" [annexedfile] @? "get failed" boolSystem "git" [Params "remote rm origin"] @? "remote rm" - forM_ [r3, r2, r1] $ \r -> indir env r $ - git_annex env "sync" [] @? "sync failed" - forM_ [r3, r2] $ \r -> indir env r $ - git_annex env "drop" ["--force", annexedfile] @? "drop failed" - indir env r1 $ do - git_annex env "sync" [] @? "sync failed in r1" - git_annex_expectoutput env "find" ["--in", "r3"] [] + forM_ [r3, r2, r1] $ \r -> indir testenv r $ + git_annex testenv "sync" [] @? "sync failed" + forM_ [r3, r2] $ \r -> indir testenv r $ + git_annex testenv "drop" ["--force", annexedfile] @? "drop failed" + indir testenv r1 $ do + git_annex testenv "sync" [] @? "sync failed in r1" + git_annex_expectoutput testenv "find" ["--in", "r3"] [] {- This was the bug. The sync - mangled location log data and it - thought the file was still in r2 -} - git_annex_expectoutput env "find" ["--in", "r2"] [] + git_annex_expectoutput testenv "find" ["--in", "r2"] [] {- Regression test for the automatic conflict resolution bug fixed - in f4ba19f2b8a76a1676da7bb5850baa40d9c388e2. -} test_conflict_resolution_movein_regression :: TestEnv -> Assertion -test_conflict_resolution_movein_regression env = withtmpclonerepo env False $ \r1 -> - withtmpclonerepo env False $ \r2 -> do +test_conflict_resolution_movein_regression testenv = withtmpclonerepo testenv False $ \r1 -> + withtmpclonerepo testenv False $ \r2 -> do let rname r = if r == r1 then "r1" else "r2" - forM_ [r1, r2] $ \r -> indir env r $ do + forM_ [r1, r2] $ \r -> indir testenv r $ do {- Get all files, see check below. -} - git_annex env "get" [] @? "get failed" + git_annex testenv "get" [] @? "get failed" disconnectOrigin - pair env r1 r2 - forM_ [r1, r2] $ \r -> indir env r $ do + pair testenv r1 r2 + forM_ [r1, r2] $ \r -> indir testenv r $ do {- Set up a conflict. -} let newcontent = content annexedfile ++ rname r ifM (annexeval Config.isDirect) ( writeFile annexedfile newcontent , do - git_annex env "unlock" [annexedfile] @? "unlock failed" + git_annex testenv "unlock" [annexedfile] @? "unlock failed" writeFile annexedfile newcontent ) {- Sync twice in r1 so it gets the conflict resolution - update from r2 -} - forM_ [r1, r2, r1] $ \r -> indir env r $ - git_annex env "sync" ["--force"] @? "sync failed in " ++ rname r + forM_ [r1, r2, r1] $ \r -> indir testenv r $ + git_annex testenv "sync" ["--force"] @? "sync failed in " ++ rname r {- After the sync, it should be possible to get all - files. This includes both sides of the conflict, - although the filenames are not easily predictable. @@ -825,28 +825,28 @@ test_conflict_resolution_movein_regression env = withtmpclonerepo env False $ \r - The bug caused, in direct mode, one repo to - be missing the content of the file that had - been put in it. -} - forM_ [r1, r2] $ \r -> indir env r $ do - git_annex env "get" [] @? "unable to get all files after merge conflict resolution in " ++ rname r + forM_ [r1, r2] $ \r -> indir testenv r $ do + git_annex testenv "get" [] @? "unable to get all files after merge conflict resolution in " ++ rname r {- Simple case of conflict resolution; 2 different versions of annexed - file. -} test_conflict_resolution :: TestEnv -> Assertion -test_conflict_resolution env = - withtmpclonerepo env False $ \r1 -> - withtmpclonerepo env False $ \r2 -> do - indir env r1 $ do +test_conflict_resolution testenv = + withtmpclonerepo testenv False $ \r1 -> + withtmpclonerepo testenv False $ \r2 -> do + indir testenv r1 $ do disconnectOrigin writeFile conflictor "conflictor1" - git_annex env "add" [conflictor] @? "add conflicter failed" - git_annex env "sync" [] @? "sync failed in r1" - indir env r2 $ do + git_annex testenv "add" [conflictor] @? "add conflicter failed" + git_annex testenv "sync" [] @? "sync failed in r1" + indir testenv r2 $ do disconnectOrigin writeFile conflictor "conflictor2" - git_annex env "add" [conflictor] @? "add conflicter failed" - git_annex env "sync" [] @? "sync failed in r2" - pair env r1 r2 - forM_ [r1,r2,r1] $ \r -> indir env r $ - git_annex env "sync" [] @? "sync failed" + git_annex testenv "add" [conflictor] @? "add conflicter failed" + git_annex testenv "sync" [] @? "sync failed in r2" + pair testenv r1 r2 + forM_ [r1,r2,r1] $ \r -> indir testenv r $ + git_annex testenv "sync" [] @? "sync failed" checkmerge "r1" r1 checkmerge "r2" r2 where @@ -857,35 +857,35 @@ test_conflict_resolution env = let v = filter (variantprefix `isPrefixOf`) l length v == 2 @? (what ++ " not exactly 2 variant files in: " ++ show l) - indir env d $ do - git_annex env "get" v @? "get failed" - git_annex_expectoutput env "find" v v + indir testenv d $ do + git_annex testenv "get" v @? "get failed" + git_annex_expectoutput testenv "find" v v {- Check merge conflict resolution when one side is an annexed - file, and the other is a directory. -} test_mixed_conflict_resolution :: TestEnv -> Assertion -test_mixed_conflict_resolution env = do +test_mixed_conflict_resolution testenv = do check True check False where - check inr1 = withtmpclonerepo env False $ \r1 -> - withtmpclonerepo env False $ \r2 -> do - indir env r1 $ do + check inr1 = withtmpclonerepo testenv False $ \r1 -> + withtmpclonerepo testenv False $ \r2 -> do + indir testenv r1 $ do disconnectOrigin writeFile conflictor "conflictor" - git_annex env "add" [conflictor] @? "add conflicter failed" - git_annex env "sync" [] @? "sync failed in r1" - indir env r2 $ do + git_annex testenv "add" [conflictor] @? "add conflicter failed" + git_annex testenv "sync" [] @? "sync failed in r1" + indir testenv r2 $ do disconnectOrigin createDirectory conflictor writeFile subfile "subfile" - git_annex env "add" [conflictor] @? "add conflicter failed" - git_annex env "sync" [] @? "sync failed in r2" - pair env r1 r2 + git_annex testenv "add" [conflictor] @? "add conflicter failed" + git_annex testenv "sync" [] @? "sync failed in r2" + pair testenv r1 r2 let l = if inr1 then [r1, r2] else [r2, r1] - forM_ l $ \r -> indir env r $ - git_annex env "sync" [] @? "sync failed in mixed conflict" + forM_ l $ \r -> indir testenv r $ + git_annex testenv "sync" [] @? "sync failed in mixed conflict" checkmerge "r1" r1 checkmerge "r2" r2 conflictor = "conflictor" @@ -899,41 +899,41 @@ test_mixed_conflict_resolution env = do @? (what ++ " conflictor variant file missing in: " ++ show l ) length v == 1 @? (what ++ " too many variant files in: " ++ show v) - indir env d $ do - git_annex env "get" (conflictor:v) @? ("get failed in " ++ what) - git_annex_expectoutput env "find" [conflictor] [Git.FilePath.toInternalGitPath subfile] - git_annex_expectoutput env "find" v v + indir testenv d $ do + git_annex testenv "get" (conflictor:v) @? ("get failed in " ++ what) + git_annex_expectoutput testenv "find" [conflictor] [Git.FilePath.toInternalGitPath subfile] + git_annex_expectoutput testenv "find" v v {- Check merge conflict resolution when both repos start with an annexed - file; one modifies it, and the other deletes it. -} test_remove_conflict_resolution :: TestEnv -> Assertion -test_remove_conflict_resolution env = do +test_remove_conflict_resolution testenv = do check True check False where - check inr1 = withtmpclonerepo env False $ \r1 -> - withtmpclonerepo env False $ \r2 -> do - indir env r1 $ do + check inr1 = withtmpclonerepo testenv False $ \r1 -> + withtmpclonerepo testenv False $ \r2 -> do + indir testenv r1 $ do disconnectOrigin writeFile conflictor "conflictor" - git_annex env "add" [conflictor] @? "add conflicter failed" - git_annex env "sync" [] @? "sync failed in r1" - indir env r2 $ + git_annex testenv "add" [conflictor] @? "add conflicter failed" + git_annex testenv "sync" [] @? "sync failed in r1" + indir testenv r2 $ disconnectOrigin - pair env r1 r2 - indir env r2 $ do - git_annex env "sync" [] @? "sync failed in r2" - git_annex env "get" [conflictor] + pair testenv r1 r2 + indir testenv r2 $ do + git_annex testenv "sync" [] @? "sync failed in r2" + git_annex testenv "get" [conflictor] @? "get conflictor failed" unlessM (annexeval Config.isDirect) $ do - git_annex env "unlock" [conflictor] + git_annex testenv "unlock" [conflictor] @? "unlock conflictor failed" writeFile conflictor "newconflictor" - indir env r1 $ + indir testenv r1 $ nukeFile conflictor let l = if inr1 then [r1, r2, r1] else [r2, r1, r2] - forM_ l $ \r -> indir env r $ - git_annex env "sync" [] @? "sync failed" + forM_ l $ \r -> indir testenv r $ + git_annex testenv "sync" [] @? "sync failed" checkmerge "r1" r1 checkmerge "r2" r2 conflictor = "conflictor" @@ -953,31 +953,31 @@ test_remove_conflict_resolution env = do - indirect mode. -} test_nonannexed_conflict_resolution :: TestEnv -> Assertion -test_nonannexed_conflict_resolution env = do +test_nonannexed_conflict_resolution testenv = do check True False check False False check True True check False True where - check inr1 switchdirect = withtmpclonerepo env False $ \r1 -> - withtmpclonerepo env False $ \r2 -> do + check inr1 switchdirect = withtmpclonerepo testenv False $ \r1 -> + withtmpclonerepo testenv False $ \r2 -> do whenM (isInDirect r1 <&&> isInDirect r2) $ do - indir env r1 $ do + indir testenv r1 $ do disconnectOrigin writeFile conflictor "conflictor" - git_annex env "add" [conflictor] @? "add conflicter failed" - git_annex env "sync" [] @? "sync failed in r1" - indir env r2 $ do + git_annex testenv "add" [conflictor] @? "add conflicter failed" + git_annex testenv "sync" [] @? "sync failed in r1" + indir testenv r2 $ do disconnectOrigin writeFile conflictor nonannexed_content boolSystem "git" [Params "add", File conflictor] @? "git add conflictor failed" - git_annex env "sync" [] @? "sync failed in r2" - pair env r1 r2 + git_annex testenv "sync" [] @? "sync failed in r2" + pair testenv r1 r2 let l = if inr1 then [r1, r2] else [r2, r1] - forM_ l $ \r -> indir env r $ do + forM_ l $ \r -> indir testenv r $ do when switchdirect $ - git_annex env "direct" [] @? "failed switching to direct mode" - git_annex env "sync" [] @? "sync failed" + git_annex testenv "direct" [] @? "failed switching to direct mode" + git_annex testenv "sync" [] @? "sync failed" checkmerge ("r1" ++ show switchdirect) r1 checkmerge ("r2" ++ show switchdirect) r2 conflictor = "conflictor" @@ -1005,37 +1005,37 @@ test_nonannexed_conflict_resolution env = do - Case 2: Remote adds conflictor/file; local has a file named conflictor. -} test_uncommitted_conflict_resolution :: TestEnv -> Assertion -test_uncommitted_conflict_resolution env = do +test_uncommitted_conflict_resolution testenv = do check conflictor check (conflictor </> "file") where - check remoteconflictor = withtmpclonerepo env False $ \r1 -> - withtmpclonerepo env False $ \r2 -> do - indir env r1 $ do + check remoteconflictor = withtmpclonerepo testenv False $ \r1 -> + withtmpclonerepo testenv False $ \r2 -> do + indir testenv r1 $ do disconnectOrigin createDirectoryIfMissing True (parentDir remoteconflictor) writeFile remoteconflictor annexedcontent - git_annex env "add" [conflictor] @? "add remoteconflicter failed" - git_annex env "sync" [] @? "sync failed in r1" - indir env r2 $ do + git_annex testenv "add" [conflictor] @? "add remoteconflicter failed" + git_annex testenv "sync" [] @? "sync failed in r1" + indir testenv r2 $ do disconnectOrigin writeFile conflictor localcontent - pair env r1 r2 - indir env r2 $ ifM (annexeval Config.isDirect) + pair testenv r1 r2 + indir testenv r2 $ ifM (annexeval Config.isDirect) ( do - git_annex env "sync" [] @? "sync failed" + git_annex testenv "sync" [] @? "sync failed" let local = conflictor ++ localprefix doesFileExist local @? (local ++ " missing after merge") s <- readFile local s == localcontent @? (local ++ " has wrong content: " ++ s) - git_annex env "get" [conflictor] @? "get failed" + git_annex testenv "get" [conflictor] @? "get failed" doesFileExist remoteconflictor @? (remoteconflictor ++ " missing after merge") s' <- readFile remoteconflictor s' == annexedcontent @? (remoteconflictor ++ " has wrong content: " ++ s) -- this case is intentionally not handled -- in indirect mode, since the user -- can recover on their own easily - , not <$> git_annex env "sync" [] @? "sync failed to fail" + , not <$> git_annex testenv "sync" [] @? "sync failed to fail" ) conflictor = "conflictor" localprefix = ".variant-local" @@ -1046,81 +1046,81 @@ test_uncommitted_conflict_resolution env = do - lost track of whether a file was a symlink. -} test_conflict_resolution_symlinks :: TestEnv -> Assertion -test_conflict_resolution_symlinks env = do - withtmpclonerepo env False $ \r1 -> - withtmpclonerepo env False $ \r2 -> do - withtmpclonerepo env False $ \r3 -> do - indir env r1 $ do +test_conflict_resolution_symlinks testenv = do + withtmpclonerepo testenv False $ \r1 -> + withtmpclonerepo testenv False $ \r2 -> do + withtmpclonerepo testenv False $ \r3 -> do + indir testenv r1 $ do writeFile conflictor "conflictor" - git_annex env "add" [conflictor] @? "add conflicter failed" - git_annex env "sync" [] @? "sync failed in r1" + git_annex testenv "add" [conflictor] @? "add conflicter failed" + git_annex testenv "sync" [] @? "sync failed in r1" check_is_link conflictor "r1" - indir env r2 $ do + indir testenv r2 $ do createDirectory conflictor writeFile (conflictor </> "subfile") "subfile" - git_annex env "add" [conflictor] @? "add conflicter failed" - git_annex env "sync" [] @? "sync failed in r2" + git_annex testenv "add" [conflictor] @? "add conflicter failed" + git_annex testenv "sync" [] @? "sync failed in r2" check_is_link (conflictor </> "subfile") "r2" - indir env r3 $ do + indir testenv r3 $ do writeFile conflictor "conflictor" - git_annex env "add" [conflictor] @? "add conflicter failed" - git_annex env "sync" [] @? "sync failed in r1" + git_annex testenv "add" [conflictor] @? "add conflicter failed" + git_annex testenv "sync" [] @? "sync failed in r1" check_is_link (conflictor </> "subfile") "r3" where conflictor = "conflictor" check_is_link f what = do - git_annex_expectoutput env "find" ["--include=*", f] [Git.FilePath.toInternalGitPath f] + git_annex_expectoutput testenv "find" ["--include=*", f] [Git.FilePath.toInternalGitPath f] l <- annexeval $ Annex.inRepo $ Git.LsTree.lsTreeFiles Git.Ref.headRef [f] all (\i -> Git.Types.toBlobType (Git.LsTree.mode i) == Just Git.Types.SymlinkBlob) l @? (what ++ " " ++ f ++ " lost symlink bit after merge: " ++ show l) {- Set up repos as remotes of each other. -} pair :: TestEnv -> FilePath -> FilePath -> Assertion -pair env r1 r2 = forM_ [r1, r2] $ \r -> indir env r $ do +pair testenv r1 r2 = forM_ [r1, r2] $ \r -> indir testenv r $ do when (r /= r1) $ boolSystem "git" [Params "remote add r1", File ("../../" ++ r1)] @? "remote add" when (r /= r2) $ boolSystem "git" [Params "remote add r2", File ("../../" ++ r2)] @? "remote add" test_map :: TestEnv -> Assertion -test_map env = intmpclonerepo env $ do +test_map testenv = intmpclonerepo testenv $ do -- set descriptions, that will be looked for in the map - git_annex env "describe" [".", "this repo"] @? "describe 1 failed" - git_annex env "describe" ["origin", "origin repo"] @? "describe 2 failed" + git_annex testenv "describe" [".", "this repo"] @? "describe 1 failed" + git_annex testenv "describe" ["origin", "origin repo"] @? "describe 2 failed" -- --fast avoids it running graphviz, not a build dependency - git_annex env "map" ["--fast"] @? "map failed" + git_annex testenv "map" ["--fast"] @? "map failed" test_uninit :: TestEnv -> Assertion -test_uninit env = intmpclonerepo env $ do - git_annex env "get" [] @? "get failed" +test_uninit testenv = intmpclonerepo testenv $ do + git_annex testenv "get" [] @? "get failed" annexed_present annexedfile - _ <- git_annex env "uninit" [] -- exit status not checked; does abnormal exit + _ <- git_annex testenv "uninit" [] -- exit status not checked; does abnormal exit checkregularfile annexedfile doesDirectoryExist ".git" @? ".git vanished in uninit" test_uninit_inbranch :: TestEnv -> Assertion -test_uninit_inbranch env = intmpclonerepoInDirect env $ do +test_uninit_inbranch testenv = intmpclonerepoInDirect testenv $ do boolSystem "git" [Params "checkout git-annex"] @? "git checkout git-annex" - not <$> git_annex env "uninit" [] @? "uninit failed to fail when git-annex branch was checked out" + not <$> git_annex testenv "uninit" [] @? "uninit failed to fail when git-annex branch was checked out" test_upgrade :: TestEnv -> Assertion -test_upgrade env = intmpclonerepo env $ do - git_annex env "upgrade" [] @? "upgrade from same version failed" +test_upgrade testenv = intmpclonerepo testenv $ do + git_annex testenv "upgrade" [] @? "upgrade from same version failed" test_whereis :: TestEnv -> Assertion -test_whereis env = intmpclonerepo env $ do +test_whereis testenv = intmpclonerepo testenv $ do annexed_notpresent annexedfile - git_annex env "whereis" [annexedfile] @? "whereis on non-present file failed" - git_annex env "untrust" ["origin"] @? "untrust failed" - not <$> git_annex env "whereis" [annexedfile] @? "whereis on non-present file only present in untrusted repo failed to fail" - git_annex env "get" [annexedfile] @? "get failed" + git_annex testenv "whereis" [annexedfile] @? "whereis on non-present file failed" + git_annex testenv "untrust" ["origin"] @? "untrust failed" + not <$> git_annex testenv "whereis" [annexedfile] @? "whereis on non-present file only present in untrusted repo failed to fail" + git_annex testenv "get" [annexedfile] @? "get failed" annexed_present annexedfile - git_annex env "whereis" [annexedfile] @? "whereis on present file failed" + git_annex testenv "whereis" [annexedfile] @? "whereis on present file failed" test_hook_remote :: TestEnv -> Assertion -test_hook_remote env = intmpclonerepo env $ do +test_hook_remote testenv = intmpclonerepo testenv $ do #ifndef mingw32_HOST_OS - git_annex env "initremote" (words "foo type=hook encryption=none hooktype=foo") @? "initremote failed" + git_annex testenv "initremote" (words "foo type=hook encryption=none hooktype=foo") @? "initremote failed" createDirectory dir git_config "annex.foo-store-hook" $ "cp $ANNEX_FILE " ++ loc @@ -1130,15 +1130,15 @@ test_hook_remote env = intmpclonerepo env $ do "rm -f " ++ loc git_config "annex.foo-checkpresent-hook" $ "if [ -e " ++ loc ++ " ]; then echo $ANNEX_KEY; fi" - git_annex env "get" [annexedfile] @? "get of file failed" + git_annex testenv "get" [annexedfile] @? "get of file failed" annexed_present annexedfile - git_annex env "copy" [annexedfile, "--to", "foo"] @? "copy --to hook remote failed" + git_annex testenv "copy" [annexedfile, "--to", "foo"] @? "copy --to hook remote failed" annexed_present annexedfile - git_annex env "drop" [annexedfile, "--numcopies=2"] @? "drop failed" + git_annex testenv "drop" [annexedfile, "--numcopies=2"] @? "drop failed" annexed_notpresent annexedfile - git_annex env "move" [annexedfile, "--from", "foo"] @? "move --from hook remote failed" + git_annex testenv "move" [annexedfile, "--from", "foo"] @? "move --from hook remote failed" annexed_present annexedfile - not <$> git_annex env "drop" [annexedfile, "--numcopies=2"] @? "drop failed to fail" + not <$> git_annex testenv "drop" [annexedfile, "--numcopies=2"] @? "drop failed to fail" annexed_present annexedfile where dir = "dir" @@ -1151,34 +1151,34 @@ test_hook_remote env = intmpclonerepo env $ do #endif test_directory_remote :: TestEnv -> Assertion -test_directory_remote env = intmpclonerepo env $ do +test_directory_remote testenv = intmpclonerepo testenv $ do createDirectory "dir" - git_annex env "initremote" (words "foo type=directory encryption=none directory=dir") @? "initremote failed" - git_annex env "get" [annexedfile] @? "get of file failed" + git_annex testenv "initremote" (words "foo type=directory encryption=none directory=dir") @? "initremote failed" + git_annex testenv "get" [annexedfile] @? "get of file failed" annexed_present annexedfile - git_annex env "copy" [annexedfile, "--to", "foo"] @? "copy --to directory remote failed" + git_annex testenv "copy" [annexedfile, "--to", "foo"] @? "copy --to directory remote failed" annexed_present annexedfile - git_annex env "drop" [annexedfile, "--numcopies=2"] @? "drop failed" + git_annex testenv "drop" [annexedfile, "--numcopies=2"] @? "drop failed" annexed_notpresent annexedfile - git_annex env "move" [annexedfile, "--from", "foo"] @? "move --from directory remote failed" + git_annex testenv "move" [annexedfile, "--from", "foo"] @? "move --from directory remote failed" annexed_present annexedfile - not <$> git_annex env "drop" [annexedfile, "--numcopies=2"] @? "drop failed to fail" + not <$> git_annex testenv "drop" [annexedfile, "--numcopies=2"] @? "drop failed to fail" annexed_present annexedfile test_rsync_remote :: TestEnv -> Assertion -test_rsync_remote env = intmpclonerepo env $ do +test_rsync_remote testenv = intmpclonerepo testenv $ do #ifndef mingw32_HOST_OS createDirectory "dir" - git_annex env "initremote" (words "foo type=rsync encryption=none rsyncurl=dir") @? "initremote failed" - git_annex env "get" [annexedfile] @? "get of file failed" + git_annex testenv "initremote" (words "foo type=rsync encryption=none rsyncurl=dir") @? "initremote failed" + git_annex testenv "get" [annexedfile] @? "get of file failed" annexed_present annexedfile - git_annex env "copy" [annexedfile, "--to", "foo"] @? "copy --to rsync remote failed" + git_annex testenv "copy" [annexedfile, "--to", "foo"] @? "copy --to rsync remote failed" annexed_present annexedfile - git_annex env "drop" [annexedfile, "--numcopies=2"] @? "drop failed" + git_annex testenv "drop" [annexedfile, "--numcopies=2"] @? "drop failed" annexed_notpresent annexedfile - git_annex env "move" [annexedfile, "--from", "foo"] @? "move --from rsync remote failed" + git_annex testenv "move" [annexedfile, "--from", "foo"] @? "move --from rsync remote failed" annexed_present annexedfile - not <$> git_annex env "drop" [annexedfile, "--numcopies=2"] @? "drop failed to fail" + not <$> git_annex testenv "drop" [annexedfile, "--numcopies=2"] @? "drop failed to fail" annexed_present annexedfile #else -- Rsync remotes with a rsyncurl of a directory do not currently @@ -1187,34 +1187,34 @@ test_rsync_remote env = intmpclonerepo env $ do #endif test_bup_remote :: TestEnv -> Assertion -test_bup_remote env = intmpclonerepo env $ when Build.SysConfig.bup $ do +test_bup_remote testenv = intmpclonerepo testenv $ when Build.SysConfig.bup $ do dir <- absPath "dir" -- bup special remote needs an absolute path createDirectory dir - git_annex env "initremote" (words $ "foo type=bup encryption=none buprepo="++dir) @? "initremote failed" - git_annex env "get" [annexedfile] @? "get of file failed" + git_annex testenv "initremote" (words $ "foo type=bup encryption=none buprepo="++dir) @? "initremote failed" + git_annex testenv "get" [annexedfile] @? "get of file failed" annexed_present annexedfile - git_annex env "copy" [annexedfile, "--to", "foo"] @? "copy --to bup remote failed" + git_annex testenv "copy" [annexedfile, "--to", "foo"] @? "copy --to bup remote failed" annexed_present annexedfile - git_annex env "drop" [annexedfile, "--numcopies=2"] @? "drop failed" + git_annex testenv "drop" [annexedfile, "--numcopies=2"] @? "drop failed" annexed_notpresent annexedfile - git_annex env "copy" [annexedfile, "--from", "foo"] @? "copy --from bup remote failed" + git_annex testenv "copy" [annexedfile, "--from", "foo"] @? "copy --from bup remote failed" annexed_present annexedfile - not <$> git_annex env "move" [annexedfile, "--from", "foo"] @? "move --from bup remote failed to fail" + not <$> git_annex testenv "move" [annexedfile, "--from", "foo"] @? "move --from bup remote failed to fail" annexed_present annexedfile -- gpg is not a build dependency, so only test when it's available test_crypto :: TestEnv -> Assertion #ifndef mingw32_HOST_OS -test_crypto env = do +test_crypto testenv = do testscheme "shared" testscheme "hybrid" testscheme "pubkey" where - testscheme scheme = intmpclonerepo env $ whenM (Utility.Path.inPath Utility.Gpg.gpgcmd) $ do + testscheme scheme = intmpclonerepo testenv $ whenM (Utility.Path.inPath Utility.Gpg.gpgcmd) $ do Utility.Gpg.testTestHarness @? "test harness self-test failed" Utility.Gpg.testHarness $ do createDirectory "dir" - let a cmd = git_annex env cmd $ + let a cmd = git_annex testenv cmd $ [ "foo" , "type=directory" , "encryption=" ++ scheme @@ -1227,9 +1227,9 @@ test_crypto env = do not <$> a "initremote" @? "initremote failed to fail when run twice in a row" a "enableremote" @? "enableremote failed" a "enableremote" @? "enableremote failed when run twice in a row" - git_annex env "get" [annexedfile] @? "get of file failed" + git_annex testenv "get" [annexedfile] @? "get of file failed" annexed_present annexedfile - git_annex env "copy" [annexedfile, "--to", "foo"] @? "copy --to encrypted remote failed" + git_annex testenv "copy" [annexedfile, "--to", "foo"] @? "copy --to encrypted remote failed" (c,k) <- annexeval $ do uuid <- Remote.nameToUUID "foo" rs <- Logs.Remote.readRemoteLog @@ -1241,11 +1241,11 @@ test_crypto env = do testEncryptedRemote scheme key c [k] @? "invalid crypto setup" annexed_present annexedfile - git_annex env "drop" [annexedfile, "--numcopies=2"] @? "drop failed" + git_annex testenv "drop" [annexedfile, "--numcopies=2"] @? "drop failed" annexed_notpresent annexedfile - git_annex env "move" [annexedfile, "--from", "foo"] @? "move --from encrypted remote failed" + git_annex testenv "move" [annexedfile, "--from", "foo"] @? "move --from encrypted remote failed" annexed_present annexedfile - not <$> git_annex env "drop" [annexedfile, "--numcopies=2"] @? "drop failed to fail" + not <$> git_annex testenv "drop" [annexedfile, "--numcopies=2"] @? "drop failed to fail" annexed_present annexedfile {- Ensure the configuration complies with the encryption scheme, and - that all keys are encrypted properly for the given directory remote. -} @@ -1278,28 +1278,28 @@ test_crypto _env = putStrLn "gpg testing not implemented on Windows" #endif test_add_subdirs :: TestEnv -> Assertion -test_add_subdirs env = intmpclonerepo env $ do +test_add_subdirs testenv = intmpclonerepo testenv $ do createDirectory "dir" writeFile ("dir" </> "foo") $ "dir/" ++ content annexedfile - git_annex env "add" ["dir"] @? "add of subdir failed" + git_annex testenv "add" ["dir"] @? "add of subdir failed" {- Regression test for Windows bug where symlinks were not - calculated correctly for files in subdirs. -} - git_annex env "sync" [] @? "sync failed" + git_annex testenv "sync" [] @? "sync failed" l <- annexeval $ decodeBS <$> Annex.CatFile.catObject (Git.Types.Ref "HEAD:dir/foo") "../.git/annex/" `isPrefixOf` l @? ("symlink from subdir to .git/annex is wrong: " ++ l) createDirectory "dir2" writeFile ("dir2" </> "foo") $ content annexedfile setCurrentDirectory "dir" - git_annex env "add" [".." </> "dir2"] @? "add of ../subdir failed" + git_annex testenv "add" [".." </> "dir2"] @? "add of ../subdir failed" -- This is equivilant to running git-annex, but it's all run in-process -- (when the OS allows) so test coverage collection works. git_annex :: TestEnv -> String -> [String] -> IO Bool -git_annex env command params = do +git_annex testenv command params = do #ifndef mingw32_HOST_OS - forM_ (M.toList env) $ \(var, val) -> + forM_ (M.toList testenv) $ \(var, val) -> Utility.Env.setEnv var val True -- catch all errors, including normally fatal errors @@ -1312,23 +1312,23 @@ git_annex env command params = do #else Utility.SafeCommand.boolSystemEnv "git-annex" (map Param $ command : params) - (Just $ M.toList env) + (Just $ M.toList testenv) #endif {- Runs git-annex and returns its output. -} git_annex_output :: TestEnv -> String -> [String] -> IO String -git_annex_output env command params = do +git_annex_output testenv command params = do got <- Utility.Process.readProcessEnv "git-annex" (command:params) - (Just $ M.toList env) + (Just $ M.toList testenv) -- XXX since the above is a separate process, code coverage stats are -- not gathered for things run in it. -- Run same command again, to get code coverage. - _ <- git_annex env command params + _ <- git_annex testenv command params return got git_annex_expectoutput :: TestEnv -> String -> [String] -> [String] -> IO () -git_annex_expectoutput env command params expected = do - got <- lines <$> git_annex_output env command params +git_annex_expectoutput testenv command params expected = do + got <- lines <$> git_annex_output testenv command params got == expected @? ("unexpected value running " ++ command ++ " " ++ show params ++ " -- got: " ++ show got ++ " expected: " ++ show expected) -- Runs an action in the current annex. Note that shutdown actions @@ -1341,16 +1341,16 @@ annexeval a = do a innewrepo :: TestEnv -> Assertion -> Assertion -innewrepo env a = withgitrepo env $ \r -> indir env r a +innewrepo testenv a = withgitrepo testenv $ \r -> indir testenv r a inmainrepo :: TestEnv -> Assertion -> Assertion -inmainrepo env = indir env mainrepodir +inmainrepo testenv = indir testenv mainrepodir intmpclonerepo :: TestEnv -> Assertion -> Assertion -intmpclonerepo env a = withtmpclonerepo env False $ \r -> indir env r a +intmpclonerepo testenv a = withtmpclonerepo testenv False $ \r -> indir testenv r a intmpclonerepoInDirect :: TestEnv -> Assertion -> Assertion -intmpclonerepoInDirect env a = intmpclonerepo env $ +intmpclonerepoInDirect testenv a = intmpclonerepo testenv $ ifM isdirect ( putStrLn "not supported in direct mode; skipping" , a @@ -1366,62 +1366,62 @@ isInDirect d = do not <$> Annex.eval s Config.isDirect intmpbareclonerepo :: TestEnv -> Assertion -> Assertion -intmpbareclonerepo env a = withtmpclonerepo env True $ \r -> indir env r a +intmpbareclonerepo testenv a = withtmpclonerepo testenv True $ \r -> indir testenv r a withtmpclonerepo :: TestEnv -> Bool -> (FilePath -> Assertion) -> Assertion -withtmpclonerepo env bare a = do +withtmpclonerepo testenv bare a = do dir <- tmprepodir - bracket (clonerepo env mainrepodir dir bare) cleanup a + bracket (clonerepo testenv mainrepodir dir bare) cleanup a disconnectOrigin :: Assertion disconnectOrigin = boolSystem "git" [Params "remote rm origin"] @? "remote rm" withgitrepo :: TestEnv -> (FilePath -> Assertion) -> Assertion -withgitrepo env = bracket (setuprepo env mainrepodir) return +withgitrepo testenv = bracket (setuprepo testenv mainrepodir) return indir :: TestEnv -> FilePath -> Assertion -> Assertion -indir env dir a = do - cwd <- getCurrentDirectory +indir testenv dir a = do + currdir <- getCurrentDirectory -- Assertion failures throw non-IO errors; catch - -- any type of error and change back to cwd before + -- any type of error and change back to currdir before -- rethrowing. - r <- bracket_ (changeToTmpDir env dir) (setCurrentDirectory cwd) + r <- bracket_ (changeToTmpDir testenv dir) (setCurrentDirectory currdir) (try a::IO (Either SomeException ())) case r of Right () -> return () Left e -> throw e setuprepo :: TestEnv -> FilePath -> IO FilePath -setuprepo env dir = do +setuprepo testenv dir = do cleanup dir ensuretmpdir boolSystem "git" [Params "init -q", File dir] @? "git init failed" - configrepo env dir + configrepo testenv dir return dir -- clones are always done as local clones; we cannot test ssh clones clonerepo :: TestEnv -> FilePath -> FilePath -> Bool -> IO FilePath -clonerepo env old new bare = do +clonerepo testenv old new bare = do cleanup new ensuretmpdir let b = if bare then " --bare" else "" boolSystem "git" [Params ("clone -q" ++ b), File old, File new] @? "git clone failed" - indir env new $ - git_annex env "init" ["-q", new] @? "git annex init failed" - configrepo env new + indir testenv new $ + git_annex testenv "init" ["-q", new] @? "git annex init failed" + configrepo testenv new unless bare $ - indir env new $ - handleforcedirect env + indir testenv new $ + handleforcedirect testenv return new configrepo :: TestEnv -> FilePath -> IO () -configrepo env dir = indir env dir $ do +configrepo testenv dir = indir testenv dir $ do boolSystem "git" [Params "config user.name", Param "Test User"] @? "git config failed" boolSystem "git" [Params "config user.email test@example.com"] @? "git config failed" handleforcedirect :: TestEnv -> IO () -handleforcedirect env = when (M.lookup "FORCEDIRECT" env == Just "1") $ - git_annex env "direct" ["-q"] @? "git annex direct failed" +handleforcedirect testenv = when (M.lookup "FORCEDIRECT" testenv == Just "1") $ + git_annex testenv "direct" ["-q"] @? "git annex direct failed" ensuretmpdir :: IO () ensuretmpdir = do @@ -1539,12 +1539,12 @@ withTestEnv :: Bool -> (IO TestEnv -> TestTree) -> TestTree withTestEnv forcedirect = withResource prepare release where prepare = do - env <- prepareTestEnv forcedirect - case tryIngredients [consoleTestReporter] mempty (initTests env) of + testenv <- prepareTestEnv forcedirect + case tryIngredients [consoleTestReporter] mempty (initTests testenv) of Nothing -> error "No tests found!?" Just act -> unlessM act $ error "init tests failed! cannot continue" - return env + return testenv release = releaseTestEnv releaseTestEnv :: TestEnv -> IO () @@ -1555,14 +1555,14 @@ prepareTestEnv forcedirect = do whenM (doesDirectoryExist tmpdir) $ error $ "The temporary directory " ++ tmpdir ++ " already exists; cannot run test suite." - cwd <- getCurrentDirectory + currdir <- getCurrentDirectory p <- Utility.Env.getEnvDefault "PATH" "" - env <- Utility.Env.getEnvironment + environ <- Utility.Env.getEnvironment let newenv = -- Ensure that the just-built git annex is used. - [ ("PATH", cwd ++ [searchPathSeparator] ++ p) - , ("TOPDIR", cwd) + [ ("PATH", currdir ++ [searchPathSeparator] ++ p) + , ("TOPDIR", currdir) -- Avoid git complaining if it cannot determine the user's -- email address, or exploding if it doesn't know the user's -- name. @@ -1575,11 +1575,11 @@ prepareTestEnv forcedirect = do , ("FORCEDIRECT", if forcedirect then "1" else "") ] - return $ M.fromList newenv `M.union` M.fromList env + return $ M.fromList newenv `M.union` M.fromList environ changeToTmpDir :: TestEnv -> FilePath -> IO () -changeToTmpDir env t = do - let topdir = fromMaybe "" $ M.lookup "TOPDIR" env +changeToTmpDir testenv t = do + let topdir = fromMaybe "" $ M.lookup "TOPDIR" testenv setCurrentDirectory $ topdir ++ "/" ++ t tmpdir :: String diff --git a/Utility/Batch.hs b/Utility/Batch.hs index 3f0708180..d6dadae67 100644 --- a/Utility/Batch.hs +++ b/Utility/Batch.hs @@ -16,7 +16,6 @@ import Control.Concurrent.Async import System.Posix.Process #endif import qualified Control.Exception as E -import System.Process (env) {- Runs an operation, at batch priority. - diff --git a/Utility/CoProcess.hs b/Utility/CoProcess.hs index d531f07b7..332c09d49 100644 --- a/Utility/CoProcess.hs +++ b/Utility/CoProcess.hs @@ -37,8 +37,8 @@ data CoProcessSpec = CoProcessSpec } start :: Int -> FilePath -> [String] -> Maybe [(String, String)] -> IO CoProcessHandle -start numrestarts cmd params env = do - s <- start' $ CoProcessSpec numrestarts cmd params env +start numrestarts cmd params environ = do + s <- start' $ CoProcessSpec numrestarts cmd params environ newMVar s start' :: CoProcessSpec -> IO CoProcessState diff --git a/Utility/ExternalSHA.hs b/Utility/ExternalSHA.hs index 8b5ca697c..1ab93262d 100644 --- a/Utility/ExternalSHA.hs +++ b/Utility/ExternalSHA.hs @@ -15,7 +15,6 @@ import Utility.Process import Utility.FileSystemEncoding import Utility.Misc -import System.Process import Data.List import Data.Char import Control.Applicative diff --git a/Utility/Process.hs b/Utility/Process.hs index cd3826d78..1f722af81 100644 --- a/Utility/Process.hs +++ b/Utility/Process.hs @@ -10,7 +10,7 @@ module Utility.Process ( module X, - CreateProcess, + CreateProcess(..), StdHandle(..), readProcess, readProcessEnv, diff --git a/Utility/SafeCommand.hs b/Utility/SafeCommand.hs index 04fcf3908..86e60db0e 100644 --- a/Utility/SafeCommand.hs +++ b/Utility/SafeCommand.hs @@ -9,7 +9,6 @@ module Utility.SafeCommand where import System.Exit import Utility.Process -import System.Process (env) import Data.String.Utils import Control.Applicative import System.FilePath |