mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

Improve detection of inability to check free disk space.

Browse source 
Don't check if configure indicated checks won't work. This should fix a
FTBFS on mipsel, where configure correctly detects the checks won't work,
while garbage is returned for disk space info at git-annex runtime. It also
means that, when built via cabal, disk space checks are not enabled,
unfortunatly.
This commit is contained in:
Joey Hess 2012-03-21 21:21:20 -04:00
parent d228377722
commit 181d2ccd20
6 changed files with 44 additions and 14 deletions
Download patch file Download diff file Expand all files Collapse all files

17
Build/Configure.hs
View file

@ -10,8 +10,12 @@ import Control.Applicative
import Build.TestConfig
import Utility.SafeCommand
tests :: [TestCase]
tests =
tests :: Bool -> [TestCase]
tests True = cabaltests ++ common
tests False = common
common :: [TestCase]
common =
[ TestCase "version" getVersion
, TestCase "git" $ requireCmd "git" "git --version >/dev/null"
, TestCase "git version" getGitVersion
@ -28,6 +32,11 @@ tests =
, TestCase "ssh connection caching" getSshConnectionCaching
] ++ shaTestCases [1, 256, 512, 224, 384]
cabaltests :: [TestCase]
cabaltests =
[ TestCase "StatFS" testStatFSDummy
]
shaTestCases :: [Int] -> [TestCase]
shaTestCases l = map make l
where make n =
@ -72,6 +81,10 @@ getSshConnectionCaching :: Test
getSshConnectionCaching = Config "sshconnectioncaching" . BoolConfig <$>
boolSystem "sh" [Param "-c", Param "ssh -o ControlPersist=yes -V >/dev/null 2>/dev/null"]
testStatFSDummy :: Test
testStatFSDummy =
return $ Config "statfs_sanity_checked" $ MaybeBoolConfig Nothing
{- Set up cabal file with version. -}
cabalSetup :: IO ()
cabalSetup = do

8
Build/TestConfig.hs
View file

@ -10,7 +10,8 @@ type ConfigKey = String
data ConfigValue =
BoolConfig Bool |
StringConfig String |
MaybeStringConfig (Maybe String)
MaybeStringConfig (Maybe String) |
MaybeBoolConfig (Maybe Bool)
data Config = Config ConfigKey ConfigValue
type Test = IO Config
@ -21,6 +22,7 @@ instance Show ConfigValue where
show (BoolConfig b) = show b
show (StringConfig s) = show s
show (MaybeStringConfig s) = show s
show (MaybeBoolConfig s) = show s
instance Show Config where
show (Config key value) = unlines
@ -31,6 +33,7 @@ instance Show Config where
valuetype (BoolConfig _) = "Bool"
valuetype (StringConfig _) = "String"
valuetype (MaybeStringConfig _) = "Maybe String"
valuetype (MaybeBoolConfig _) = "Maybe Bool"
writeSysConfig :: [Config] -> IO ()
writeSysConfig config = writeFile "Build/SysConfig.hs" body
@ -109,6 +112,9 @@ testEnd (Config _ (BoolConfig False)) = status "no"
testEnd (Config _ (StringConfig s)) = status s
testEnd (Config _ (MaybeStringConfig (Just s))) = status s
testEnd (Config _ (MaybeStringConfig Nothing)) = status "not available"
testEnd (Config _ (MaybeBoolConfig (Just True))) = status "yes"
testEnd (Config _ (MaybeBoolConfig (Just False))) = status "no"
testEnd (Config _ (MaybeBoolConfig Nothing)) = status "unknown"
status :: String -> IO ()
status s = putStrLn $ ' ':s