diff --git a/CHANGELOG b/CHANGELOG --- a/CHANGELOG +++ b/CHANGELOG @@ -1,3 +1,19 @@ +Darcs 2.16.3, 22 October 2020 + + * Fix building with `-f curl` (issue2655) + * Fix building with stack + * Various fixes in our custom Setup.hs, mostly to do with cabal commands + exectuted inside the unpacked source dist tar ball + * Remove obsolete dependency on split package + * Remove dependency on sandi and use base16-bytestring >= 1.0, improving + performance when darcs handles binary files and patches, and more + generally whenever we convert hashes from/to text. + * Various minor fixes and additions to tests scripts + * Issues fixed: + * 2654: amend --prompt-long-comment removes the long comment + * 2658: show dependencies should only show direct dependencies + * 2659: check for bad patch name after invoking editor, too + Darcs 2.16.2, 19 August 2020 * Fix build problem when using 'cabal install' from inside the sdist. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,18 +1,23 @@ -Darcs -===== +About +----- [Darcs](http://darcs.net) is a distributed version control system written in Haskell. -Getting started -=============== +Building +-------- -Compiling ---------- +To build and install the latest release, use -The easiest way to build darcs is by using cabal-install version 3.2 or -later. A plain +``` +cabal update && cabal install darcs +``` +with a recent cabal (version 3.2 or later is recommended). Any version of +ghc from 8.2 up to 8.10 should work. + +From inside a clone or a source dist, use + ``` > cabal build ``` @@ -23,18 +28,21 @@ > cabal install ``` -should work out of the box with any ghc version from 8.0 up to 8.10. +If you prefer stack: -Run the test suite ------------------- +``` +> stack install +``` -It is currently not possible to run the full test suite from the source -distribution that you get from hackage. Instead you need to be in a clone of -the darcs source code repository. This is because the tests depend on an old -version of shelly that was patched to work with newer ghc versions and -bundled with Darcs. It is not part of the source distribution to avoid -'cabal install' also trying to install our patched version of shelly. +Note that using stack will select older versions for some dependencies, +which may mean that performance is slightly less than optimal. +Running the test suite +---------------------- + +This is optional, of course, but useful if you want to help find bugs or +before you contribute patches. + ``` > cabal build --enable-tests > cabal test --test-show-details=direct @@ -79,6 +87,9 @@ > darcs pull ``` +Documentation +------------- + Concise and up-to-date documentation is available from darcs itself: ``` @@ -87,24 +98,38 @@ > darcs command --help # dito ``` +The complete documentation is available as a man page which can be generated +using + +``` +darcs help manpage > darcs.1 +``` + Reporting bugs -============== +-------------- Please send bug reports to . This will automatically add your report to the bug tracker. If you are unsure or just have a question or a comment, you can subscribe to darcs-users@darcs.net and post your question or comments there. See http://darcs.net/MailingLists for details. +There is also an IRC channel named `#darcs` on freenode.net, where you can +report problems or ask questions. + Hacking -======= +------- -Please consult for information -about how to contribute to Darcs. Or send an email to darcs-devel@darcs.net -or to darcs-users@darcs.net. +We are happy to receive patches and will try our best to review them in a +timely fashion. Just record your patches in a clone of + and `darcs send` them. You are encouraged, but not +required, to look at for +additional information. -The wiki can be downloaded with the command: +BTW, the wiki is a darcs repo, you can clone it with: ``` > darcs clone --lazy http://darcs.net/darcs-wiki ``` + +to edit the contents and send us patches. diff --git a/Setup.hs b/Setup.hs --- a/Setup.hs +++ b/Setup.hs @@ -3,7 +3,7 @@ -- portions copyright (c) 2007-2009 Judah Jacobson {-# OPTIONS_GHC -Wall #-} import Distribution.Simple - ( defaultMainWithHooks, UserHooks(..), simpleUserHooks, Args ) + ( defaultMainWithHooks, UserHooks(..), simpleUserHooks ) import Distribution.PackageDescription ( PackageDescription ) import Distribution.Package ( packageVersion ) import Distribution.Version( Version ) @@ -11,8 +11,8 @@ ( LocalBuildInfo(..), absoluteInstallDirs ) import Distribution.Simple.InstallDirs (mandir, CopyDest (NoCopyDest)) import Distribution.Simple.Setup - (configVerbosity, copyDest, copyVerbosity, fromFlag, ConfigFlags, - installVerbosity) + (buildVerbosity, copyDest, copyVerbosity, fromFlag, + haddockVerbosity, installVerbosity, replVerbosity ) import Distribution.Simple.BuildPaths ( autogenPackageModulesDir ) import Distribution.Simple.Utils (copyFiles, createDirectoryIfMissingVerbose, rawSystemStdout, @@ -23,7 +23,7 @@ import Control.Monad ( unless, when, void ) import System.Directory ( doesDirectoryExist, doesFileExist ) import System.IO ( openFile, IOMode(..) ) -import System.Process (runProcess) +import System.Process (callProcess, runProcess) import Data.List( isInfixOf ) import System.FilePath ( () ) @@ -33,25 +33,39 @@ catchAny f h = Exception.catch f (\e -> h (e :: Exception.SomeException)) main :: IO () -main = - defaultMainWithHooks $ - simpleUserHooks - { postConf = postConfHook - , postBuild = \_ _ _ lbi -> buildManpage lbi - , postCopy = - \_ flags pkg lbi -> - installManpage pkg lbi - (fromFlag $ copyVerbosity flags) (fromFlag $ copyDest flags) - , postInst = - \_ flags pkg lbi -> - installManpage pkg lbi (fromFlag $ installVerbosity flags) NoCopyDest - } +main = defaultMainWithHooks $ simpleUserHooks { -postConfHook :: Args -> ConfigFlags -> PackageDescription -> LocalBuildInfo -> IO () -postConfHook _args flags pkg lbi = do - let verbosity = fromFlag $ configVerbosity flags + buildHook = \ pkg lbi hooks flags -> + let verb = fromFlag $ buildVerbosity flags + in commonBuildHook buildHook pkg lbi hooks verb >>= ($ flags), + + haddockHook = \ pkg lbi hooks flags -> + let verb = fromFlag $ haddockVerbosity flags + in commonBuildHook haddockHook pkg lbi hooks verb >>= ($ flags) , + replHook = \pkg lbi hooks flags args -> + let verb = fromFlag $ replVerbosity flags + in commonBuildHook replHook pkg lbi hooks verb >>= (\f -> f flags args) , + postBuild = \ _ _ _ lbi -> buildManpage lbi, + postCopy = \ _ flags pkg lbi -> + installManpage pkg lbi (fromFlag $ copyVerbosity flags) (fromFlag $ copyDest flags), + postInst = \ _ flags pkg lbi -> + installManpage pkg lbi (fromFlag $ installVerbosity flags) NoCopyDest + +} + +-- | For @./Setup build@ and @./Setup haddock@, do some unusual +-- things, then invoke the base behaviour ("simple hook"). +commonBuildHook :: (UserHooks -> PackageDescription -> LocalBuildInfo -> t -> a) + -> PackageDescription -> LocalBuildInfo -> t -> Verbosity -> IO a +commonBuildHook runHook pkg lbi hooks verbosity = do + versionInfoExists <- + (&&) <$> doesFileExist "release/distributed-context" + <*> doesFileExist "release/distributed-version" + unless versionInfoExists $ + callProcess "runghc" ["./release/gen-version-info.hs"] (version, state) <- determineVersion verbosity pkg generateVersionModule verbosity lbi version state + return $ runHook simpleUserHooks pkg lbi hooks -- --------------------------------------------------------------------- -- man page diff --git a/darcs.cabal b/darcs.cabal --- a/darcs.cabal +++ b/darcs.cabal @@ -1,6 +1,6 @@ Cabal-Version: 2.2 Name: darcs -version: 2.16.2 +version: 2.16.3 License: GPL-2.0-or-later License-file: COPYING Author: David Roundy , @@ -430,7 +430,7 @@ haskeline >= 0.7.2 && < 0.9, memory >= 0.14 && < 0.16, cryptonite >= 0.24 && < 0.28, - base16-bytestring >= 0.1 && < 0.2, + base16-bytestring >= 0.1.1.7 && < 1.1, utf8-string >= 1 && < 1.1, vector >= 0.11 && < 0.13, tar >= 0.5 && < 0.6, @@ -439,7 +439,6 @@ zip-archive >= 0.3 && < 0.5, async >= 2.0.2 && < 2.3, constraints >= 0.11 && < 0.13, - sandi >= 0.4 && < 0.6, unix-compat >= 0.5 && < 0.6, bytestring >= 0.10.6 && < 0.11, old-time >= 1.1.0.3 && < 1.2, @@ -454,7 +453,7 @@ zlib >= 0.6.1.2 && < 0.7.0.0, network-uri >= 2.6 && < 2.8, network >= 2.6 && < 3.2, - conduit >= 1.3.0 && < 1.3.3, + conduit >= 1.3.0 && < 1.4, http-conduit >= 2.3 && < 2.4, http-types >= 0.12.1 && < 0.12.4 @@ -574,7 +573,6 @@ filepath, mtl, transformers, - split >= 0.2.2 && < 0.3, text, directory, FindBin >= 0.0.5 && < 0.1, diff --git a/harness/Darcs/Test/Patch/Arbitrary/PrimV1.hs b/harness/Darcs/Test/Patch/Arbitrary/PrimV1.hs --- a/harness/Darcs/Test/Patch/Arbitrary/PrimV1.hs +++ b/harness/Darcs/Test/Patch/Arbitrary/PrimV1.hs @@ -209,6 +209,7 @@ aModelShrinkName repo = do (oldPath, _) <- list repo newPath <- shrinkPath oldPath + guard (newPath `notElem` map fst (list repo)) return $ Sealed $ move oldPath newPath aModelDeleteFile :: V1Model wX -> [Sealed (Prim.Prim wX)] @@ -224,7 +225,7 @@ aModelShrinkFileContent :: V1Model wX -> [Sealed (Prim.Prim wX)] aModelShrinkFileContent repo = do (path, file) <- filterFiles (list repo) - (pos, lineToRemove) <- zip [0..] $ fileContent file + (pos, lineToRemove) <- zip [1..] $ fileContent file (return (Sealed $ hunk path pos [lineToRemove] []) <|> do diff --git a/harness/test.hs b/harness/test.hs --- a/harness/test.hs +++ b/harness/test.hs @@ -91,6 +91,8 @@ let pathToUse = map (fromText . pack) $ takeDirectory dp:Native.splitSearchPath p let env = [ ("HOME", EnvFilePath wd) + -- in case someone has XDG_CACHE_HOME set: + , ("XDG_CACHE_HOME", EnvFilePath (wd ".cache")) , ("TESTDATA", EnvFilePath (srcdir "tests" "data")) , ("TESTBIN", EnvFilePath (srcdir "tests" "bin")) , ("DARCS_TESTING_PREFS_DIR", EnvFilePath $ wd ".darcs") 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\n[TAG 2.16.2\nBen Franksen **20200819210622\n Ignore-this: 8aeca92b4f3d72a38b97ea681f4f87ea9f13e1a0abb37954596cbc64754cdaf4202fe95d848e9764\n] \n" +Just "\nContext:\n\n\n[TAG 2.16.3\nBen Franksen **20201022094642\n Ignore-this: bd76d7e31488721e4a5ce7267115e71c3b68d680c155c75c3dd275d9e54933a607d208fab502a143\n] \n" diff --git a/src/Darcs/Patch/Prim/V1/Coalesce.hs b/src/Darcs/Patch/Prim/V1/Coalesce.hs --- a/src/Darcs/Patch/Prim/V1/Coalesce.hs +++ b/src/Darcs/Patch/Prim/V1/Coalesce.hs @@ -193,7 +193,7 @@ coalesceFilePrim :: AnchoredPath -> FilePatchType wX wY -> FilePatchType wY wZ -> Maybe (Prim wX wZ) coalesceFilePrim f (Hunk line1 old1 new1) (Hunk line2 old2 new2) - = coalesceHunk f line2 old2 new2 line1 old1 new1 + = coalesceHunk f line1 old1 new1 line2 old2 new2 -- Token replace patches operating right after (or before) AddFile (RmFile) -- is an identity patch, as far as coalescing is concerned. -- These two cases make no sense when we decoalesce, which is the second @@ -219,27 +219,27 @@ -> Int -> [B.ByteString] -> [B.ByteString] -> Maybe (Prim wX wY) coalesceHunk f line1 old1 new1 line2 old2 new2 - | line1 == line2 && lengthold1 < lengthnew2 = - if take lengthold1 new2 /= old1 + | line2 == line1 && lengthold2 < lengthnew1 = + if take lengthold2 new1 /= old2 then Nothing - else case drop lengthold1 new2 of - extranew -> Just (FP f (Hunk line1 old2 (new1 ++ extranew))) - | line1 == line2 && lengthold1 > lengthnew2 = - if take lengthnew2 old1 /= new2 + else case drop lengthold2 new1 of + extranew -> Just (FP f (Hunk line2 old1 (new2 ++ extranew))) + | line2 == line1 && lengthold2 > lengthnew1 = + if take lengthnew1 old2 /= new1 then Nothing - else case drop lengthnew2 old1 of - extraold -> Just (FP f (Hunk line1 (old2 ++ extraold) new1)) - | line1 == line2 = if new2 == old1 then Just (FP f (Hunk line1 old2 new1)) + else case drop lengthnew1 old2 of + extraold -> Just (FP f (Hunk line2 (old1 ++ extraold) new2)) + | line2 == line1 = if new1 == old2 then Just (FP f (Hunk line2 old1 new2)) else Nothing - | line1 < line2 && lengthold1 >= line2 - line1 = - case take (line2 - line1) old1 of - extra-> coalesceHunk f line1 old1 new1 line1 (extra ++ old2) (extra ++ new2) - | line1 > line2 && lengthnew2 >= line1 - line2 = - case take (line1 - line2) new2 of + | line2 < line1 && lengthold2 >= line1 - line2 = + case take (line1 - line2) old2 of extra-> coalesceHunk f line2 (extra ++ old1) (extra ++ new1) line2 old2 new2 + | line2 > line1 && lengthnew1 >= line2 - line1 = + case take (line2 - line1) new1 of + extra-> coalesceHunk f line1 old1 new1 line1 (extra ++ old2) (extra ++ new2) | otherwise = Nothing - where lengthold1 = length old1 - lengthnew2 = length new2 + where lengthold2 = length old2 + lengthnew1 = length new1 canonizeHunk :: Gap w => D.DiffAlgorithm -> AnchoredPath -> Int -> [B.ByteString] -> [B.ByteString] diff --git a/src/Darcs/UI/Commands/ShowDependencies.hs b/src/Darcs/UI/Commands/ShowDependencies.hs --- a/src/Darcs/UI/Commands/ShowDependencies.hs +++ b/src/Darcs/UI/Commands/ShowDependencies.hs @@ -21,7 +21,9 @@ import Darcs.Util.Printer ( Doc , (<+>) + , ($+$) , formatText + , formatWords , hsep , prefixLines , putDocLn @@ -30,6 +32,7 @@ , text , vcat ) +import Darcs.Util.Progress ( beginTedious, endTedious, progress, tediousSize ) import Darcs.Patch.Commute ( Commute, commuteFL ) import Darcs.Patch.Ident ( PatchId, Ident(..) ) @@ -39,6 +42,7 @@ , FL(..) , RL(..) , reverseFL + , lengthFL ) import Darcs.Patch.Witnesses.Sealed ( Sealed2(..) ) @@ -46,16 +50,28 @@ showDepsDescription = "Generate the graph of dependencies." showDepsHelp :: Doc -showDepsHelp = formatText 80 - [ unwords [ "The `darcs show dependencies` command is used to create" - , "a graph of the dependencies between patches of the" - , "repository (by default up to last tag)." - ] - , unwords [ "The resulting graph is described in Dot Language, a" - , "general example of use could be:" - ] - , "darcs show dependencies | dot -Tpdf -o FILE.pdf" - ] +showDepsHelp = + formatWords + [ "This command creates a graph of the dependencies between patches." + , "The output format is the Dot Language, see" + , "https://www.graphviz.org/doc/info/lang.html. The resulting graph" + , "is transitively reduced, in other words," + , "it contains only the direct dependencies, not the indirect ones." + ] + $+$ formatWords + [ "By default all patches in your repository are considered. You can" + , "limit this to a range of patches using patch matching options, see" + , "`darcs help patterns` and the options avaiable for this command." + , "For instance, to visualize the dependencies between all patches" + , "since the last tag, do:" + ] + $+$ " darcs show dependencies --from-tag=. | dot -Tpdf -o FILE.pdf" + $+$ formatWords + [ "This command can take a very(!) long time to compute its result," + , "depending on the number of patches in the selected range. For N" + , "patches it needs to do on the order of N^3 commutations in the" + , "worst case." + ] showDeps :: DarcsCommand showDeps = DarcsCommand @@ -78,45 +94,65 @@ showDepsBasicOpts = O.matchRange showDepsOpts = showDepsBasicOpts `withStdOpts` oid +progressKey :: String +progressKey = "Determining dependencies" + depsCmd :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO () depsCmd _ opts _ = do let repodir = fromMaybe "." (getRepourl opts) withRepositoryLocation (useCache ? opts) repodir $ RepoJob $ \repo -> do - Sealed2 rFl <- matchRange (O.matchRange ? opts) <$> readRepo repo - putDocLn $ renderDepsGraphAsDot $ depsGraph $ reverseFL rFl + Sealed2 range <- matchRange (O.matchRange ? opts) <$> readRepo repo + beginTedious progressKey + tediousSize progressKey (lengthFL range) + putDocLn $ renderDepsGraphAsDot $ depsGraph $ reverseFL range + endTedious progressKey --- A 'M.Map' from 'PatchId's to 'Deps'. +-- | A 'M.Map' from 'PatchId's to 'Deps'. type DepsGraph p = M.Map (PatchId p) (Deps p) --- A pair of (direct, indirect) dependencies. +-- | A pair of (direct, indirect) dependencies. For the result we need only the +-- direct dependencies. We store the indirect ones as an optimization to avoid +-- doing commutes for which we already know that they cannot succeed. Note that +-- the two sets are always disjoint. type Deps p = (S.Set (PatchId p), S.Set (PatchId p)) --- Determine the 'DepsGraph' of an 'RL' of patches. +-- | Determine the 'DepsGraph' of an 'RL' of patches. depsGraph :: forall p wX wY. (Commute p, Ident p) => RL p wX wY -> DepsGraph p depsGraph NilRL = M.empty depsGraph (ps :<: p) = - M.insert i (foldDeps ps (p :>: NilFL) NilFL (S.empty, S.empty)) m + M.insert (ident p) (foldDeps ps (p :>: NilFL) NilFL (S.empty, S.empty)) m where + -- First recurse on the context. The result now has all the 'Deps' for + -- all patches preceding p. m = depsGraph ps - i = ident p + -- Lookup all (direct and indirect) dependencies of a patch in a given + -- 'DepthGraph' allDeps j = uncurry S.union . fromJust . M.lookup j + -- Add all (direct and indirect) dependencies of a patch to a given set + -- assuming 'm' already addDeps j = S.insert j . S.union (allDeps j m) + -- Add direct and indirect dependencies of a patch, assuming that the + -- graph has already been constructed for all patches in the context. foldDeps :: RL p wA wB -> FL p wB wC -> FL p wC wD -> Deps p -> Deps p - foldDeps NilRL _ _ acc = acc + foldDeps NilRL _ _ acc = progress progressKey acc foldDeps (qs :<: q) p_and_deps non_deps acc@(direct, indirect) - -- no need to commute or adjust acc if we already know we depend - -- (indirectly) on q; note that (ident q `S.member` direct) is - -- impossible + -- If we already know we indirectly depend on q, then there is + -- nothing left to do. Note that (j `S.member` direct) is impossible. | j `S.member` indirect = foldDeps qs (q :>: p_and_deps) non_deps acc - -- if q commutes past p_and_deps then we don't depend on it + -- If q commutes past p_and_deps then we don't depend on it | Just (p_and_deps' :> q') <- commuteFL (q :> p_and_deps) = foldDeps qs p_and_deps' (q' :>: non_deps) acc - -- we have a new dependency which must be a direct one + -- We have a new dependency which must be a direct one, so add it to + -- 'direct' and all its dependencies to 'indirect'. The invariant that + -- direct and indirect are disjoint is maintained because neither the + -- direct and indirect deps of a patch contain its own 'PatchId'. | otherwise = - foldDeps qs (q :>: p_and_deps) non_deps (addDeps j direct, indirect) + foldDeps qs (q :>: p_and_deps) non_deps (S.insert j direct, addDeps j indirect) where j = ident q +-- | Render a 'DepthGraph' in the Dot Language format. This function +-- considers only the direct dependencies. renderDepsGraphAsDot :: M.Map PatchInfo (S.Set PatchInfo, S.Set PatchInfo) -> Doc renderDepsGraphAsDot g = vcat ["digraph {", indent body, "}"] where diff --git a/src/Darcs/UI/Flags.hs b/src/Darcs/UI/Flags.hs --- a/src/Darcs/UI/Flags.hs +++ b/src/Darcs/UI/Flags.hs @@ -16,6 +16,10 @@ -- Boston, MA 02110-1301, USA. {-# LANGUAGE OverloadedStrings #-} +-- | Helper functions to access option contents. Some of them are here only to +-- ease the transition from the legacy system where we manually parsed the flag +-- list to the new(er) option system. At some point this module should be +-- renamed and the re-exports from "Darcs.UI.Options.All" removed. module Darcs.UI.Flags ( F.DarcsFlag , remoteDarcs @@ -177,7 +181,10 @@ -- | This will become dis-entangled as soon as we inline these functions. wantGuiPause :: Config -> O.WantGuiPause -wantGuiPause fs = if (hasDiffCmd fs || hasExternalMerge fs) && hasPause fs then O.YesWantGuiPause else O.NoWantGuiPause +wantGuiPause fs = + if (hasDiffCmd fs || hasExternalMerge fs) && hasPause fs + then O.YesWantGuiPause + else O.NoWantGuiPause where hasDiffCmd = isJust . O.diffCmd . parseFlags O.extDiff hasExternalMerge = (/= O.NoExternalMerge) . parseFlags O.externalMerge @@ -279,7 +286,9 @@ -- position of the path that cannot be converted. -- -- It is intended for validating file arguments to darcs commands. -maybeFixSubPaths :: (AbsolutePath, AbsolutePath) -> [String] -> IO [Maybe AnchoredPath] +maybeFixSubPaths :: (AbsolutePath, AbsolutePath) + -> [String] + -> IO [Maybe AnchoredPath] maybeFixSubPaths (r, o) fs = do fixedFs <- mapM (fmap dropInDarcsdir . fixit) fs let bads = snd . unzip . filter (isNothing . fst) $ zip fixedFs fs @@ -332,7 +341,10 @@ -- and if it's not possible, ask the user. getAuthor :: Maybe String -> Bool -> IO String getAuthor (Just author) _ = return author -getAuthor Nothing pipe = if pipe then askUser "Who is the author? " else promptAuthor True False +getAuthor Nothing pipe = + if pipe + then askUser "Who is the author? " + else promptAuthor True False -- | 'promptAuthor' try to guess the author, from repository or -- global preference files or environment variables, and @@ -397,10 +409,10 @@ unless exists $ createDirectory dir return dir --- | 'getEasyAuthor' tries to get the author name first from the repository preferences, --- then from global preferences, then from environment variables. Returns @[]@ --- if it could not get it. Note that it may only return multiple possibilities when --- reading from global preferences +-- | 'getEasyAuthor' tries to get the author name first from the repository +-- preferences, then from global preferences, then from environment variables. +-- Returns @[]@ if it could not get it. Note that it may only return multiple +-- possibilities when reading from global preferences. getEasyAuthor :: IO [String] getEasyAuthor = firstNotNullIO [ (take 1 . nonblank) `fmap` getPreflist "author" @@ -440,7 +452,8 @@ -- to be used by @darcs send@. Looks for a command specified by -- @SendmailCmd \"command\"@ in that list of flags, if any. -- This flag is present if darcs was invoked with @--sendmail-command=COMMAND@ --- Alternatively the user can set @$S@@ENDMAIL@ which will be used as a fallback if present. +-- Alternatively the user can set @$S@@ENDMAIL@ which will be used as a +-- fallback if present. getSendmailCmd :: Config -> IO String getSendmailCmd fs = case parseFlags O.sendmailCmd fs of Just cmd -> return cmd diff --git a/src/Darcs/UI/PatchHeader.hs b/src/Darcs/UI/PatchHeader.hs --- a/src/Darcs/UI/PatchHeader.hs +++ b/src/Darcs/UI/PatchHeader.hs @@ -52,7 +52,7 @@ import Control.Monad.Trans ( liftIO ) import Control.Monad.Trans.State.Strict ( StateT(..), evalStateT, get, put ) import Data.List ( isPrefixOf, stripPrefix ) -import Data.Maybe ( fromMaybe ) +import Data.Maybe ( fromMaybe, isJust ) import System.Exit ( exitSuccess ) import System.IO ( stdin ) @@ -105,7 +105,7 @@ mlp <- readTextFile f `catch` (\(_ :: IOException) -> return []) firstname <- case (patchname_specified, mlp) of (FlagPatchName p, []) -> check_badname p >> return p - (_, p:_) -> if badName p + (_, p:_) -> if is_badname p then prompt_patchname True else return p -- logfile trumps prior! (PriorPatchName p, []) -> return p @@ -154,8 +154,6 @@ (Nothing, Just (name, _)) -> PriorPatchName (stripTagPrefix name) (Nothing, Nothing) -> NoPatchName - badName n = null n || hasTagPrefix n - default_log = case m_old of Nothing -> [] Just (_,l) -> l @@ -172,25 +170,27 @@ just_a_badname n = if null n then - Just "The patch name must not be empty!" + Just "Error: The patch name must not be empty!" else if hasTagPrefix n then - Just "The patch name must not start with \"TAG \"!" + Just "Error: The patch name must not start with \"TAG \"!" else Nothing + is_badname = isJust . just_a_badname + prompt_long_comment oldname = - do y <- promptYorn "Do you want to add a long comment?" + do let verb = case m_old of Nothing -> "add a"; Just _ -> "edit the" + y <- promptYorn $ "Do you want to "++verb++" long comment?" if y then get_log_using_editor oldname - else return (oldname, [], Nothing) + else return (oldname, default_log, Nothing) get_log_using_editor p = do let logf = darcsLastMessage - -- TODO: make sure encoding used for logf is the same everywhere - -- probably should be locale because the editor will assume it writeTextFile logf $ unlines $ p : default_log append_info logf p _ <- editFile logf (name,long) <- read_long_comment logf p + check_badname name return (name,long,Just logf) read_long_comment :: FilePathLike p => p -> String -> IO (String, [String]) 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 @@ -57,12 +57,11 @@ import Darcs.Prelude -import Codec.Binary.Base16 ( b16Enc, b16Dec ) - import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as BC import qualified Data.ByteString.Lazy as BL import Data.ByteString (intercalate) +import qualified Data.ByteString.Base16 as B16 import System.IO ( withFile, IOMode(ReadMode) , hSeek, SeekMode(SeekFromEnd,AbsoluteSeek) @@ -72,10 +71,11 @@ import System.IO.Unsafe ( unsafePerformIO ) import Data.Bits ( rotateL ) -import Data.Char ( ord, toLower, toUpper ) +import Data.Char ( ord ) import Data.Word ( Word8 ) import Data.Int ( Int32, Int64 ) import Data.List ( intersperse ) +import Control.Exception ( throw ) import Control.Monad ( when ) import Control.Monad.ST.Lazy ( ST ) @@ -325,17 +325,21 @@ -- fromPS2Hex fromPS2Hex :: B.ByteString -> B.ByteString -fromPS2Hex = BC.map toLower . b16Enc +fromPS2Hex = B16.encode -- ------------------------------------------------------------------------- -- fromHex2PS fromHex2PS :: B.ByteString -> B.ByteString fromHex2PS s = - case b16Dec $ BC.map toUpper s of - Right (result, remaining) - | B.null remaining -> result - _ -> error "fromHex2PS: input is not hex encoded" + case B16.decode s of +#if MIN_VERSION_base16_bytestring(1,0,0) + Right result -> result + Left msg -> throw $ userError $ "fromHex2PS: input is not hex encoded: "++msg +#else + (result, rest) | B.null rest -> result + _ -> throw $ userError $ "fromHex2PS: input is not hex encoded" +#endif propHexConversion :: B.ByteString -> Bool propHexConversion x = fromHex2PS (fromPS2Hex x) == x diff --git a/src/Darcs/Util/Hash.hs b/src/Darcs/Util/Hash.hs --- a/src/Darcs/Util/Hash.hs +++ b/src/Darcs/Util/Hash.hs @@ -1,6 +1,7 @@ -- Copyright (C) 2009-2011 Petr Rockai BSD3 -- Copyright (C) 2001, 2004 Ian Lynagh +{-# LANGUAGE CPP #-} module Darcs.Util.Hash ( Hash(..) , encodeBase16, decodeBase16, sha256, sha256sum, rawHash @@ -17,13 +18,11 @@ import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString.Char8 as BC - -import qualified Codec.Binary.Base16 as B16 +import qualified Data.ByteString.Base16 as B16 import qualified Crypto.Hash as H -import Data.Maybe( isJust, fromJust ) -import Data.Char( toLower, toUpper, intToDigit, ord ) +import Data.Char( intToDigit, ord ) import Data.Binary ( Binary(..), decode, encode ) import Data.Bits ( xor, shiftL, (.|.) ) @@ -36,25 +35,23 @@ | NoHash deriving (Show, Eq, Ord, Read) -base16 :: B.ByteString -> B.ByteString -base16 = BC.map toLower . B16.b16Enc - -debase16 :: B.ByteString -> Maybe B.ByteString -debase16 bs = case B16.b16Dec $ BC.map toUpper bs of - Right (s, _) -> Just s - Left _ -> Nothing - -- | Produce a base16 (ascii-hex) encoded string from a hash. This can be -- turned back into a Hash (see "decodeBase16". This is a loss-less process. encodeBase16 :: Hash -> B.ByteString -encodeBase16 (SHA256 bs) = base16 bs +encodeBase16 (SHA256 bs) = B16.encode bs encodeBase16 NoHash = B.empty -- | Take a base16-encoded string and decode it as a "Hash". If the string is -- malformed, yields NoHash. decodeBase16 :: B.ByteString -> Hash -decodeBase16 bs | B.length bs == 64 && isJust (debase16 bs) = SHA256 (fromJust $ debase16 bs) - | otherwise = NoHash +decodeBase16 bs + | B.length bs == 64 +#if MIN_VERSION_base16_bytestring(1,0,0) + , Right dbs <- B16.decode bs = SHA256 dbs +#else + , (dbs, rest) <- B16.decode bs, B.null rest = SHA256 dbs +#endif + | otherwise = NoHash -- | Compute a sha256 of a (lazy) ByteString. sha256 :: BL.ByteString -> Hash @@ -62,7 +59,7 @@ -- | Same as previous but general purpose. sha256sum :: B.ByteString -> String -sha256sum = BC.unpack . base16 . convert . H.hashWith H.SHA256 +sha256sum = BC.unpack . B16.encode . convert . H.hashWith H.SHA256 rawHash :: Hash -> B.ByteString rawHash NoHash = error "Cannot obtain raw hash from NoHash." @@ -138,4 +135,4 @@ {-# INLINE sha1Show #-} sha1Show :: SHA1 -> B.ByteString -sha1Show = base16 . BL.toStrict . encode +sha1Show = B16.encode . BL.toStrict . encode diff --git a/src/hscurl.c b/src/hscurl.c --- a/src/hscurl.c +++ b/src/hscurl.c @@ -6,6 +6,8 @@ #include #include +#include "cabal_macros.h" + #if LIBCURL_VERSION_NUM >= 0x071301 /* enable pipelining for libcurl >= 7.19.1 */ #define ENABLE_PIPELINING @@ -45,13 +47,8 @@ }; static int debug = 0; -#ifndef _WIN32 static const char user_agent[] = - "darcs/" PACKAGE_VERSION " libcurl/" LIBCURL_VERSION; -#else -static const char user_agent[] = - "darcs/unknown libcurl/" LIBCURL_VERSION; -#endif + "darcs/" CURRENT_PACKAGE_VERSION " libcurl/" LIBCURL_VERSION; static const char *proxypass; static int init_done = 0; diff --git a/tests/conflict-fight-failure.sh b/tests/conflict-fight-failure.sh --- a/tests/conflict-fight-failure.sh +++ b/tests/conflict-fight-failure.sh @@ -14,6 +14,9 @@ # test fails for these obsolete formats: skip-formats darcs-1 darcs-2 +# skip if time executable is not found +/usr/bin/env time --help 2> /dev/null || exit 200 + num_conflicts=40 rm -rf RA RB diff --git a/tests/issue1956.sh b/tests/issue1956.sh new file mode 100644 --- /dev/null +++ b/tests/issue1956.sh @@ -0,0 +1,38 @@ +## Test for issue1956 + +# copied almost verbatim from igloo's +# http://bugs.darcs.net/file1862/darcs_bug_with_touch.sh + +. lib + +rm -rf a +rm -rf b + +mkdir a +cd a +darcs init --darcs-2 +echo A > file +darcs add file +darcs rec -a -m A --ignore-times +cd .. + +darcs get a b + +cd a +echo BB > file +darcs rec -a -m B --ignore-times +cd .. + +sleep 1 + +cd b +touch ts +echo R > file +touch file --reference=ts +darcs rec -a -m R +# sleep 1 +echo S > file +touch file --reference=ts +# darcs rec -a -m S --ignore-times +echo y| darcs pull ../a -ap B +cd .. diff --git a/tests/issue2353.sh b/tests/issue2353.sh new file mode 100644 --- /dev/null +++ b/tests/issue2353.sh @@ -0,0 +1,16 @@ +## issue2353: darcs does not show old changes of moved files + +#!/usr/bin/env bash +. ./lib + +rm -rf test +mkdir test +cd test +darcs init +echo 'hello world' > file +darcs add file +darcs record -am 'patch 1' --skip-long +darcs mv file new_file +darcs record -am 'file -> new_file' --skip-long +darcs diff -p 'patch 1' | grep -F "+hello world" +cd .. diff --git a/tests/issue2549-trailing-slash-in-patch-bundle.sh b/tests/issue2549-trailing-slash-in-patch-bundle.sh new file mode 100644 --- /dev/null +++ b/tests/issue2549-trailing-slash-in-patch-bundle.sh @@ -0,0 +1,28 @@ +. lib + +rm -rf R S N W + +mkdir R S +darcs init R +darcs init S +cd R +mkdir directory +darcs add directory +darcs record -am 'add directory' +darcs send -a -o orig.dpatch ../S +sed -e s'#adddir ./directory#adddir ./directory/#'\ + -e '/Patch bundle hash:/,+2d' orig.dpatch > tweaked.dpatch +cd ../S +darcs apply ../R/tweaked.dpatch +rm -rf directory +darcs record -am 'rm directory' +cd .. +# Now, try pulling these patches. +darcs init --no-patch-index N +cd N +darcs pull -a ../S +cd .. +darcs init --with-patch-index W +cd W +darcs pull -a ../S +cd .. diff --git a/tests/issue2659-show-dependencies.sh b/tests/issue2659-show-dependencies.sh new file mode 100644 --- /dev/null +++ b/tests/issue2659-show-dependencies.sh @@ -0,0 +1,25 @@ +#!/usr/bin/env bash + +# test that 'darcs show dependencies' shows only the direct dependencies + +. lib + +rm -rf R +darcs init R +cd R + +# 4 patches, each depending on the previous one +echo a > f +darcs record -lam a +echo b > f +darcs record -lam a +echo c > f +darcs record -lam a +echo d > f +darcs record -lam d + +# the number of edges in the dependency graph should be exactly 3 +darcs show dependencies > graph.dot +test "3" = $(grep -wF -- '->' graph.dot | wc -l) + +cd .. diff --git a/tests/issue595_get_permissions.sh b/tests/issue595_get_permissions.sh --- a/tests/issue595_get_permissions.sh +++ b/tests/issue595_get_permissions.sh @@ -15,36 +15,24 @@ abort_windows -rm -rf temp1 temp2 +rm -rf tmp_remote tmp_restrictive # Set up a "remote" repo -mkdir tmp_remote -cd tmp_remote -darcs 'init' -cd .. +darcs init tmp_remote -DIR=`pwd` +DIR=`/bin/pwd` +trap "chmod +wx $PWD/tmp_restrictive" EXIT + # Set up a directory with restrictive permissions mkdir -p tmp_restrictive/liberal cd tmp_restrictive/liberal -chmod 0111 ../../tmp_restrictive +chmod a-wx ../../tmp_restrictive +# sanity check that we can not cd .. +not cd .. # sanity check that we can cd out and back -cd ../..; cd tmp_restrictive/liberal -# TODO: we avoid this test on Solaris because it seems we can't create -# anything in tmp_restrictive/liberal -touch can_touch -if [ -e can_touch ]; then - if hwpwd; then - darcs get "$DIR/tmp_remote" 2> log - not grep -i 'permission denied' log - else - echo "Apparently I can't do `basename $0` on this platform" - fi -else - echo "Can't do `basename $0` on this platform" -fi -cd "$DIR" -# We have to fix the permissions, just so we can delete it. -chmod 0755 tmp_restrictive - -rm -rf tmp_remote tmp_restrictive +(cd ../.. && cd tmp_restrictive/liberal) || exit 200 +(touch can_touch && test -e can_touch) || exit 200 +# now run the real test +darcs get "$DIR/tmp_remote" 2>&1 >log +not grep -i 'permission denied' log +cd ../.. diff --git a/tests/record.sh b/tests/record.sh --- a/tests/record.sh +++ b/tests/record.sh @@ -52,18 +52,26 @@ echo "second record\n" >> log.txt darcs record -a -m 'second record' --logfile=log.txt date.t | grep -i 'finished recording' +echo text > file +darcs add file + # refuse empty patch name -export DARCS_EDITOR="cat -n" -echo "patchname" | not darcs record -a -m "" + +# true command outputs nothing & ignores its arguments +DARCS_EDITOR=true not darcs record -a --edit-long-comment +# cat command reproduces its input unchanged +DARCS_EDITOR=cat not darcs record -a -m "" --edit-long-comment not darcs record -a -m "" # refuse patch name starting with "TAG " -export DARCS_EDITOR="cat -n" -echo "patchname" | not darcs record -a -m "TAG fake" + +# editor output will be "echo TAG _darcs/patch_description.txt" +DARCS_EDITOR='echo TAG ' not darcs record -a --edit-long-comment +# cat command reproduces its input unchanged +DARCS_EDITOR=cat not darcs record -a -m "TAG fake" --edit-long-comment not darcs record -a -m "TAG fake" cd .. -rm -rf temp1 # record race @@ -84,7 +92,6 @@ darcs pull -a ../foo1 cd .. cmp foo1/foo foo2/foo -rm -rf foo1 foo2 # record interactive @@ -110,7 +117,6 @@ not grep cancelled ch cd .. -rm -rf temp1 # Some tests for 'darcs rec --edit-long-comment' @@ -119,6 +125,7 @@ export DARCS_EDITOR="cat -n" # editor: space in command +rm -rf temp1 mkdir temp1 cd temp1 darcs init @@ -126,9 +133,9 @@ darcs add file.t echo y | darcs record --edit-long-comment -a -m foo file.t | grep '# Please enter' cd .. -rm -rf temp1 # editor: space in path +rm -rf temp2\ dir mkdir temp2\ dir cd temp2\ dir darcs init @@ -136,9 +143,9 @@ darcs add file.t echo y | darcs record --edit-long-comment -a -m foo file.t | grep '# Please enter' cd .. -rm -rf temp2\ dir # make sure summaries are coalesced +rm -rf temp3 mkdir temp3 cd temp3 darcs init @@ -158,10 +165,10 @@ EOF echo y | darcs record --edit-long-comment -a -m edit | grep -c "./file" | grep 1 cd .. -rm -rf temp2\ dir export DARCS_EDITOR='grep "# Please enter"' # editor: quoting in command +rm -rf temp1 mkdir temp1 cd temp1 darcs init @@ -169,10 +176,10 @@ darcs add file.t echo y | darcs record --edit-long-comment -a -m foo file.t | grep '# Please enter' cd .. -rm -rf temp1 export DARCS_EDITOR='echo' # editor: evil filename +rm -rf temp1 darcs init temp1 cd temp1 touch file.t @@ -186,10 +193,10 @@ echo y | darcs record --logfile='; test-command' --edit-long-comment -a -m foo file.t > log not grep EVIL log cd .. -rm -rf temp1 ## Test for issue142 - darcs record --logfile foo should not +rm -rf temp1 darcs init temp1 cd temp1 touch f g @@ -197,11 +204,11 @@ darcs record -alm f --logfile log f not darcs record -alm g --logfile missing g cd .. -rm -rf temp1 ## Test for issue1845 - darcs record f, for f a removed file should work ## Public domain - 2010 Petr Rockai +rm -rf temp1 darcs init temp1 cd temp1 @@ -211,20 +218,20 @@ echo ny | darcs record f 2>&1 | tee log not grep "None of the files" log cd .. -rm -rf temp1 # issue1472 - "darcs record ./foo" shouldn't even TRY to read ./bar +rm -rf temp1 darcs init temp1 mkdir temp1/d/ echo 'Example content.' >temp1/f echo 'Similar content.' >temp1/d/f chmod 0 temp1/f # Make temp1/f unreadable darcs record --repo temp1 -lam 'Only changes to temp1/d/.' d -rm -rf temp1 # issue1871 - `darcs record .` should work for tracked changes # in a subdirectory even if the subdirectory itself is not known yet. +rm -rf temp1 darcs init temp1 cd temp1 mkdir d @@ -234,4 +241,3 @@ echo ny | darcs record . > log not grep "None of the files" log cd .. -rm -rf temp1