refactor away whichCmd and some other cleanup
This commit is contained in:
parent
b889543507
commit
e2404ca409
3 changed files with 21 additions and 24 deletions
|
@ -72,30 +72,26 @@ testCmd k cmdline = do
|
|||
|
||||
{- Ensures that one of a set of commands is available by running each in
|
||||
- turn. The Config is set to the first one found. -}
|
||||
selectCmd :: ConfigKey -> [String] -> Test
|
||||
selectCmd k cmds = search cmds
|
||||
selectCmd :: Bool -> ConfigKey -> [String] -> String -> Test
|
||||
selectCmd required k cmds param = search cmds
|
||||
where
|
||||
search [] = do
|
||||
testEnd $ Config k (BoolConfig False)
|
||||
error $ "* need one of these commands, but none are available: " ++ show (map (head . words) cmds)
|
||||
search [] = failure
|
||||
search (c:cs) = do
|
||||
ret <- system $ quiet c
|
||||
ret <- system $ quiet c ++ " " ++ param
|
||||
if (ret == ExitSuccess)
|
||||
then return $ Config k (StringConfig c)
|
||||
else search cs
|
||||
|
||||
whichCmd :: ConfigKey -> [String] -> Test
|
||||
whichCmd k cmds = search cmds
|
||||
where
|
||||
search [] = do
|
||||
let r = Config k (MaybeStringConfig Nothing)
|
||||
testEnd r
|
||||
return r
|
||||
search (c:cs) = do
|
||||
ret <- system $ quiet c
|
||||
if (ret == ExitSuccess)
|
||||
then return $ Config k (MaybeStringConfig $ Just $ head $ words c)
|
||||
then success c
|
||||
else search cs
|
||||
success c
|
||||
| required == True = return $ Config k (StringConfig c)
|
||||
| otherwise = return $ Config k (MaybeStringConfig $ Just c)
|
||||
failure
|
||||
| required == True = do
|
||||
testEnd $ Config k (BoolConfig False)
|
||||
error $ "* need one of these commands, but none are available: " ++ show cmds
|
||||
| otherwise = do
|
||||
let r = Config k (MaybeStringConfig Nothing)
|
||||
testEnd r
|
||||
return r
|
||||
|
||||
quiet :: String -> String
|
||||
quiet s = s ++ " >/dev/null 2>&1"
|
||||
|
|
|
@ -11,7 +11,7 @@ tests = [
|
|||
, testCp "cp_a" "-a"
|
||||
, testCp "cp_p" "-p"
|
||||
, testCp "cp_reflink_auto" "--reflink=auto"
|
||||
, TestCase "uuid generator" $ selectCmd "uuid" ["uuid", "uuidgen"]
|
||||
, TestCase "uuid generator" $ selectCmd True "uuid" ["uuid", "uuidgen"] ""
|
||||
, TestCase "xargs -0" $ requireCmd "xargs_0" "xargs -0 </dev/null"
|
||||
, TestCase "rsync" $ requireCmd "rsync" "rsync --version >/dev/null"
|
||||
, TestCase "curl" $ testCmd "curl" "curl --version >/dev/null"
|
||||
|
@ -22,9 +22,9 @@ shaTestCases :: [Int] -> [TestCase]
|
|||
shaTestCases l = map make l
|
||||
where make n =
|
||||
let
|
||||
cmds = map (\x -> "sha" ++ show n ++ x ++ " </dev/null") ["", "sum"]
|
||||
cmds = map (\x -> "sha" ++ show n ++ x) ["", "sum"]
|
||||
key = "sha" ++ show n
|
||||
in TestCase key $ whichCmd key cmds
|
||||
in TestCase key $ selectCmd False key cmds "</dev/null"
|
||||
|
||||
tmpDir :: String
|
||||
tmpDir = "tmp"
|
||||
|
|
3
debian/changelog
vendored
3
debian/changelog
vendored
|
@ -14,7 +14,8 @@ git-annex (0.20110402) UNRELEASED; urgency=low
|
|||
* Add doc-base file. Closes: #621408
|
||||
* Periodically flush git command queue, to avoid boating memory usage
|
||||
too much.
|
||||
* Support "sha1" and "sha512" commands on FreeBSD. Thanks, Fraser Tweedale
|
||||
* Support "sha1" and "sha512" commands on FreeBSD, and allow building
|
||||
if any/all SHA commands are not available. Thanks, Fraser Tweedale
|
||||
|
||||
-- Joey Hess <joeyh@debian.org> Sat, 02 Apr 2011 13:45:54 -0400
|
||||
|
||||
|
|
Loading…
Reference in a new issue