diff --git a/darcs.cabal b/darcs.cabal --- a/darcs.cabal +++ b/darcs.cabal @@ -1,5 +1,5 @@ Name: darcs -version: 2.10.0 +version: 2.10.1 License: GPL License-file: COPYING Author: David Roundy , @@ -112,6 +112,7 @@ flag warn-as-error default: False + manual: True description: Build with warnings-as-errors -- To allow building with containers < 0.5, we keep a local copy of this @@ -136,6 +137,10 @@ flag use-time-1point5 default: False +flag network-uri + description: Get Network.URI from the network-uri package + default: True + -- ---------------------------------------------------------------------- -- darcs library -- ---------------------------------------------------------------------- @@ -435,7 +440,7 @@ vector >= 0.7 && < 0.11, tar == 0.4.*, data-ordlist == 0.4.*, - attoparsec >= 0.11 && < 0.13, + attoparsec >= 0.11 && < 0.14, zip-archive >= 0.2.3 && < 0.3 if !os(windows) @@ -487,8 +492,11 @@ includes: curl/curl.h if flag(http) - build-depends: network >= 2.3 && < 2.5, - HTTP >= 4000.2.3 && < 4000.3 + if flag(network-uri) + build-depends: network-uri == 2.6.*, network == 2.6.* + else + build-depends: network >= 2.3 && < 2.6 + build-depends: HTTP >= 4000.2.3 && < 4000.3 cpp-options: -DHAVE_HTTP x-have-http: @@ -497,11 +505,11 @@ build-depends: mmap >= 0.5 && < 0.6 - build-depends: zlib >= 0.5.3.0 && < 0.6.0.0 + build-depends: zlib >= 0.5.3.0 && < 0.7.0.0 -- The terminfo package cannot be built on Windows. if flag(terminfo) && !os(windows) - build-depends: terminfo == 0.3.* + build-depends: terminfo >= 0.3 && < 0.5 cpp-options: -DHAVE_TERMINFO -- if true to work around cabal bug with flag ordering @@ -652,12 +660,12 @@ mtl >= 2.1 && < 2.3, parsec >= 3.1 && < 3.2, regex-compat-tdfa >= 0.95.1 && < 0.96, - shelly >= 1.6 && < 1.7, + shelly >= 1.6.2 && < 1.7, split >= 0.1.4.1 && < 0.3, text >= 0.11.0.6 && < 1.3, directory >= 1.1.0.2 && < 1.3.0.0, FindBin >= 0.0 && < 0.1, - QuickCheck >= 2.3 && < 2.8, + QuickCheck >= 2.3 && < 2.9, HUnit >= 1.0 && < 1.3, test-framework >= 0.4.0 && < 0.9, test-framework-hunit >= 0.2.2 && < 0.4, diff --git a/harness/Darcs/Test/Patch.hs b/harness/Darcs/Test/Patch.hs --- a/harness/Darcs/Test/Patch.hs +++ b/harness/Darcs/Test/Patch.hs @@ -366,7 +366,7 @@ , testGroup "Darcs.Patch.V2 (using Prim.V1)" $ unit_V2P1 ++ qc_V2 (undefined :: V1.Prim wX wY) ++ qc_V2P1 ++ general_patchTests (PatchType :: PatchType (RealPatch V1.Prim)) - , testGroup "Darcs.Patch.Prim.V3" $ qc_prim (undefined :: V3.Prim wX wY) + -- , testGroup "Darcs.Patch.Prim.V3" $ qc_prim (undefined :: V3.Prim wX wY) , testGroup "Darcs.Patch.V2 (using Prim.V3)" $ qc_V2 (undefined :: V3.Prim wX wY) ++ general_patchTests (PatchType :: PatchType (RealPatch V3.Prim)) diff --git a/harness/test.hs b/harness/test.hs --- a/harness/test.hs +++ b/harness/test.hs @@ -86,7 +86,8 @@ setenv "GHC_VERSION" $ pack $ show (__GLASGOW_HASKELL__ :: Int) mkdir ".darcs" writefile ".darcs/defaults" defaults - _ <- Shelly.run "bash" [ "test" ] + _ <- onCommandHandles (initOutputHandles (\h -> hSetBinaryMode h True)) $ + Shelly.run "bash" [ "test" ] return Success `catch_sh` \(_::SomeException) -> do code <- lastExitCode diff --git a/hashed-storage/Storage/Hashed/Monad.hs b/hashed-storage/Storage/Hashed/Monad.hs --- a/hashed-storage/Storage/Hashed/Monad.hs +++ b/hashed-storage/Storage/Hashed/Monad.hs @@ -192,12 +192,8 @@ expandTo p = do t <- gets tree p' <- (`catPaths` p) `fmap` ask - let amend = do t' <- lift $ expandPath t p' - modify $ \st -> st { tree = t' } - case find t p' of - Nothing -> amend - Just (Stub _ _) -> amend - _ -> return () + t' <- lift $ expandPath t p' + modify $ \st -> st { tree = t' } return p' fileExists p = diff --git a/hashed-storage/Storage/Hashed/Test.hs b/hashed-storage/Storage/Hashed/Test.hs --- a/hashed-storage/Storage/Hashed/Test.hs +++ b/hashed-storage/Storage/Hashed/Test.hs @@ -324,7 +324,7 @@ (Just LT == runIdentity (t2 `cmpExpandedShape` t1)) ==> runIdentity $ (t1 `overlay` t2) `expandedShapeEq` t1 prop_overlay_super (t1 :: Tree Identity, t2) = - (Just LT == runIdentity (t2 `cmpExpandedShape` t1)) ==> + (Just LT == runIdentity (t2 `cmpExpandedShape` t1)) && no_stubs t2 ==> Just EQ == (runIdentity $ restrict t2 (t1 `overlay` t2) `cmpTree` t2) prop_expandPath (TreeWithPath t p) = notStub $ find (runIdentity $ expandPath t p) p diff --git a/release/distributed-context b/release/distributed-context --- a/release/distributed-context +++ b/release/distributed-context @@ -1,1 +1,1 @@ -Just "\nContext:\n\n[TAG 2.10.0\nGuillaume Hoffmann **20150419200705\n Ignore-this: 6d154c9aa51c8328c777ca9a2c223125\n] \n" +Just "\nContext:\n\n[TAG 2.10.1\nGuillaume Hoffmann **20150709164849\n Ignore-this: 91f5dd97c5899801364cdfc0a8266faa\n] \n" diff --git a/src/Darcs/Patch/Match.hs b/src/Darcs/Patch/Match.hs --- a/src/Darcs/Patch/Match.hs +++ b/src/Darcs/Patch/Match.hs @@ -379,7 +379,7 @@ -- true, but not @--from-patch@ or @--to-patch@. haveNonrangeMatch :: forall p . Matchable p => PatchType p -> [MatchFlag] -> Bool haveNonrangeMatch _ fs = - isJust (hasIndexRange fs) + case hasIndexRange fs of Just (m,n) | m == n -> True; _ -> False || isJust (nonrangeMatcher fs::Maybe (Matcher p)) -- | @havePatchsetMatch flags@ tells whether there is a "patchset diff --git a/src/Darcs/Repository.hs b/src/Darcs/Repository.hs --- a/src/Darcs/Repository.hs +++ b/src/Darcs/Repository.hs @@ -667,23 +667,20 @@ unpackTar c mh xs _ -> fail "Unexpected non-file tar entry" where - writeFile' Nothing z y = withTemp $ \x' -> do - BL.writeFile x' y - renameFile x' z - writeFile' (Just ca) z y = do - let fileFullPath = case splitPath z of + writeFile' Nothing path content = withTemp $ \tmp -> do + BL.writeFile tmp content + renameFile tmp path + writeFile' (Just ca) path content = do + let fileFullPath = case splitPath path of _:hDir:hFile:_ -> joinPath [ca, hDir, bucketFolder hFile, hFile] _ -> fail "Unexpected file path" - ex <- doesFileExist fileFullPath - if ex - then createLink' fileFullPath z - else withTemp $ \x'' -> do - BL.writeFile x'' y - createLink' x'' fileFullPath - renameFile x'' z - createLink' z y = do - createDirectoryIfMissing True $ takeDirectory y - createLink z y `catchall` return () + createDirectoryIfMissing True $ takeDirectory path + createLink fileFullPath path `catch` (\(ex :: IOException) -> do + if isAlreadyExistsError ex then + return () -- so much the better + else + -- ignore cache if we cannot link + writeFile' Nothing path content) basicMetaHandler :: Cache -> MVar () -> IO () basicMetaHandler ca mv = do diff --git a/src/Darcs/Repository/Match.hs b/src/Darcs/Repository/Match.hs --- a/src/Darcs/Repository/Match.hs +++ b/src/Darcs/Repository/Match.hs @@ -32,6 +32,8 @@ , getMatchingTag , matchAPatchset , nonrangeMatcher + , applyNInv + , hasIndexRange , MatchFlag(..) ) @@ -58,7 +60,11 @@ => Repository p wR wU wT -> [MatchFlag] -> IO () -getNonrangeMatch r fs = withRecordedMatch r (getNonrangeMatchS fs) +getNonrangeMatch r = withRecordedMatch r . getMatch where + getMatch fs = case hasIndexRange fs of + Just (n, m) | n == m -> applyNInv (n-1) + | otherwise -> fail "Index range is not allowed for this command." + _ -> getNonrangeMatchS fs getPartialNonrangeMatch :: (RepoPatch p, ApplyMonad DefaultIO (ApplyState p), ApplyState p ~ Tree) => Repository p wR wU wT diff --git a/src/Darcs/UI/Commands.hs b/src/Darcs/UI/Commands.hs --- a/src/Darcs/UI/Commands.hs +++ b/src/Darcs/UI/Commands.hs @@ -231,6 +231,8 @@ , "Use 'darcs --exact-version' to see a detailed darcs version." , "Use 'darcs help patterns' for help on patch matching." , "Use 'darcs help environment' for help on environment variables." + , "Use 'darcs help manpage' to display help in the manpage format." + , "Use 'darcs help markdown' to display help in the markdown format." , "" , "Check bug reports at http://bugs.darcs.net/" ] diff --git a/src/Darcs/UI/Commands/Diff.hs b/src/Darcs/UI/Commands/Diff.hs --- a/src/Darcs/UI/Commands/Diff.hs +++ b/src/Darcs/UI/Commands/Diff.hs @@ -28,7 +28,9 @@ import Data.List ( (\\) ) import Storage.Hashed.Plain( writePlainTree ) import Storage.Hashed.Darcs( hashedTreeIO ) - +import Data.Maybe ( isJust ) +import System.Directory ( findExecutable ) + import Darcs.Util.CommandLine ( parseCmd ) import Darcs.UI.External ( diffProgram @@ -248,15 +250,22 @@ rundiff f1 f2 = do cmd <- diffProgram case getDiffCmdAndArgs cmd opts f1 f2 of - Left err -> fail err - Right (d_cmd, d_args) -> - let pausingForGui = (wantGuiPause opts == YesWantGuiPause) in - do when pausingForGui $ putStrLn $ - "Running command '" ++ unwords (d_cmd:d_args) ++ "'" - output <- execPipeIgnoreError Encode d_cmd d_args empty - when pausingForGui $ - askEnter "Hit return to move on..." - return output + Left err -> fail err + Right (d_cmd, d_args) -> do + if length (filter (==f1) d_args) /= 1 || length (filter (==f2) d_args) /= 1 + then fail $ "Invalid argument (%1 or %2) in --diff-command" + else return () + cmdExists <- findExecutable d_cmd + if isJust cmdExists + then return () + else fail $ d_cmd ++ " is not an executable in --diff-command" + let pausingForGui = (wantGuiPause opts == YesWantGuiPause) in + do when pausingForGui $ putStrLn $ + "Running command '" ++ unwords (d_cmd:d_args) ++ "'" + output <- execPipeIgnoreError Encode d_cmd d_args empty + when pausingForGui $ + askEnter "Hit return to move on..." + return output getDiffInfo :: RepoPatch p => [DarcsFlag] -> PatchSet p wStart wX -> [PatchInfo] getDiffInfo opts ps = diff --git a/src/Darcs/UI/Commands/Dist.hs b/src/Darcs/UI/Commands/Dist.hs --- a/src/Darcs/UI/Commands/Dist.hs +++ b/src/Darcs/UI/Commands/Dist.hs @@ -27,6 +27,7 @@ ( dist , doFastZip -- libdarcs export + , doFastZip' ) where import Prelude hiding ( (^), writeFile ) @@ -70,7 +71,7 @@ ( getFirstMatch , getNonrangeMatch ) -import Darcs.Repository ( withRepository, RepoJob(..), +import Darcs.Repository ( withRepository, withRepositoryDirectory, RepoJob(..), setScriptsExecutable, repoPatchType, createPartialsPristineDirectoryTree ) import Darcs.Repository.Prefs ( getPrefval ) @@ -214,19 +215,28 @@ doFastZip :: [DarcsFlag] -> IO () -doFastZip opts = withRepository (useCache opts) $ RepoJob $ \(Repo _ _ _ c) -> do - when (SetScriptsExecutable `elem` opts) $ - putStrLn "WARNING: Zip archives cannot store executable flag." +doFastZip opts = do currentdir <- getCurrentDirectory - let distname = getDistName currentdir [x | DistName x <- opts] - i <- fetchFilePS (darcsdir "hashed_inventory") Uncachable + let distname = getDistName currentdir [x | DistName x <- opts] + let resultfile = currentdir distname ++ ".zip" + doFastZip' opts currentdir (writeFile resultfile) + when (Quiet `notElem` opts) $ putStrLn $ "Created " ++ resultfile + +doFastZip' :: [DarcsFlag] -- ^ Flags/options + -> FilePath -- ^ The path to the repository + -> (BL.ByteString -> IO a) -- ^ An action to perform on the archive contents + -> IO a +doFastZip' opts path act = withRepositoryDirectory (useCache opts) path $ RepoJob $ \(Repo _ _ _ c) -> do + when (SetScriptsExecutable `elem` opts) $ + putStrLn "WARNING: Zip archives cannot store executable flag." + let distname = getDistName path [x | DistName x <- opts] + i <- fetchFilePS (path darcsdir "hashed_inventory") Uncachable pristine <- pathsAndContents (distname ++ "/") c (inv2pris i) epochtime <- toSeconds `fmap` getCurrentTime - let entries = [ toEntry path epochtime (toLazy contents) | (path,contents) <- pristine ] + let entries = [ toEntry filepath epochtime (toLazy contents) | (filepath,contents) <- pristine ] let archive = foldr addEntryToArchive emptyArchive entries - let resultfile = currentdir distname ++ ".zip" - writeFile resultfile $ fromArchive archive - when (Quiet `notElem` opts) $ putStrLn $ "Created " ++ resultfile + act (fromArchive archive) + toLazy :: B.ByteString -> BL.ByteString toLazy bs = BL.fromChunks [bs] diff --git a/src/Darcs/UI/Commands/Log.hs b/src/Darcs/UI/Commands/Log.hs --- a/src/Darcs/UI/Commands/Log.hs +++ b/src/Darcs/UI/Commands/Log.hs @@ -49,12 +49,13 @@ import Darcs.UI.Options ( DarcsOption, (^), odesc, ocheck, onormalise, defaultFlags, parseFlags ) import qualified Darcs.UI.Options.All as O import Darcs.Util.Path ( SubPath(), toFilePath, - fp2fn, fn2fp, normPath, AbsolutePath ) + fp2fn, fn2fp, normPath, AbsolutePath, simpleSubPath ) import Darcs.Repository ( PatchSet, PatchInfoAnd, withRepositoryDirectory, RepoJob(..), readRepo, unrecordedChanges, withRepoLockCanFail ) import Darcs.Repository.Flags ( UseIndex(..), ScanKnown(..), DiffAlgorithm(MyersDiff), UpdateWorking(..) ) +import Darcs.Repository.Lock ( withTempDir ) import Darcs.Patch.Set ( PatchSet(..), newset2RL ) import Darcs.Patch.Conflict ( Conflict, CommuteNoConflicts ) import Darcs.Patch.Format ( PatchListFormat ) @@ -88,6 +89,7 @@ vsep, (<>), ($$), errorDoc, insertBeforeLastline, empty, RenderMode(..) ) import Darcs.Util.Printer.Color ( fancyPrinters ) import Darcs.Util.Progress ( setProgressMode, debugMessage ) +import Darcs.Util.URL ( isValidLocalPath ) import Darcs.UI.SelectChanges ( viewChanges ) import qualified Darcs.UI.SelectChanges as S ( PatchSelectionOptions (..) ) import Darcs.Repository.PatchIndex ( PatchFilter, maybeFilterPatches, attemptCreatePatchIndex ) @@ -175,6 +177,13 @@ | GenContext `elem` opts = if not . null $ args then fail "log --context cannot accept other arguments" else logContext opts + | hasRemoteRepo opts = do + (fs, es) <- remoteSubPaths args [] + if null es then + withTempDir "darcs.log" (\_ -> showLog opts $ maybeNotNull $ nub $ sort fs) + else + fail $ "For a remote repo I can only handle relative paths.\n" + ++ "Invalid arguments: "++unwords es | null args = showLog opts Nothing | otherwise = do fs <- fixSubPaths fps args @@ -184,7 +193,22 @@ $ unless (NoPatchIndexFlag `elem` opts) $ withRepoLockCanFail (useCache opts) YesUpdateWorking (umask opts) $ RepoJob attemptCreatePatchIndex - showLog opts . Just . nub $ sort fs + showLog opts $ Just $ nub $ sort fs + +maybeNotNull :: [a] -> Maybe [a] +maybeNotNull [] = Nothing +maybeNotNull xs = Just xs + +hasRemoteRepo :: [DarcsFlag] -> Bool +hasRemoteRepo = maybe False (not . isValidLocalPath) . parseFlags O.possiblyRemoteRepo + +remoteSubPaths :: [String] -> [String] -> IO ([SubPath],[String]) +remoteSubPaths [] es = return ([], es) +remoteSubPaths (arg:args) es = case simpleSubPath arg of + Nothing -> remoteSubPaths args (arg:es) + Just sp -> do + (sps, es') <- remoteSubPaths args es + return (sp:sps, es') showLog :: [DarcsFlag] -> Maybe [SubPath] -> IO () showLog opts files = diff --git a/src/Darcs/UI/Commands/ShowContents.hs b/src/Darcs/UI/Commands/ShowContents.hs --- a/src/Darcs/UI/Commands/ShowContents.hs +++ b/src/Darcs/UI/Commands/ShowContents.hs @@ -19,7 +19,7 @@ import Prelude hiding ( (^) ) -import Control.Monad ( filterM, forM_, forM, unless ) +import Control.Monad ( filterM, forM_, forM ) import System.IO ( stdout ) import qualified Data.ByteString as B @@ -28,20 +28,20 @@ import Darcs.UI.Commands ( DarcsCommand(..), withStdOpts, nodefaults, findRepository ) import Darcs.UI.Flags ( DarcsFlag, useCache, fixSubPaths ) import Darcs.UI.Options ( DarcsOption, (^), oid, odesc, ocheck, onormalise, defaultFlags, parseFlags ) -import qualified Darcs.UI.Options.All as O ( MatchFlag, matchOne, workingRepoDir, StdCmdAction, Verbosity, UseCache ) -import Darcs.Patch.ApplyMonad ( withFiles ) -import Darcs.Patch.Match - ( haveNonrangeMatch - , applyInvToMatcher - , nonrangeMatcher - , InclusiveOrExclusive(..) - , matchExists - , applyNInv - , hasIndexRange ) -import Darcs.Repository ( withRepository, RepoJob(..), readRepo, readRecorded, repoPatchType ) +import qualified Darcs.UI.Options.All as O + ( MatchFlag + , matchOne + , workingRepoDir + , StdCmdAction + , Verbosity + , UseCache ) +import Darcs.Patch.Match ( haveNonrangeMatch ) +import Darcs.Repository ( withRepository, RepoJob(..), readRecorded, repoPatchType ) +import Darcs.Repository.Lock ( withDelayedDir ) +import Darcs.Repository.Match ( getNonrangeMatch ) +import Storage.Hashed.Plain( readPlainTree ) import qualified Storage.Hashed.Monad as HSM -import Darcs.Util.Path( floatPath, anchorPath, FileName, fp2fn, - sp2fn, toFilePath, AbsolutePath ) +import Darcs.Util.Path( floatPath, sp2fn, toFilePath, AbsolutePath ) showContentsDescription :: String showContentsDescription = "Outputs a specific version of a file." @@ -92,31 +92,27 @@ showContentsCmd :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO () showContentsCmd _ _ [] = fail "show contents needs at least one argument." -showContentsCmd fps opts args = withRepository (useCache opts) $ RepoJob $ \repository -> do - path_list <- map sp2fn `fmap` fixSubPaths fps args - pristine <- readRecorded repository - unapply <- let matchFlags = parseFlags O.matchOne opts - in - if haveNonrangeMatch (repoPatchType repository) matchFlags - then do - patchset <- readRepo repository - case nonrangeMatcher matchFlags of - -- Index cannot be a Matcher, so handle it manually. - Nothing -> case hasIndexRange matchFlags of - Just (n, m) | n == m -> return $ applyNInv (n-1) patchset - _ -> fail "Couldn't obtain a valid matcher." - Just m -> do - unless (matchExists m patchset) $ - fail $ "Couldn't match pattern " ++ show m - return $ applyInvToMatcher Exclusive m patchset - else return (return ()) - let dump :: HSM.TreeIO [(FileName, B.ByteString)] - dump = do - let floatedPaths = map (floatPath . toFilePath) path_list - okpaths <- filterM HSM.fileExists floatedPaths - forM okpaths $ \f -> do - content <- (B.concat . BL.toChunks) `fmap` HSM.readFile f - return (fp2fn $ ("./" ++) $ anchorPath "" f, content) - files <- flip withFiles unapply `fmap` fst - `fmap` HSM.virtualTreeIO dump pristine - forM_ files $ \(_, f) -> B.hPut stdout f +showContentsCmd fps opts args = do + floatedPaths <- map (floatPath . toFilePath . sp2fn) `fmap` fixSubPaths fps args + let matchFlags = parseFlags O.matchOne opts + withRepository (useCache opts) $ RepoJob $ \repository -> do + let readContents = do + okpaths <- filterM HSM.fileExists floatedPaths + forM okpaths $ \f -> (B.concat . BL.toChunks) `fmap` HSM.readFile f + -- Note: The two calls to execReadContents below are from + -- different working directories. This matters despite our + -- use of virtualTreeIO. + execReadContents tree = fst `fmap` HSM.virtualTreeIO readContents tree + files <- if haveNonrangeMatch (repoPatchType repository) matchFlags then + withDelayedDir "show.contents" $ \_ -> do + -- this call populates our temporary directory, but note that + -- it does so lazily: the tree gets (partly) expanded inside + -- execReadContents, so it is important that we execute the + -- latter from the same working directory. + getNonrangeMatch repository matchFlags + readPlainTree "." >>= execReadContents + else do + -- we can use the existing pristine tree because we don't modify + -- anything in this case + readRecorded repository >>= execReadContents + forM_ files $ B.hPut stdout diff --git a/src/Darcs/UI/Defaults.hs b/src/Darcs/UI/Defaults.hs --- a/src/Darcs/UI/Defaults.hs +++ b/src/Darcs/UI/Defaults.hs @@ -1,13 +1,12 @@ module Darcs.UI.Defaults ( applyDefaults ) where +import Control.Monad.Writer import Data.Char ( isSpace ) import Data.Functor.Compose ( Compose(..) ) -import Data.List ( nub ) +import Data.List ( nub, intercalate ) import Data.Maybe ( catMaybes ) import qualified Data.Map as M import System.Console.GetOpt -import System.IO ( stderr, hPutStrLn ) -import System.Exit ( exitFailure ) import Text.Regex.Applicative ( (<$>), (<*>), (*>), (<|>) , match, pure, many, some @@ -21,10 +20,7 @@ , WrappedCommand(..) ) import Darcs.UI.TheCommands ( commandControlList ) -import Darcs.Repository.Prefs ( getGlobal, getPreflist ) -import Darcs.Util.Path - ( AbsolutePath - , getCurrentDirectory ) +import Darcs.Util.Path ( AbsolutePath ) -- | Apply defaults from all sources to a list of 'DarcsFlag's (e.g. from the -- command line), given the command (and possibly super command) name, and a @@ -48,25 +44,29 @@ -- override the built-in defaults. Inside the options from a defaults file, -- options for the given command override options for the @ALL@ pseudo command. -- --- Conflicting options at the same level of precedence are not allowed. If --- encountered, the program halts with an appropriate error message. +-- Conflicting options at the same level of precedence are not allowed. +-- +-- Errors encountered during processing of command line or defaults flags +-- are formatted and added as (separate) strings to the list of error messages +-- that are returned together with the resulting flag list. applyDefaults :: Maybe String -> DarcsCommand pf + -> AbsolutePath + -> [String] + -> [String] -> [DarcsFlag] - -> IO [DarcsFlag] -applyDefaults msuper cmd flags = do - cwd <- getCurrentDirectory -- so we can build default flags with path arguments - let cmd_name = mkCmdName msuper (commandName cmd) - builtin_defs = commandDefaults cmd - check_opts = commandCheckOptions cmd - opts = uncurry (++) $ commandAlloptions cmd - get_flags source = handleEither . parseDefaults source cwd cmd_name opts check_opts - handleEither (Left err) = hPutStrLn stderr err >> exitFailure - handleEither (Right x) = return x - cl_flags <- handleEither $ checkConflictingOptions "command line" check_opts flags - user_defs <- getGlobal "defaults" >>= get_flags "user defaults" - repo_defs <- getPreflist "defaults" >>= get_flags "repo defaults" - return $ cl_flags ++ repo_defs ++ user_defs ++ builtin_defs + -> ([DarcsFlag], [String]) +applyDefaults msuper cmd cwd user repo flags = runWriter $ do + cl_flags <- runChecks "Command line" check_opts flags + user_defs <- get_flags "User defaults" user + repo_defs <- get_flags "Repo defaults" repo + return $ cl_flags ++ repo_defs ++ user_defs ++ builtin_defs + where + cmd_name = mkCmdName msuper (commandName cmd) + builtin_defs = commandDefaults cmd + check_opts = commandCheckOptions cmd + opts = uncurry (++) $ commandAlloptions cmd + get_flags source = parseDefaults source cwd cmd_name opts check_opts -- | Name of a normal command, or name of super and sub command. data CmdName = NormalCmd String | SuperCmd String String @@ -81,10 +81,12 @@ showCmdName (SuperCmd super sub) = unwords [super,sub] showCmdName (NormalCmd name) = name -checkConflictingOptions :: String -> ([DarcsFlag] -> [String]) -> [DarcsFlag] -> Either String [DarcsFlag] -checkConflictingOptions source check fs = case check fs of - [] -> Right fs - es -> Left $ unlines (source:es) +runChecks :: String -> ([DarcsFlag] -> [String]) -> [DarcsFlag] -> Writer [String] [DarcsFlag] +runChecks source check fs = case check fs of + [] -> return fs + es -> do + tell [intercalate "\n" $ map ((source++": ")++) es] + return fs -- | Parse a list of lines from a defaults file, returning a list of 'DarcsFlag', -- given the current working directory, the command name, and a list of 'DarcsOption' @@ -112,26 +114,29 @@ -> [DarcsOptDescr DarcsFlag] -> ([DarcsFlag] -> [String]) -> [String] - -> Either String [DarcsFlag] -parseDefaults source cwd cmd opts check_opts def_lines = do -- Monad (Either String) + -> Writer [String] [DarcsFlag] +parseDefaults source cwd cmd opts check_opts def_lines = do cmd_flags <- flags_for (M.keys opt_map) cmd_defs >>= - checkConflictingOptions (source++" for command '"++showCmdName cmd++"'") check_opts + runChecks (source++" for command '"++showCmdName cmd++"'") check_opts all_flags <- flags_for allOptionSwitches all_defs >>= - checkConflictingOptions (source++" for ALL commands") check_opts + runChecks (source++" for ALL commands") check_opts return $ cmd_flags ++ all_flags where opt_map = optionMap opts cmd_defs = parseDefaultsLines cmd def_lines all_defs = parseDefaultsLines (NormalCmd "ALL") def_lines to_flag all_switches (switch,arg) = - if switch `notElem` all_switches then - Left $ "Bad default option in "++source++": command '"++showCmdName cmd - ++"' has no option '"++switch++"'." + if switch `notElem` all_switches then do + tell [source++": command '"++showCmdName cmd + ++"' has no option '"++switch++"'."] + return Nothing else - defaultToFlag cwd opt_map (switch,arg) + mapErrors ((source++" for command '"++showCmdName cmd++"':"):) + $ defaultToFlag cwd opt_map (switch,arg) -- the catMaybes filters out options that are not defined -- for this command flags_for all_switches = fmap catMaybes . mapM (to_flag all_switches) + mapErrors f = mapWriter (\(r, es) -> (r, if null es then [] else f es)) -- | Result of parsing a defaults line: switch and argument(s). type Default = (String, String) @@ -190,33 +195,35 @@ defaultToFlag :: AbsolutePath -> OptionMap -> Default - -> Either String (Maybe DarcsFlag) + -> Writer [String] (Maybe DarcsFlag) defaultToFlag cwd opts (switch, arg) = case M.lookup switch opts of -- This case is not impossible! A default flag defined for ALL commands -- is not necessarily defined for the concrete command in question. - Nothing -> Right Nothing - Just opt -> fmap Just $ flag_from $ getArgDescr $ getCompose opt + Nothing -> return Nothing + Just opt -> flag_from $ getArgDescr $ getCompose opt where getArgDescr (Option _ _ a _) = a - flag_from (NoArg mkFlag) = - if null arg then - Right $ mkFlag cwd + flag_from (NoArg mkFlag) = do + if not (null arg) then do + tell ["'"++switch++"' takes no argument, but '"++arg++"' argument given."] + return Nothing else - Left $ "Bad default option: '"++switch++"' takes no argument, but '"++arg++"' argument given." + return $ Just $ mkFlag cwd flag_from (OptArg mkFlag _) = - Right $ mkFlag (if null arg then Nothing else Just arg) cwd - flag_from (ReqArg mkFlag _) = - if null arg then - Left $ "Bad default option: '"++switch++"' requires an argument, but no "++"argument given." + return $ Just $ mkFlag (if null arg then Nothing else Just arg) cwd + flag_from (ReqArg mkFlag _) = do + if null arg then do + tell ["'"++switch++"' requires an argument, but no "++"argument given."] + return Nothing else - Right $ mkFlag arg cwd + return $ Just $ mkFlag arg cwd -- | Get all the longSwitches from a list of options. optionSwitches :: [DarcsOptDescr DarcsFlag] -> [String] optionSwitches = concatMap sel where sel (Compose (Option _ switches _ _)) = switches --- | A finite map from long switches to 'DarcsAtomicOption's. +-- | A finite map from long switches to 'DarcsOptDescr's. type OptionMap = M.Map String (DarcsOptDescr DarcsFlag) -- | Build an 'OptionMap' from a list of 'DarcsOption's. diff --git a/src/Darcs/UI/Options/Util.hs b/src/Darcs/UI/Options/Util.hs --- a/src/Darcs/UI/Options/Util.hs +++ b/src/Darcs/UI/Options/Util.hs @@ -183,7 +183,7 @@ ocheck fs = case map snd (rawParse ropts fs) of [] -> [] -- error "this should not happen" [_] -> [] - ropts' -> ["conflicting flags: " ++ intercalate ", " (map (intercalate "/" . switchNames) ropts')] + ropts' -> ["conflicting options: " ++ intercalate ", " (map (intercalate "/" . switchNames) ropts')] odesc = map (addDefaultHelp dval) ropts -- * Simple primitive scalar valued options @@ -261,7 +261,7 @@ oparse k _ = k () ocheck fs = case map snd (rawParse ropts fs) of [] -> [] - ropts' -> ("deprecated flag(s): " ++ intercalate ", " (concatMap switchNames ropts')) : comments + ropts' -> ("deprecated option(s): " ++ intercalate ", " (concatMap switchNames ropts')) : comments odesc = map noDefaultHelp ropts noDefaultHelp (RawNoArg s l f _ h) = noArg s l f h noDefaultHelp (RawStrArg s l mkF _ _ _ a h) = strArg s l mkF a h diff --git a/src/Darcs/UI/RunCommand.hs b/src/Darcs/UI/RunCommand.hs --- a/src/Darcs/UI/RunCommand.hs +++ b/src/Darcs/UI/RunCommand.hs @@ -22,6 +22,7 @@ import Prelude hiding ( (^) ) import Data.Functor ((<$>)) +import Data.List ( intercalate ) import Control.Monad ( unless, when ) import System.Console.GetOpt( ArgOrder( Permute, RequireOrder ), OptDescr( Option ), @@ -35,45 +36,45 @@ , preHook, postHook ) import Darcs.UI.Defaults ( applyDefaults ) +import Darcs.UI.External ( viewDoc ) import Darcs.UI.Flags ( DarcsFlag (NewRepo), toMatchFlags, fixRemoteRepos ) -import Darcs.UI.Commands ( CommandArgs( CommandOnly, SuperCommandOnly, SuperCommandSub ), - CommandControl, - DarcsCommand, - commandName, - commandCommand, - commandPrereq, - commandExtraArgHelp, - commandExtraArgs, - commandArgdefaults, - commandGetArgPossibilities, - commandOptions, - commandParseOptions, - wrappedCommandName, - disambiguateCommands, - getCommandHelp, getCommandMiniHelp, - getSubcommands, - extractCommands, - superName, - subusage +import Darcs.UI.Commands + ( CommandArgs( CommandOnly, SuperCommandOnly, SuperCommandSub ) + , CommandControl + , DarcsCommand + , commandName + , commandCommand + , commandPrereq + , commandExtraArgHelp + , commandExtraArgs + , commandArgdefaults + , commandGetArgPossibilities + , commandOptions + , commandParseOptions + , wrappedCommandName + , disambiguateCommands + , getCommandHelp + , getCommandMiniHelp + , getSubcommands + , extractCommands + , superName + , subusage , formatPath ) import Darcs.UI.Commands.GZCRCs ( doCRCWarnings ) import Darcs.UI.Commands.Clone ( makeRepoName, cloneToSSH ) -import Darcs.UI.External ( viewDoc ) +import Darcs.Patch.Match ( checkMatchSyntax ) +import Darcs.Repository.Prefs ( getGlobal, getPreflist ) +import Darcs.Repository.Test ( runPosthook, runPrehook ) import Darcs.Util.AtExit ( atexit ) +import Darcs.Util.Download ( setDebugHTTP, disableHTTPPipelining ) import Darcs.Util.Global ( setDebugMode, setTimingsMode ) -import Darcs.Patch.Match ( checkMatchSyntax ) -import Darcs.Util.Progress ( setProgressMode ) import Darcs.Util.Path ( AbsolutePath, getCurrentDirectory, toPath, ioAbsoluteOrRemote, makeAbsolute ) - -import Darcs.Repository.Test ( runPosthook, runPrehook ) -import Data.List ( intercalate ) import Darcs.Util.Printer ( text ) -import Darcs.Util.Download ( setDebugHTTP, disableHTTPPipelining ) +import Darcs.Util.Progress ( setProgressMode ) import Darcs.Util.Text ( chompTrailingNewline ) - runTheCommand :: [CommandControl] -> String -> [String] -> IO () runTheCommand commandControlList cmd args = either fail rtc $ disambiguateCommands commandControlList cmd args @@ -89,35 +90,42 @@ runCommand msuper cmd args = do old_wd <- getCurrentDirectory let options = commandOptions old_wd cmd - case getOpt Permute options args of - (cmdline_flags,orig_extra,[]) -> do + case fixupMsgs $ getOpt Permute options args of + (cmdline_flags,orig_extra,getopt_errs) -> do + -- FIXME This code is highly order-dependent because of hidden state: the + -- current directory. Like almost all Repository functions, getGlobal and + -- getPreflist assume that the cwd is the base of our work repo (if any). + -- This is supposed to be ensured by commandPrereq. Which means we must + -- first call commandPrereq, then getGlobal and getPreflist, and then we + -- must use the (saved) original working directory to resolve possibly + -- relative paths to absolute paths. prereq_errors <- commandPrereq cmd cmdline_flags - -- Important: we must applyDefaults only after commandPrereq has been run, - -- so it sees the cwd after commandPrereq has changed it. - flags <- applyDefaults (fmap commandName msuper) cmd cmdline_flags + user_defs <- getGlobal "defaults" + repo_defs <- getPreflist "defaults" + let (flags,flag_errors) = + applyDefaults (fmap commandName msuper) cmd old_wd user_defs repo_defs cmdline_flags case parseFlags stdCmdActions flags of Just Help -> viewDoc $ text $ getCommandHelp msuper cmd Just ListOptions -> do setProgressMode False file_args <- commandGetArgPossibilities cmd - putStrLn $ unlines $ getOptionsOptions options : file_args + putStrLn $ intercalate "\n" $ getOptionsOptions options : file_args Just Disable -> fail $ "Command "++commandName cmd++" disabled with --disable option!" Nothing -> case prereq_errors of Left complaint -> fail $ "Unable to " ++ formatPath ("darcs " ++ superName msuper ++ commandName cmd) ++ " here.\n\n" ++ complaint - Right () -> do - extra <- commandArgdefaults cmd flags old_wd orig_extra - case extraArgumentsError extra cmd msuper of - Nothing -> runWithHooks cmd old_wd flags extra - Just msg -> fail msg - (_,_,ermsgs) -> fail $ chompTrailingNewline(unlines ermsgs) + Right () -> case getopt_errs ++ flag_errors of + [] -> do + extra <- commandArgdefaults cmd flags old_wd orig_extra + case extraArgumentsError extra cmd msuper of + Nothing -> runWithHooks cmd old_wd flags extra + Just msg -> fail msg + es -> fail (intercalate "\n" es) -{- removed the --debug-verbose flag - where addVerboseIfDebug opts | DebugVerbose `elem` opts = Debug:Verbose:opts - | otherwise = opts --} +fixupMsgs :: (a, b, [String]) -> (a, b, [String]) +fixupMsgs (fs,as,es) = (fs,as,map (("command line: "++).chompTrailingNewline) es) withHookOpts :: DarcsOption a (t2 -> t3 -> t4 -> t1) -> (t2 -> t3 -> t4 -> t -> t1) -> [DarcsFlag] -> t -> a @@ -206,9 +214,9 @@ ++ subusage super runRawSupercommand super args = do cwd <- getCurrentDirectory - case getOpt RequireOrder (map (optDescr cwd) (odesc stdCmdActions)) args of + case fixupMsgs $ getOpt RequireOrder (map (optDescr cwd) (odesc stdCmdActions)) args of -- note: we do not apply defaults here - (flags,_,[]) -> case parseFlags stdCmdActions flags of + (flags,_,getopt_errs) -> case parseFlags stdCmdActions flags of Just Help -> viewDoc $ text $ getCommandHelp Nothing super Just ListOptions -> do @@ -217,6 +225,6 @@ Just Disable -> do fail $ "Command " ++ commandName super ++ " disabled with --disable option!" - Nothing -> - fail $ "Invalid subcommand!\n\n" ++ subusage super - (_,_,ermsgs) -> fail $ chompTrailingNewline(unlines ermsgs) + Nothing -> fail $ case getopt_errs of + [] -> "Invalid subcommand!\n\n" ++ subusage super + _ -> intercalate "\n" getopt_errs diff --git a/src/Darcs/Util/ByteString.hs b/src/Darcs/Util/ByteString.hs --- a/src/Darcs/Util/ByteString.hs +++ b/src/Darcs/Util/ByteString.hs @@ -83,6 +83,9 @@ import Data.Text.Encoding ( encodeUtf8, decodeUtf8With ) import Data.Text.Encoding.Error ( lenientDecode ) import Control.Monad ( when ) +#if MIN_VERSION_zlib(0,6,0) +import Control.Monad.ST.Lazy ( ST ) +#endif import Foreign.Ptr ( plusPtr, Ptr ) import Foreign.ForeignPtr ( withForeignPtr ) @@ -279,12 +282,26 @@ gzDecompress mbufsize = -- This is what the code would be without the bad CRC recovery logic: -- return . BL.toChunks . GZ.decompressWith decompressParams +#if MIN_VERSION_zlib(0,6,0) + decompressWarn (ZI.decompressST ZI.gzipFormat decompressParams) +#else toListWarn . ZI.decompressWithErrors ZI.gzipFormat decompressParams +#endif where decompressParams = case mbufsize of Just bufsize -> GZ.defaultDecompressParams { GZ.decompressBufferSize = bufsize } Nothing -> GZ.defaultDecompressParams +#if MIN_VERSION_zlib(0,6,0) + decompressWarn :: (forall s . ZI.DecompressStream (ST s)) -> BL.ByteString -> ([B.ByteString], Bool) + decompressWarn = ZI.foldDecompressStreamWithInput + (\x ~(xs, b) -> (x:xs, b)) + (\xs -> if BL.null xs + then ([], False) + else error "trailing data at end of compressed stream" + ) + handleBad +#else toListWarn :: ZI.DecompressStream -> ([B.ByteString], Bool) toListWarn = foldDecompressStream (\x ~(xs, b) -> (x:xs, b)) ([], False) handleBad @@ -297,12 +314,18 @@ fold ZI.StreamEnd = end fold (ZI.StreamChunk bs stream) = chunk bs (fold stream) fold (ZI.StreamError code msg) = err code msg +#endif -- For a while a bug in darcs caused gzip files with good data but bad CRCs to be -- produced. Trap bad CRC messages, run the specified action to report that it happened, -- but continue on the assumption that the data is valid. +#if MIN_VERSION_zlib(0,6,0) + handleBad (ZI.DataFormatError "incorrect data check") = ([], True) + handleBad e = error (show e) +#else handleBad ZI.DataError "incorrect data check" = ([], True) handleBad _ msg = error msg +#endif isGZFile :: FilePath -> IO (Maybe Int) isGZFile f = do diff --git a/src/Darcs/Util/Printer.hs b/src/Darcs/Util/Printer.hs --- a/src/Darcs/Util/Printer.hs +++ b/src/Darcs/Util/Printer.hs @@ -41,6 +41,7 @@ , hPutDoc, hPutDocLn, putDoc, putDocLn , hPutDocWith, hPutDocLnWith, putDocWith, putDocLnWith , hPutDocCompr + , debugDocLn , renderString, renderStringWith, renderPS, renderPSWith , renderPSs, renderPSsWith, lineColor , prefix, insertBeforeLastline, colorText, invisibleText @@ -57,13 +58,18 @@ , errorDoc ) where +import Control.Exception ( throwIO, ErrorCall(..) ) import Data.String ( IsString(..) ) import Data.List (intersperse) +import GHC.Stack ( currentCallStack ) import System.IO (Handle, stdout, hPutStr) -import Darcs.Util.ByteString ( linesPS, encodeLocale, gzWriteHandle ) +import System.IO.Unsafe ( unsafePerformIO ) import qualified Data.ByteString as B (ByteString, hPut, concat) import qualified Data.ByteString.Char8 as BC (unpack, pack, singleton) +import Darcs.Util.ByteString ( linesPS, encodeLocale, gzWriteHandle ) +import Darcs.Util.Global ( debugMessage ) + -- | A 'Printable' is either a String, a packed string, or a chunk of -- text with both representations. data Printable = S !String @@ -101,7 +107,9 @@ parens d = lparen <> d <> rparen errorDoc :: Doc -> a -errorDoc = error . renderStringWith simplePrinters' Encode +errorDoc x = unsafePerformIO $ do + stack <- currentCallStack + throwIO $ ErrorCall $ renderString Encode $ x $$ vcat (map text stack) -- | 'putDocWith' puts a doc on stdout using the given printer. putDocWith :: Printers -> Doc -> IO () @@ -142,6 +150,10 @@ -- | like 'hPutDoc' but with compress data before writing hPutDocCompr :: RenderMode -> Handle -> Doc -> IO () hPutDocCompr target h = gzWriteHandle h . renderPSs target + +-- | Write a 'Doc' to stderr if debugging is turned on. +debugDocLn :: Doc -> IO () +debugDocLn = debugMessage . renderString Standard -- | @'hPrintPrintables' h@ prints a list of 'Printable's to the handle h hPrintPrintables :: RenderMode -> Handle -> [Printable] -> IO () diff --git a/tests/disable.sh b/tests/disable.sh --- a/tests/disable.sh +++ b/tests/disable.sh @@ -13,7 +13,7 @@ grep disable log rm log # --disable works from defaults - sub_commands=$(darcs $cmd --list-options | grep -v -- --) + sub_commands="$(darcs $cmd --list-options | grep -v -- -- || true)" # disabling super commands in the defaults file is broken if test -z "$sub_commands"; then echo "$cmd --disable" > _darcs/prefs/defaults @@ -21,8 +21,8 @@ rm _darcs/prefs/defaults grep disable log rm log - elif $cmd != setpref; then - # setpref is not a proper super command + elif test $cmd != "setpref" -a $cmd != "help"; then + # setpref and help are not proper super commands for scmd in $sub_commands; do echo "$cmd $scmd --disable" > _darcs/prefs/defaults not darcs $cmd 2> log diff --git a/tests/issue2447-show-content-of-removed-file.sh b/tests/issue2447-show-content-of-removed-file.sh new file mode 100644 --- /dev/null +++ b/tests/issue2447-show-content-of-removed-file.sh @@ -0,0 +1,52 @@ +#!/usr/bin/env bash +## Test for issue2447 - get contents of deleted file +## +## Copyright (C) 2015 Ben Franksen +## +## Permission is hereby granted, free of charge, to any person +## obtaining a copy of this software and associated documentation +## files (the "Software"), to deal in the Software without +## restriction, including without limitation the rights to use, copy, +## modify, merge, publish, distribute, sublicense, and/or sell copies +## of the Software, and to permit persons to whom the Software is +## furnished to do so, subject to the following conditions: +## +## The above copyright notice and this permission notice shall be +## included in all copies or substantial portions of the Software. +## +## THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +## EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +## MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +## NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS +## BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN +## ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN +## CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +## SOFTWARE. + +. lib # Load some portability helpers. +darcs init --repo R # Create our test repos. + +cd R + +echo 'example content' > f +darcs add f +darcs record -am 'add f' +hash1=$(darcs log --last=1 | grep '^patch' | cut -d ' ' -f 2) +rm f +darcs record -am 'removed f' +darcs show contents --hash $hash1 f | grep 'example content' + +mkdir d +echo 'example content' > d/f +darcs add d/f +darcs record -am 'add d/f' +hash2=$(darcs log --last=1 | grep '^patch' | cut -d ' ' -f 2) +rm d/f +darcs record -am 'removed d/f' +darcs show contents --hash $hash2 d/f | grep 'example content' + +darcs obliterate -a --last=1 + +rm -rf d +darcs record -am 'removed d and d/f' +darcs show contents --hash $hash2 d/f | grep 'example content' diff --git a/tests/network/log.sh b/tests/network/log.sh --- a/tests/network/log.sh +++ b/tests/network/log.sh @@ -1,5 +1,17 @@ #!/usr/bin/env bash -set -ev -# Demonstrates issue385 +. lib + +# Demonstrates issue385 and others darcs log --repo=http://darcs.net GNUmakefile --last 300 + +# Test things mentioned in issue2461: + +# no _darcs should remain +test ! -d _darcs +# go to a directory where we have no write access +cd / +# and try again (with less patches to fetch) +darcs log --repo=http://darcs.net GNUmakefile --last 3 +# an absolute path should give an error +not darcs log --repo=http://darcs.net /GNUmakefile --last 3 diff --git a/tests/show-removed-file.sh b/tests/show-removed-file.sh new file mode 100644 --- /dev/null +++ b/tests/show-removed-file.sh @@ -0,0 +1,53 @@ +#!/usr/bin/env bash +## Test that 'show files --hash' acts as expected +## when selecting changes up to a given patch +## +## Copyright (C) 2015 Ben Franksen +## +## Permission is hereby granted, free of charge, to any person +## obtaining a copy of this software and associated documentation +## files (the "Software"), to deal in the Software without +## restriction, including without limitation the rights to use, copy, +## modify, merge, publish, distribute, sublicense, and/or sell copies +## of the Software, and to permit persons to whom the Software is +## furnished to do so, subject to the following conditions: +## +## The above copyright notice and this permission notice shall be +## included in all copies or substantial portions of the Software. +## +## THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +## EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +## MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +## NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS +## BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN +## ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN +## CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +## SOFTWARE. + +. lib # Load some portability helpers. +darcs init --repo R # Create our test repos. + +cd R + +touch f +darcs add f +darcs record -am 'add f' +hash1=$(darcs log --last=1 | grep '^patch' | cut -d ' ' -f 2) +darcs show files > add-f.1 + +rm f +darcs record -am 'removed f' +darcs show files --hash $hash1 --no-pending > add-f.2 +diff add-f.1 add-f.2 + +mkdir d +touch d/f +darcs add d/f +darcs record -am 'add d/f' +hash2=$(darcs log --last=1 | grep '^patch' | cut -d ' ' -f 2) +darcs show files > add-df.1 + +rm -rf d +darcs record -am 'removed d and d/f' +darcs show files --hash $hash2 --no-pending > add-df.2 +diff add-df.1 add-df.2