darcs 2.16.2 → 2.16.3
raw patch · 21 files changed
+389/−182 lines, 21 filesdep −sandidep −splitdep ~base16-bytestringdep ~conduitsetup-changedPVP ok
version bump matches the API change (PVP)
Dependencies removed: sandi, split
Dependency ranges changed: base16-bytestring, conduit
API changes (from Hackage documentation)
Files
- CHANGELOG +16/−0
- README.md +48/−23
- Setup.hs +34/−20
- darcs.cabal +3/−5
- harness/Darcs/Test/Patch/Arbitrary/PrimV1.hs +2/−1
- harness/test.hs +2/−0
- release/distributed-context +1/−1
- src/Darcs/Patch/Prim/V1/Coalesce.hs +17/−17
- src/Darcs/UI/Commands/ShowDependencies.hs +60/−24
- src/Darcs/UI/Flags.hs +21/−8
- src/Darcs/UI/PatchHeader.hs +10/−10
- src/Darcs/Util/ByteString.hs +12/−8
- src/Darcs/Util/Hash.hs +14/−17
- src/hscurl.c +3/−6
- tests/conflict-fight-failure.sh +3/−0
- tests/issue1956.sh +38/−0
- tests/issue2353.sh +16/−0
- tests/issue2549-trailing-slash-in-patch-bundle.sh +28/−0
- tests/issue2659-show-dependencies.sh +25/−0
- tests/issue595_get_permissions.sh +14/−26
- tests/record.sh +22/−16
CHANGELOG view
@@ -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.
README.md view
@@ -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 <bugs@darcs.net>. 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 <http://darcs.net/Development/GettingStarted> 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+<http://darcs.net/screened> and `darcs send` them. You are encouraged, but not+required, to look at <http://darcs.net/Development/GettingStarted> 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.
Setup.hs view
@@ -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
darcs.cabal view
@@ -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 <droundy@darcs.net>, <darcs-devel@darcs.net>@@ -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,
harness/Darcs/Test/Patch/Arbitrary/PrimV1.hs view
@@ -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
harness/test.hs view
@@ -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")
release/distributed-context view
@@ -1,1 +1,1 @@-Just "\nContext:\n\n\n[TAG 2.16.2\nBen Franksen <ben.franksen@online.de>**20200819210622\n Ignore-this: 8aeca92b4f3d72a38b97ea681f4f87ea9f13e1a0abb37954596cbc64754cdaf4202fe95d848e9764\n] \n"+Just "\nContext:\n\n\n[TAG 2.16.3\nBen Franksen <ben.franksen@online.de>**20201022094642\n Ignore-this: bd76d7e31488721e4a5ce7267115e71c3b68d680c155c75c3dd275d9e54933a607d208fab502a143\n] \n"
src/Darcs/Patch/Prim/V1/Coalesce.hs view
@@ -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]
src/Darcs/UI/Commands/ShowDependencies.hs view
@@ -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
src/Darcs/UI/Flags.hs view
@@ -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
src/Darcs/UI/PatchHeader.hs view
@@ -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])
src/Darcs/Util/ByteString.hs view
@@ -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
src/Darcs/Util/Hash.hs view
@@ -1,6 +1,7 @@ -- Copyright (C) 2009-2011 Petr Rockai BSD3 -- Copyright (C) 2001, 2004 Ian Lynagh <igloo@earth.li> +{-# 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
src/hscurl.c view
@@ -6,6 +6,8 @@ #include <stdlib.h> #include <string.h> +#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;
tests/conflict-fight-failure.sh view
@@ -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
+ tests/issue1956.sh view
@@ -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 ..
+ tests/issue2353.sh view
@@ -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 ..
+ tests/issue2549-trailing-slash-in-patch-bundle.sh view
@@ -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 ..
+ tests/issue2659-show-dependencies.sh view
@@ -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 ..
tests/issue595_get_permissions.sh view
@@ -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 ../..
tests/record.sh view
@@ -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