add regression test for symlink calculation

Note: Test reordered because running git-annex sync early broke the
environment for some other tests.
This commit is contained in:
Joey Hess 2014-02-06 20:33:30 -04:00
parent f404379716
commit dc3b7effd2
2 changed files with 26 additions and 14 deletions

39
Test.hs
View file

@ -22,6 +22,7 @@ import qualified Data.Map as M
import System.IO.HVFS (SystemFS(..))
import qualified Text.JSON
import System.Path
import qualified Data.ByteString.Lazy as L
import Common
@ -31,6 +32,7 @@ import qualified Annex.UUID
import qualified Backend
import qualified Git.CurrentRepo
import qualified Git.Filename
import qualified Git.Types
import qualified Locations
import qualified Types.KeySource
import qualified Types.Backend
@ -50,6 +52,7 @@ import qualified Config
import qualified Config.Cost
import qualified Crypto
import qualified Annex.Init
import qualified Annex.CatFile
import qualified Utility.Path
import qualified Utility.FileMode
import qualified Build.SysConfig
@ -157,7 +160,6 @@ unitTests :: String -> IO TestEnv -> TestTree
unitTests note getenv = testGroup ("Unit Tests " ++ note)
[ check "add sha1dup" test_add_sha1dup
, check "add extras" test_add_extras
, check "add subdirs" test_add_subdirs
, check "reinject" test_reinject
, check "unannex (no copy)" test_unannex_nocopy
, check "unannex (with copy)" test_unannex_withcopy
@ -200,6 +202,7 @@ unitTests note getenv = testGroup ("Unit Tests " ++ note)
, check "bup remote" test_bup_remote
, check "crypto" test_crypto
, check "preferred content" test_preferred_content
, check "add subdirs" test_add_subdirs
]
where
check desc t = testCase desc (getenv >>= t)
@ -251,19 +254,6 @@ test_add_extras env = intmpclonerepo env $ do
annexed_present wormannexedfile
checkbackend wormannexedfile backendWORM
test_add_subdirs :: TestEnv -> Assertion
test_add_subdirs env = intmpclonerepo env $ do
createDirectory "dir"
writeFile ("dir" </> "foo") $ content annexedfile
git_annex env "add" ["dir"] @? "add of subdir failed"
createDirectory "dir2"
writeFile ("dir2" </> "foo") $ content annexedfile
#ifndef mingw32_HOST_OS
{- This does not work on Windows, for whatever reason. -}
setCurrentDirectory "dir"
git_annex env "add" [".." </> "dir2"] @? "add of ../subdir failed"
#endif
test_reinject :: TestEnv -> Assertion
test_reinject env = intmpclonerepoInDirect env $ do
git_annex env "drop" ["--force", sha1annexedfile] @? "drop failed"
@ -1069,6 +1059,27 @@ test_crypto env = do
test_crypto _env = putStrLn "gpg testing not implemented on Windows"
#endif
test_add_subdirs :: TestEnv -> Assertion
test_add_subdirs env = intmpclonerepo env $ do
createDirectory "dir"
writeFile ("dir" </> "foo") $ "dir/" ++ content annexedfile
git_annex env "add" ["dir"] @? "add of subdir failed"
{- Regression test for Windows bug where symlinks were not
- calculated correctly for files in subdirs. -}
git_annex env "sync" [] @? "sync failed"
l <- annexeval $ encodeW8 . L.unpack <$> Annex.CatFile.catObject (Git.Types.Ref "HEAD:dir/foo")
"../.git/annex/" `isPrefixOf` l @? ("symlink from subdir to .git/annex is wrong: " ++ l)
#ifndef mingw32_HOST_OS
{- This does not work on Windows, for whatever reason. -}
createDirectory "dir2"
writeFile ("dir2" </> "foo") $ content annexedfile
setCurrentDirectory "dir"
git_annex env "add" [".." </> "dir2"] @? "add of ../subdir failed"
#endif
-- This is equivilant to running git-annex, but it's all run in-process
-- (when the OS allows) so test coverage collection works.
git_annex :: TestEnv -> String -> [String] -> IO Bool

View file

@ -47,6 +47,7 @@ absNormPath dir path = Just $ combine dir path
{- On Windows, this converts the paths to unix-style, in order to run
- MissingH's absNormPath on them. Resulting path will use / separators. -}
absNormPathUnix :: FilePath -> FilePath -> Maybe FilePath
#ifndef mingw32_HOST_OS
absNormPathUnix dir path = MissingH.absNormPath dir path
#else