From 52971b3d94d77ac11f78ec57c1552507e6ccab9d Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Thu, 6 Feb 2014 20:33:30 -0400
Subject: add regression test for symlink calculation

Note: Test reordered because running git-annex sync early broke the
environment for some other tests.
---
 Test.hs         | 39 +++++++++++++++++++++++++--------------
 Utility/Path.hs |  1 +
 2 files changed, 26 insertions(+), 14 deletions(-)

diff --git a/Test.hs b/Test.hs
index 3def4a2ad..0fba72eb2 100644
--- a/Test.hs
+++ b/Test.hs
@@ -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
diff --git a/Utility/Path.hs b/Utility/Path.hs
index 817cee480..27f39d3e5 100644
--- a/Utility/Path.hs
+++ b/Utility/Path.hs
@@ -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
-- 
cgit v1.2.3