summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Makefile2
-rw-r--r--TestConfig.hs93
-rw-r--r--configure.hs100
3 files changed, 105 insertions, 90 deletions
diff --git a/Makefile b/Makefile
index 44d4be02b..831c004dc 100644
--- a/Makefile
+++ b/Makefile
@@ -7,7 +7,7 @@ mans=git-annex.1 git-annex-shell.1
all: $(bins) $(mans) docs
-SysConfig.hs: configure.hs
+SysConfig.hs: configure.hs TestConfig.hs
$(GHCMAKE) configure
./configure
diff --git a/TestConfig.hs b/TestConfig.hs
new file mode 100644
index 000000000..5e59681dd
--- /dev/null
+++ b/TestConfig.hs
@@ -0,0 +1,93 @@
+{- Tests the system and generates SysConfig.hs. -}
+
+module TestConfig where
+
+import System.IO
+import System.Cmd
+import System.Exit
+
+type ConfigKey = String
+data ConfigValue = BoolConfig Bool | StringConfig String
+data Config = Config ConfigKey ConfigValue
+
+type Test = IO Config
+type TestName = String
+data TestCase = TestCase TestName Test
+
+instance Show ConfigValue where
+ show (BoolConfig b) = show b
+ show (StringConfig s) = show s
+
+instance Show Config where
+ show (Config key value) = unlines
+ [ key ++ " :: " ++ valuetype value
+ , key ++ " = " ++ show value
+ ]
+ where
+ valuetype (BoolConfig _) = "Bool"
+ valuetype (StringConfig _) = "String"
+
+writeSysConfig :: [Config] -> IO ()
+writeSysConfig config = writeFile "SysConfig.hs" body
+ where
+ body = unlines $ header ++ map show config ++ footer
+ header = [
+ "{- Automatically generated. -}"
+ , "module SysConfig where"
+ , ""
+ ]
+ footer = []
+
+runTests :: [TestCase] -> IO [Config]
+runTests [] = return []
+runTests ((TestCase tname t):ts) = do
+ testStart tname
+ c <- t
+ testEnd c
+ rest <- runTests ts
+ return $ c:rest
+
+{- Tests that a command is available, aborting if not. -}
+requireCmd :: ConfigKey -> String -> Test
+requireCmd k cmdline = do
+ ret <- testCmd k cmdline
+ handle ret
+ where
+ handle r@(Config _ (BoolConfig True)) = return r
+ handle r = do
+ testEnd r
+ error $ "** the " ++ c ++ " command is required"
+ c = (words cmdline) !! 0
+
+{- Checks if a command is available by running a command line. -}
+testCmd :: ConfigKey -> String -> Test
+testCmd k cmdline = do
+ ret <- system $ quiet cmdline
+ return $ Config k (BoolConfig $ ret == ExitSuccess)
+
+{- 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
+ where
+ search [] = do
+ testEnd $ Config k (BoolConfig False)
+ error $ "* need one of these commands, but none are available: " ++ show cmds
+ search (c:cs) = do
+ ret <- system $ quiet c
+ if (ret == ExitSuccess)
+ then return $ Config k (StringConfig c)
+ else search cs
+
+quiet :: String -> String
+quiet s = s ++ " >/dev/null 2>&1"
+
+testStart :: TestName -> IO ()
+testStart s = do
+ putStr $ " checking " ++ s ++ "..."
+ hFlush stdout
+
+testEnd :: Config -> IO ()
+testEnd (Config _ (BoolConfig True)) = putStrLn $ " yes"
+testEnd (Config _ (BoolConfig False)) = putStrLn $ " no"
+testEnd (Config _ (StringConfig s)) = putStrLn $ " " ++ s
diff --git a/configure.hs b/configure.hs
index 9f50328d3..8d1c117a7 100644
--- a/configure.hs
+++ b/configure.hs
@@ -1,37 +1,17 @@
{- Checks system configuration and generates SysConfig.hs. -}
-import System.IO
-import System.Cmd
-import System.Exit
import System.Directory
-type ConfigKey = String
-data ConfigValue = BoolConfig Bool | StringConfig String
-data Config = Config ConfigKey ConfigValue
-
-type Test = IO Config
-type TestName = String
-data TestCase = TestCase TestName Test
-
-instance Show Config where
- show (Config key value) = unlines [
- key ++ " :: " ++ valuetype value
- , key ++ " = " ++ showvalue value
- ]
- where
- valuetype (BoolConfig _) = "Bool"
- valuetype (StringConfig _) = "String"
- showvalue (BoolConfig b) = show b
- showvalue (StringConfig s) = show s
+import TestConfig
tests :: [TestCase]
tests = [
- TestCase "cp -a" $ testCp "cp_a" "-a"
- , TestCase "cp -p" $ testCp "cp_p" "-p"
- , TestCase "cp --reflink=auto" $ testCp "cp_reflink_auto" "--reflink=auto"
- , TestCase "uuid" $ selectCmd "uuid" ["uuid", "uuidgen"]
- , TestCase "xargs -0" $ requireCmd "xargs_0" "xargs -0" "xargs -0 </dev/null"
- , TestCase "rsync" $ requireCmd "rsync" "rsync" "rsync --version >/dev/null"
+ testCp "cp_a" "-a"
+ , testCp "cp_p" "-p"
+ , testCp "cp_reflink_auto" "--reflink=auto"
+ , 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"
]
tmpDir :: String
@@ -40,69 +20,11 @@ tmpDir = "tmp"
testFile :: String
testFile = tmpDir ++ "/testfile"
-requireCmd :: ConfigKey -> String -> String -> Test
-requireCmd k c cmdline = do
- ret <- testCmd k cmdline
- handle ret
- where
- handle r@(Config _ (BoolConfig True)) = return r
- handle r = do
- testEnd r
- error $ "** the " ++ c ++ " command is required to use git-annex"
-
-testCp :: ConfigKey -> String -> Test
-testCp k option = testCmd k $
- "cp " ++ option ++ " " ++ testFile ++ " " ++ testFile ++ ".new"
-
-testCmd :: ConfigKey -> String -> Test
-testCmd k c = do
- ret <- system $ quiet c
- return $ Config k (BoolConfig $ ret == ExitSuccess)
-
-selectCmd :: ConfigKey -> [String] -> Test
-selectCmd k cmds = search cmds
+testCp :: ConfigKey -> String -> TestCase
+testCp k option = TestCase cmd $ testCmd k run
where
- search [] = do
- testEnd $ Config k (BoolConfig False)
- error $ "* need one of these commands, but none are available: " ++ show cmds
- search (c:cs) = do
- ret <- system $ quiet c
- if (ret == ExitSuccess)
- then return $ Config k (StringConfig c)
- else search cs
-
-quiet :: String -> String
-quiet s = s ++ " >/dev/null 2>&1"
-
-testStart :: TestName -> IO ()
-testStart s = do
- putStr $ " checking " ++ s ++ "..."
- hFlush stdout
-
-testEnd :: Config -> IO ()
-testEnd (Config _ (BoolConfig True)) = putStrLn $ " yes"
-testEnd (Config _ (BoolConfig False)) = putStrLn $ " no"
-testEnd (Config _ (StringConfig s)) = putStrLn $ " " ++ s
-
-writeSysConfig :: [Config] -> IO ()
-writeSysConfig config = writeFile "SysConfig.hs" body
- where
- body = unlines $ header ++ map show config ++ footer
- header = [
- "{- Automatically generated by configure. -}"
- , "module SysConfig where"
- , ""
- ]
- footer = []
-
-runTests :: [TestCase] -> IO [Config]
-runTests [] = return []
-runTests ((TestCase tname t):ts) = do
- testStart tname
- c <- t
- testEnd c
- rest <- runTests ts
- return $ c:rest
+ cmd = "cp " ++ option
+ run = cmd ++ " " ++ testFile ++ " " ++ testFile ++ ".new"
setup :: IO ()
setup = do