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 System.IO.HVFS (SystemFS(..))
import qualified Text.JSON import qualified Text.JSON
import System.Path import System.Path
import qualified Data.ByteString.Lazy as L
import Common import Common
@ -31,6 +32,7 @@ import qualified Annex.UUID
import qualified Backend import qualified Backend
import qualified Git.CurrentRepo import qualified Git.CurrentRepo
import qualified Git.Filename import qualified Git.Filename
import qualified Git.Types
import qualified Locations import qualified Locations
import qualified Types.KeySource import qualified Types.KeySource
import qualified Types.Backend import qualified Types.Backend
@ -50,6 +52,7 @@ import qualified Config
import qualified Config.Cost import qualified Config.Cost
import qualified Crypto import qualified Crypto
import qualified Annex.Init import qualified Annex.Init
import qualified Annex.CatFile
import qualified Utility.Path import qualified Utility.Path
import qualified Utility.FileMode import qualified Utility.FileMode
import qualified Build.SysConfig import qualified Build.SysConfig
@ -157,7 +160,6 @@ unitTests :: String -> IO TestEnv -> TestTree
unitTests note getenv = testGroup ("Unit Tests " ++ note) unitTests note getenv = testGroup ("Unit Tests " ++ note)
[ check "add sha1dup" test_add_sha1dup [ check "add sha1dup" test_add_sha1dup
, check "add extras" test_add_extras , check "add extras" test_add_extras
, check "add subdirs" test_add_subdirs
, check "reinject" test_reinject , check "reinject" test_reinject
, check "unannex (no copy)" test_unannex_nocopy , check "unannex (no copy)" test_unannex_nocopy
, check "unannex (with copy)" test_unannex_withcopy , 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 "bup remote" test_bup_remote
, check "crypto" test_crypto , check "crypto" test_crypto
, check "preferred content" test_preferred_content , check "preferred content" test_preferred_content
, check "add subdirs" test_add_subdirs
] ]
where where
check desc t = testCase desc (getenv >>= t) check desc t = testCase desc (getenv >>= t)
@ -251,19 +254,6 @@ test_add_extras env = intmpclonerepo env $ do
annexed_present wormannexedfile annexed_present wormannexedfile
checkbackend wormannexedfile backendWORM 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 :: TestEnv -> Assertion
test_reinject env = intmpclonerepoInDirect env $ do test_reinject env = intmpclonerepoInDirect env $ do
git_annex env "drop" ["--force", sha1annexedfile] @? "drop failed" 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" test_crypto _env = putStrLn "gpg testing not implemented on Windows"
#endif #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 -- This is equivilant to running git-annex, but it's all run in-process
-- (when the OS allows) so test coverage collection works. -- (when the OS allows) so test coverage collection works.
git_annex :: TestEnv -> String -> [String] -> IO Bool 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 {- On Windows, this converts the paths to unix-style, in order to run
- MissingH's absNormPath on them. Resulting path will use / separators. -} - MissingH's absNormPath on them. Resulting path will use / separators. -}
absNormPathUnix :: FilePath -> FilePath -> Maybe FilePath
#ifndef mingw32_HOST_OS #ifndef mingw32_HOST_OS
absNormPathUnix dir path = MissingH.absNormPath dir path absNormPathUnix dir path = MissingH.absNormPath dir path
#else #else