100% pass on FAT
This commit is contained in:
parent
aa569500d5
commit
7db739f6c4
1 changed files with 34 additions and 29 deletions
35
Test.hs
35
Test.hs
|
@ -134,15 +134,13 @@ tests crippledfilesystem opts = testGroup "Tests" $ properties :
|
||||||
where
|
where
|
||||||
testmodes = catMaybes
|
testmodes = catMaybes
|
||||||
[ Just ("v6 unlocked", (testMode opts "6") { unlockedFiles = True })
|
[ Just ("v6 unlocked", (testMode opts "6") { unlockedFiles = True })
|
||||||
, Just ("v5", testMode opts "5")
|
, unlesscrippled ("v5", testMode opts "5")
|
||||||
, if crippledfilesystem
|
, unlesscrippled ("v6 locked", testMode opts "6")
|
||||||
then Nothing
|
|
||||||
else Just ("v6 locked", testMode opts "6")
|
|
||||||
#ifndef mingw32_HOST_OS
|
|
||||||
-- Windows will only use direct mode, so don't test twice.
|
|
||||||
, Just ("v5 direct", (testMode opts "5") { forceDirect = True })
|
, Just ("v5 direct", (testMode opts "5") { forceDirect = True })
|
||||||
#endif
|
|
||||||
]
|
]
|
||||||
|
unlesscrippled v
|
||||||
|
| crippledfilesystem = Nothing
|
||||||
|
| otherwise = Just v
|
||||||
|
|
||||||
properties :: TestTree
|
properties :: TestTree
|
||||||
properties = localOption (QuickCheckTests 1000) $ testGroup "QuickCheck"
|
properties = localOption (QuickCheckTests 1000) $ testGroup "QuickCheck"
|
||||||
|
@ -830,8 +828,12 @@ test_unused = intmpclonerepoInDirect $ do
|
||||||
checkunused [] "after dropunused"
|
checkunused [] "after dropunused"
|
||||||
not <$> git_annex "dropunused" ["--force", "10", "501"] @? "dropunused failed to fail on bogus numbers"
|
not <$> git_annex "dropunused" ["--force", "10", "501"] @? "dropunused failed to fail on bogus numbers"
|
||||||
|
|
||||||
-- unused used to miss renamed symlinks that were not staged
|
-- Unused used to miss renamed symlinks that were not staged
|
||||||
-- and pointed at annexed content, and think that content was unused
|
-- and pointed at annexed content, and think that content was unused.
|
||||||
|
-- This is only relevant when using locked files; if the file is
|
||||||
|
-- unlocked, the work tree file has the content, and there's no way
|
||||||
|
-- to associate it with the key.
|
||||||
|
unlessM (unlockedFiles <$> getTestMode) $ do
|
||||||
writeFile "unusedfile" "unusedcontent"
|
writeFile "unusedfile" "unusedcontent"
|
||||||
git_annex "add" ["unusedfile"] @? "add of unusedfile failed"
|
git_annex "add" ["unusedfile"] @? "add of unusedfile failed"
|
||||||
unusedfilekey <- getKey backendSHA256E "unusedfile"
|
unusedfilekey <- getKey backendSHA256E "unusedfile"
|
||||||
|
@ -1765,14 +1767,15 @@ cleanup' final dir = whenM (doesDirectoryExist dir) $ do
|
||||||
removeDirectoryRecursive dir
|
removeDirectoryRecursive dir
|
||||||
|
|
||||||
checklink :: FilePath -> Assertion
|
checklink :: FilePath -> Assertion
|
||||||
checklink f = ifM (annexeval Config.crippledFileSystem)
|
checklink f =
|
||||||
|
-- in direct mode, it may be a symlink, or not, depending
|
||||||
|
-- on whether the content is present.
|
||||||
|
unlessM (annexeval Config.isDirect) $
|
||||||
|
ifM (annexeval Config.crippledFileSystem)
|
||||||
( (isJust <$> annexeval (Annex.Link.getAnnexLinkTarget f))
|
( (isJust <$> annexeval (Annex.Link.getAnnexLinkTarget f))
|
||||||
@? f ++ " is not a (crippled) symlink"
|
@? f ++ " is not a (crippled) symlink"
|
||||||
, do
|
, do
|
||||||
s <- getSymbolicLinkStatus f
|
s <- getSymbolicLinkStatus f
|
||||||
-- in direct mode, it may be a symlink, or not, depending
|
|
||||||
-- on whether the content is present.
|
|
||||||
unlessM (annexeval Config.isDirect) $
|
|
||||||
isSymbolicLink s @? f ++ " is not a symlink"
|
isSymbolicLink s @? f ++ " is not a symlink"
|
||||||
)
|
)
|
||||||
|
|
||||||
|
@ -1876,8 +1879,10 @@ annexed_present f = ifM (unlockedFiles <$> getTestMode)
|
||||||
)
|
)
|
||||||
|
|
||||||
annexed_present_locked :: FilePath -> Assertion
|
annexed_present_locked :: FilePath -> Assertion
|
||||||
annexed_present_locked = runchecks
|
annexed_present_locked f = ifM (annexeval Config.crippledFileSystem)
|
||||||
[checklink, checkcontent, checkunwritable, inlocationlog]
|
( runchecks [checklink, inlocationlog] f
|
||||||
|
, runchecks [checklink, checkcontent, checkunwritable, inlocationlog] f
|
||||||
|
)
|
||||||
|
|
||||||
annexed_present_unlocked :: FilePath -> Assertion
|
annexed_present_unlocked :: FilePath -> Assertion
|
||||||
annexed_present_unlocked = runchecks
|
annexed_present_unlocked = runchecks
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue