summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2014-06-10 19:20:14 -0400
committerGravatar Joey Hess <joey@kitenet.net>2014-06-10 19:20:14 -0400
commit899f84a217681833146fadd8f30cd25ed1a9f653 (patch)
tree37351958f69f8afef17b96966a30ca2dde79ba1c
parent465c36e8f6a45b888e8f7be8baa52f0eb1759f77 (diff)
export CreateProcess fields from Utility.Process
update code to avoid cwd and env redefinition warnings
-rw-r--r--Annex/Ssh.hs1
-rw-r--r--Assistant/Install.hs10
-rw-r--r--Assistant/Threads/RemoteControl.hs1
-rw-r--r--Assistant/TransferrerPool.hs1
-rw-r--r--Assistant/XMPP/Git.hs9
-rw-r--r--Command/Status.hs4
-rw-r--r--Command/Uninit.hs4
-rw-r--r--Command/WebApp.hs1
-rw-r--r--Git/CheckAttr.hs10
-rw-r--r--Git/Command.hs2
-rw-r--r--Git/Config.hs1
-rw-r--r--Git/CurrentRepo.hs8
-rw-r--r--Git/Fsck.hs1
-rw-r--r--Git/LsFiles.hs4
-rw-r--r--Git/Queue.hs3
-rw-r--r--Git/UpdateIndex.hs1
-rw-r--r--Locations.hs4
-rw-r--r--Remote/External.hs1
-rw-r--r--Remote/Git.hs9
-rw-r--r--Remote/Glacier.hs2
-rw-r--r--Remote/Hook.hs16
-rw-r--r--RemoteDaemon/Transport/Ssh.hs1
-rw-r--r--Test.hs816
-rw-r--r--Utility/Batch.hs1
-rw-r--r--Utility/CoProcess.hs4
-rw-r--r--Utility/ExternalSHA.hs1
-rw-r--r--Utility/Process.hs2
-rw-r--r--Utility/SafeCommand.hs1
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
diff --git a/Test.hs b/Test.hs
index 55546d08b..95f8db663 100644
--- a/Test.hs
+++ b/Test.hs
@@ -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