refactor away whichCmd and some other cleanup

This commit is contained in:
Joey Hess 2011-04-07 22:03:31 -04:00
parent b889543507
commit e2404ca409
3 changed files with 21 additions and 24 deletions

View file

@ -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"

View file

@ -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
View file

@ -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