diff options
| -rw-r--r-- | Command/Sync.hs | 9 | ||||
| -rw-r--r-- | Test.hs | 71 |
2 files changed, 50 insertions, 30 deletions
diff --git a/Command/Sync.hs b/Command/Sync.hs index 33b30df13..22a6b6f4d 100644 --- a/Command/Sync.hs +++ b/Command/Sync.hs @@ -434,13 +434,14 @@ resolveMerge' u d <- fromRepo gitAnnexMergeDir l <- liftIO $ dirContentsRecursive (d </> item) if null l - then go (d </> item) - else mapM_ go l + then go d (d </> item) + else mapM_ (go d) l where - go f = do + go d f = do v <- getAnnexLinkTarget f + let worktreef = makeRelative d f case v of - Just target -> stageSymlink f + Just target -> stageSymlink worktreef =<< hashSymlink target Nothing -> noop @@ -33,6 +33,8 @@ import qualified Backend import qualified Git.CurrentRepo import qualified Git.Filename import qualified Git.Types +import qualified Git.Ref +import qualified Git.LsTree import qualified Locations import qualified Types.KeySource import qualified Types.Backend @@ -199,7 +201,7 @@ unitTests note getenv = testGroup ("Unit Tests " ++ note) , check "union merge regression" test_union_merge_regression , check "conflict resolution" test_conflict_resolution_movein_bug , check "conflict resolution (mixed directory and file)" test_mixed_conflict_resolution - , check "conflict resolution (mixed directory and file) 2" test_mixed_conflict_resolution2 + , check "conflict resolution symlinks" test_conflict_resolution_symlinks , check "conflict resolution (uncommitted local file)" test_uncommitted_conflict_resolution , check "map" test_map , check "uninit" test_uninit @@ -824,7 +826,7 @@ test_mixed_conflict_resolution env = do indir env r2 $ do disconnectOrigin createDirectory conflictor - writeFile (conflictor </> "subfile") "subfile" + writeFile subfile "subfile" git_annex env "add" [conflictor] @? "add conflicter failed" git_annex env "sync" [] @? "sync failed in r2" pair env r1 r2 @@ -834,12 +836,21 @@ test_mixed_conflict_resolution env = do checkmerge "r1" r1 checkmerge "r1" r2 conflictor = "conflictor" + subfile = conflictor </> "subfile" variantprefix = conflictor ++ ".variant" checkmerge what d = do doesDirectoryExist (d </> conflictor) @? (d ++ " conflictor directory missing") l <- getDirectoryContents d - any (variantprefix `isPrefixOf`) l + let v = filter (variantprefix `isPrefixOf`) l + not (null v) @? (what ++ " conflictor file missing in: " ++ show l ) + -- Make sure that files after conflict resolution are + -- annexed, particularly on filesystems without symlinks, + -- it's possible to lose track. + indir env d $ do + git_annex env "get" (conflictor:v) @? ("get failed in " ++ what) + git_annex_expectoutput env "find" [conflictor] [subfile] + git_annex_expectoutput env "find" v v {- Check merge conflict resolution when there is a local file, - that is not staged or committed, that conflicts with what's being added @@ -888,30 +899,37 @@ test_uncommitted_conflict_resolution env = do localcontent = "local" annexedcontent = "annexed" -{- - - During conflict resolution, one of the annexed files in git is - - accidentially converted from a symlink to a regular file. - - This only happens on crippled filesystems. - - - - This test case happens to detect the problem when it tries the next - - pass of conflict resolution, since it's unable to resolve a conflict - - between an annexed and non-annexed file. +{- On Windows/FAT, repeated conflict resolution sometimes + - lost track of whether a file was a symlink. -} -test_mixed_conflict_resolution2 :: TestEnv -> Assertion -test_mixed_conflict_resolution2 env = go >> go - where - go = withtmpclonerepo env False $ \r1 -> +test_conflict_resolution_symlinks :: TestEnv -> Assertion +test_conflict_resolution_symlinks env = do + withtmpclonerepo env False $ \r1 -> withtmpclonerepo env False $ \r2 -> do - indir env r1 $ do - writeFile conflictor "conflictor" - git_annex env "add" [conflictor] @? "add conflicter failed" - git_annex env "sync" [] @? "sync failed in r1" - indir env r2 $ do - createDirectory conflictor - writeFile (conflictor </> "subfile") "subfile" - git_annex env "add" [conflictor] @? "add conflicter failed" - git_annex env "sync" [] @? "sync failed in r2" + withtmpclonerepo env False $ \r3 -> do + indir env r1 $ do + writeFile conflictor "conflictor" + git_annex env "add" [conflictor] @? "add conflicter failed" + git_annex env "sync" [] @? "sync failed in r1" + check_is_link conflictor "r1" + indir env r2 $ do + createDirectory conflictor + writeFile (conflictor </> "subfile") "subfile" + git_annex env "add" [conflictor] @? "add conflicter failed" + git_annex env "sync" [] @? "sync failed in r2" + check_is_link (conflictor </> "subfile") "r2" + indir env r3 $ do + writeFile conflictor "conflictor" + git_annex env "add" [conflictor] @? "add conflicter failed" + git_annex env "sync" [] @? "sync failed in r1" + check_is_link (conflictor </> "subfile") "r3" + where conflictor = "conflictor" + check_is_link f what = do + git_annex_expectoutput env "find" ["--include=*", f] [f] + l <- annexeval $ Annex.inRepo $ Git.LsTree.lsTreeFiles Git.Ref.headRef [f] + all (\i -> Git.Types.toBlobType (Git.LsTree.mode i) == Just Git.Types.SymlinkBlob) l + @? (what ++ " " ++ f ++ " lost symlink bit after merge: " ++ show l) {- Set up repos as remotes of each other. -} pair :: TestEnv -> FilePath -> FilePath -> Assertion @@ -1392,7 +1410,8 @@ prepareTestEnv forcedirect = do cwd <- getCurrentDirectory p <- Utility.Env.getEnvDefault "PATH" "" - let env = + env <- Utility.Env.getEnvironment + let newenv = -- Ensure that the just-built git annex is used. [ ("PATH", cwd ++ [searchPathSeparator] ++ p) , ("TOPDIR", cwd) @@ -1408,7 +1427,7 @@ prepareTestEnv forcedirect = do , ("FORCEDIRECT", if forcedirect then "1" else "") ] - return $ M.fromList env + return $ M.fromList newenv `M.union` M.fromList env changeToTmpDir :: TestEnv -> FilePath -> IO () changeToTmpDir env t = do |