fix test suite when run by root
This commit is contained in:
parent
948691e893
commit
dbdcb67f79
1 changed files with 9 additions and 5 deletions
14
test.hs
14
test.hs
|
@ -577,10 +577,14 @@ checkcontent f = do
|
||||||
|
|
||||||
checkunwritable :: FilePath -> Assertion
|
checkunwritable :: FilePath -> Assertion
|
||||||
checkunwritable f = do
|
checkunwritable f = do
|
||||||
r <- try $ writeFile f $ content f
|
-- Look at permissions bits rather than trying to write or using
|
||||||
case r of
|
-- fileAccess because if run as root, any file can be modified
|
||||||
Left _ -> return () -- expected permission error
|
-- despite permissions.
|
||||||
Right _ -> assertFailure $ "was able to modify annexed file's " ++ f ++ " content"
|
s <- getFileStatus f
|
||||||
|
let mode = fileMode s
|
||||||
|
if (mode == mode `unionFileModes` ownerWriteMode)
|
||||||
|
then assertFailure $ "able to modify annexed file's " ++ f ++ " content"
|
||||||
|
else return ()
|
||||||
|
|
||||||
checkwritable :: FilePath -> Assertion
|
checkwritable :: FilePath -> Assertion
|
||||||
checkwritable f = do
|
checkwritable f = do
|
||||||
|
@ -640,7 +644,7 @@ runchecks (a:as) f = do
|
||||||
|
|
||||||
annexed_notpresent :: FilePath -> Assertion
|
annexed_notpresent :: FilePath -> Assertion
|
||||||
annexed_notpresent = runchecks
|
annexed_notpresent = runchecks
|
||||||
[checklink, checkdangling, checkunwritable, notinlocationlog]
|
[checklink, checkdangling, notinlocationlog]
|
||||||
|
|
||||||
annexed_present :: FilePath -> Assertion
|
annexed_present :: FilePath -> Assertion
|
||||||
annexed_present = runchecks
|
annexed_present = runchecks
|
||||||
|
|
Loading…
Reference in a new issue