diff options
author | 2011-04-08 00:12:00 -0400 | |
---|---|---|
committer | 2011-04-08 00:18:09 -0400 | |
commit | a77c34d2b4795a5d41f82a78e999ce33f43d8862 (patch) | |
tree | 6b387b9bf30dba14c6776862e0d5decc581f428f | |
parent | dfc1bfcc76036549eb49d8e88136d9d40e77a51a (diff) |
refactor
-rw-r--r-- | TestConfig.hs | 30 | ||||
-rw-r--r-- | configure.hs | 8 |
2 files changed, 20 insertions, 18 deletions
diff --git a/TestConfig.hs b/TestConfig.hs index 9b2759e19..bab297003 100644 --- a/TestConfig.hs +++ b/TestConfig.hs @@ -72,26 +72,28 @@ 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 :: Bool -> ConfigKey -> [String] -> String -> Test -selectCmd required k cmds param = search cmds +selectCmd :: ConfigKey -> [String] -> String -> Test +selectCmd k = searchCmd + (\match -> return $ Config k $ StringConfig match) + (\cmds -> do + testEnd $ Config k $ BoolConfig False + error $ "* need one of these commands, but none are available: " ++ show cmds + ) + +maybeSelectCmd :: ConfigKey -> [String] -> String -> Test +maybeSelectCmd k = searchCmd + (\match -> return $ Config k $ MaybeStringConfig $ Just match) + (\_ -> return $ Config k $ MaybeStringConfig Nothing) + +searchCmd :: (String -> Test) -> ([String] -> Test) -> [String] -> String -> Test +searchCmd success failure cmds param = search cmds where - search [] = failure + search [] = failure cmds search (c:cs) = do ret <- system $ quiet c ++ " " ++ param if (ret == ExitSuccess) 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" diff --git a/configure.hs b/configure.hs index 0661813ae..d340f937d 100644 --- a/configure.hs +++ b/configure.hs @@ -6,12 +6,12 @@ import Data.List import TestConfig tests :: [TestCase] -tests = [ - TestCase "version" $ getVersion +tests = + [ TestCase "version" $ getVersion , testCp "cp_a" "-a" , testCp "cp_p" "-p" , testCp "cp_reflink_auto" "--reflink=auto" - , TestCase "uuid generator" $ selectCmd True "uuid" ["uuid", "uuidgen"] "" + , TestCase "uuid generator" $ selectCmd "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" @@ -24,7 +24,7 @@ shaTestCases l = map make l let cmds = map (\x -> "sha" ++ show n ++ x) ["", "sum"] key = "sha" ++ show n - in TestCase key $ selectCmd False key cmds "</dev/null" + in TestCase key $ maybeSelectCmd key cmds "</dev/null" tmpDir :: String tmpDir = "tmp" |