blob: b9ea2344fe0005aad9427f8cb56c94ed69165a3b (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
|
{- Checks system configuration and generates SysConfig.hs. -}
import System.IO
import System.Cmd
import System.Exit
import System.Directory
type Test = IO Bool
data TestDesc = TestDesc String String Test
data Config = Config String Bool
instance Show Config where
show (Config key value) = unlines $ [
key ++ " :: Bool"
, key ++ " = " ++ show value
]
tests :: [TestDesc]
tests = [
TestDesc "cp -a" "cp_a" $ testCp "-a"
, TestDesc "cp -p" "cp_p" $ testCp "-p"
, TestDesc "cp --reflink=auto" "cp_reflink_auto" $ testCp "--reflink=auto"
]
tmpDir :: String
tmpDir = "tmp"
testFile :: String
testFile = tmpDir ++ "/testfile"
quiet :: String -> String
quiet s = s ++ " 2>/dev/null"
testCp :: String -> Test
testCp option = testCmd $ quiet $ "cp " ++ option ++ " " ++ testFile ++
" " ++ testFile ++ ".new"
testCmd :: String -> Test
testCmd c = do
ret <- system c
return $ ret == ExitSuccess
testStart :: String -> IO ()
testStart s = do
putStr $ " checking " ++ s ++ "..."
hFlush stdout
testEnd :: Bool -> IO ()
testEnd r = putStrLn $ " " ++ (show r)
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 :: [TestDesc] -> IO [Config]
runTests [] = return []
runTests ((TestDesc tname key t):ts) = do
testStart tname
val <- t
testEnd val
rest <- runTests ts
return $ (Config key val):rest
setup :: IO ()
setup = do
createDirectoryIfMissing True tmpDir
writeFile testFile "test file contents"
cleanup :: IO ()
cleanup = do
removeDirectoryRecursive tmpDir
main :: IO ()
main = do
setup
config <- runTests tests
writeSysConfig config
cleanup
|
