darcs 2.5 → 2.5.1

raw patch · 69 files changed

+764/−302 lines, 69 filesdep ~HTTPdep ~containersdep ~directorynew-uploaderbinary-addedPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: HTTP, containers, directory, filepath, mtl, network, text

API changes (from Hackage documentation)

Files

• Distribution/ShellHarness.hs +7/−4
• darcs.cabal +137/−106
• release/distributed-context +1/−1
• src/Darcs/Arguments.lhs +28/−15
• src/Darcs/Commands.lhs +10/−10
• src/Darcs/Commands/Add.lhs +2/−1
• src/Darcs/Commands/AmendRecord.lhs +2/−1
• src/Darcs/Commands/Annotate.lhs +2/−1
• src/Darcs/Commands/Apply.lhs +2/−1
• src/Darcs/Commands/Changes.lhs +2/−1
• src/Darcs/Commands/Check.lhs +2/−1
• src/Darcs/Commands/Convert.lhs +2/−1
• src/Darcs/Commands/Diff.lhs +2/−1
• src/Darcs/Commands/Dist.lhs +3/−7
• src/Darcs/Commands/GZCRCs.lhs +2/−1
• src/Darcs/Commands/Get.lhs +11/−6
• src/Darcs/Commands/Help.lhs +2/−1
• src/Darcs/Commands/Init.lhs +2/−1
• src/Darcs/Commands/MarkConflicts.lhs +2/−1
• src/Darcs/Commands/Move.lhs +2/−1
• src/Darcs/Commands/Optimize.lhs +2/−1
• src/Darcs/Commands/Pull.lhs +4/−2
• src/Darcs/Commands/Push.lhs +2/−1
• src/Darcs/Commands/Put.lhs +2/−1
• src/Darcs/Commands/Record.lhs +2/−1
• src/Darcs/Commands/Remove.lhs +2/−1
• src/Darcs/Commands/Repair.lhs +2/−1
• src/Darcs/Commands/Replace.lhs +3/−6
• src/Darcs/Commands/Revert.lhs +2/−1
• src/Darcs/Commands/Rollback.lhs +2/−1
• src/Darcs/Commands/Send.lhs +5/−4
• src/Darcs/Commands/SetPref.lhs +2/−1
• src/Darcs/Commands/Show.lhs +2/−1
• src/Darcs/Commands/ShowAuthors.lhs +1/−0
• src/Darcs/Commands/ShowBug.lhs +2/−1
• src/Darcs/Commands/ShowContents.lhs +2/−1
• src/Darcs/Commands/ShowFiles.lhs +1/−0
• src/Darcs/Commands/ShowIndex.lhs +1/−0
• src/Darcs/Commands/ShowRepo.lhs +2/−1
• src/Darcs/Commands/ShowTags.lhs +1/−0
• src/Darcs/Commands/Tag.lhs +3/−7
• src/Darcs/Commands/TrackDown.lhs +2/−1
• src/Darcs/Commands/TransferMode.lhs +2/−1
• src/Darcs/Commands/Unrecord.lhs +4/−2
• src/Darcs/Commands/Unrevert.lhs +2/−1
• src/Darcs/Commands/WhatsNew.lhs +2/−1
• src/Darcs/CommandsAux.hs +13/−2
• src/Darcs/Flags.hs +9/−1
• src/Darcs/Patch/Choices.hs +4/−3
• src/Darcs/Patch/Commute.lhs +2/−1
• src/Darcs/Patch/Split.hs +1/−0
• src/Darcs/Repository.hs +9/−3
• src/Darcs/Repository/HashedIO.hs +13/−11
• src/Darcs/Repository/Internal.hs +12/−6
• src/Darcs/Repository/Prefs.lhs +6/−5
• src/Darcs/SelectChanges.hs +5/−4
• src/Darcs/Test/Patch/Info.hs +2/−2
• src/Darcs/Test/Patch/QuickCheck.hs +11/−15
• tests/external.sh +1/−1
• tests/failing-issue2017-missing-tag.sh +85/−0
• tests/failing-issue612_repo_not_writable.sh +39/−0
• tests/hunk-editor.sh +46/−0
• tests/issue1978.sh +35/−0
• tests/issue2035-malicious-subpath.sh +30/−0
• tests/issue612_repo_not_writeable.sh +0/−42
• tests/lib +1/−1
• tests/repoformat.sh +109/−5
• tests/repos/badrepo.tgz binary
• tests/set-default-hint.sh +51/−0

@@ -2,8 +2,10 @@ module Distribution.ShellHarness ( runTests ) where  import Prelude hiding( catch )-import System.Directory ( getCurrentDirectory, setPermissions,-                          Permissions(..), getDirectoryContents,+import System.Directory ( getCurrentDirectory,+                          getPermissions, setPermissions,+                          readable, writable, executable, searchable,+                          getDirectoryContents,                           findExecutable, createDirectoryIfMissing,                           renameFile, removeFile ) import System.Environment ( getEnv, getEnvironment )@@ -110,8 +112,9 @@                  system $ "hpc sum --union --output=" ++ tixdir </> "sum.tix" ++ " " ++ unwords tixfiles                  forM tixfiles $ \f -> removeFile f                  return ()-             mapM_ (\x->-                  setPermissions x (Permissions+             mapM_ (\x-> do+                  p <- getPermissions x+                  setPermissions x (p                                    {readable = True                                    ,writable = True                                    ,executable = False

@@ -1,5 +1,5 @@ Name:           darcs-version:        2.5+version:        2.5.1 License:        GPL License-file:   COPYING Author:         David Roundy <droundy@darcs.net>, <darcs-users@darcs.net>@@ -124,6 +124,8 @@   else     buildable: True +    build-tools: ghc >= 6.10 && < 7.2+     hs-source-dirs:   src     include-dirs:     src     cpp-options:      -DGADT_WITNESSES=1@@ -137,17 +139,23 @@     -- if not mentioned     other-modules:    Darcs.Test.Patch.Check -    extensions:-      CPP-      PatternGuards-      UndecidableInstances-      ScopedTypeVariables-      -- PatternSignatures is needed for GHC 6.8-      PatternSignatures-      RankNTypes-      GADTs-      TypeOperators+    if true+      extensions:+        CPP+        ForeignFunctionInterface+        PatternGuards+        UndecidableInstances+        ScopedTypeVariables+        -- PatternSignatures is needed for GHC 6.8+        PatternSignatures+        RankNTypes+        GADTs+        TypeOperators +    if impl(ghc>=7.0)+      extensions:+        NoMonoLocalBinds+     if os(windows)       hs-source-dirs: src/win32       include-dirs:   src/win32@@ -163,19 +171,19 @@     build-depends:   base          < 5,                      extensible-exceptions >= 0.1 && < 0.2,                      regex-compat >= 0.71 && < 0.94,-                     mtl          >= 1.0 && < 1.2,+                     mtl          >= 1.0 && < 2.1,                      parsec       >= 2.0 && < 3.1,                      html         == 1.0.*,-                     filepath     == 1.1.*,+                     filepath     >= 1.1.0.0 && < 1.3.0.0,                      haskeline    >= 0.6.2.2 && < 0.7,                      hashed-storage >= 0.5.2 && < 0.6,                      base >= 3,                      bytestring >= 0.9.0 && < 0.10,-                     text >= 0.3,+                     text == 0.11.*,                      old-time   == 1.0.*,-                     directory  == 1.0.*,+                     directory  >= 1.0.0.0 && < 1.2.0.0,                      process    == 1.0.*,-                     containers >= 0.1 && < 0.4,+                     containers >= 0.1 && < 0.5,                      array      >= 0.1 && < 0.4,                      random     == 1.0.*,                      tar          == 0.3.*,@@ -186,8 +194,8 @@     if !os(windows)       build-depends: unix >= 1.0 && < 2.5     if flag(http)-        build-depends:    network == 2.2.*,-                          HTTP    >= 3000.0 && < 4000.1+        build-depends:    network >= 2.2 && < 2.4,+                          HTTP    >= 3000.0 && < 4000.2   -- ----------------------------------------------------------------------@@ -200,6 +208,8 @@   else     buildable: True +    build-tools: ghc >= 6.10 && < 7.2+     hs-source-dirs:   src     include-dirs:     src @@ -356,6 +366,7 @@                       System.Posix.Files                       System.Posix.IO       cpp-options:    -DWIN32+      c-sources:      src/win32/send_email.c       build-depends:  unix-compat >= 0.1.2,                       regex-posix >= 0.94.4 && < 0.95 @@ -365,10 +376,10 @@     build-depends:   base          < 5,                      extensible-exceptions >= 0.1 && < 0.2,                      regex-compat >= 0.71 && < 0.94,-                     mtl          >= 1.0 && < 1.2,+                     mtl          >= 1.0 && < 2.1,                      parsec       >= 2.0 && < 3.1,                      html         == 1.0.*,-                     filepath     == 1.1.*,+                     filepath     >= 1.1.0.0 && < 1.3.0.0,                      haskeline    >= 0.6.2.2 && < 0.7,                      hashed-storage >= 0.5.2 && < 0.6,                      tar          == 0.3.*@@ -378,11 +389,11 @@      build-depends: base >= 3,                    bytestring >= 0.9.0 && < 0.10,-                   text >= 0.3,+                   text == 0.11.*,                    old-time   == 1.0.*,-                   directory  == 1.0.*,+                   directory  >= 1.0.0.0 && < 1.2.0.0,                    process    == 1.0.*,-                   containers >= 0.1 && < 0.4,+                   containers >= 0.1 && < 0.5,                    array      >= 0.1 && < 0.4,                    random     == 1.0.* @@ -408,8 +419,8 @@       cc-options:        -DHAVE_CURL      if flag(http)-        build-depends:    network == 2.2.*,-                          HTTP    >= 3000.0 && < 4000.1+        build-depends:    network >= 2.2 && < 2.4,+                          HTTP    >= 3000.0 && < 4000.2         cpp-options:      -DHAVE_HTTP         x-have-http: @@ -430,29 +441,34 @@     if flag(color)       x-use-color: -    extensions:-      CPP,-      ForeignFunctionInterface,-      BangPatterns,-      PatternGuards,-      MagicHash,-      UndecidableInstances,-      DeriveDataTypeable,-      GADTs,-      TypeOperators,-      ExistentialQuantification,-      FlexibleContexts,-      FlexibleInstances,-      ScopedTypeVariables,-      -- PatternSignatures is needed for GHC 6.8-      PatternSignatures,-      KindSignatures,-      TypeSynonymInstances,-      Rank2Types,-      RankNTypes,-      GeneralizedNewtypeDeriving,-      MultiParamTypeClasses+    if true+      extensions:+        CPP,+        ForeignFunctionInterface,+        BangPatterns,+        PatternGuards,+        MagicHash,+        UndecidableInstances,+        DeriveDataTypeable,+        GADTs,+        TypeOperators,+        ExistentialQuantification,+        FlexibleContexts,+        FlexibleInstances,+        ScopedTypeVariables,+        -- PatternSignatures is needed for GHC 6.8+        PatternSignatures,+        KindSignatures,+        TypeSynonymInstances,+        Rank2Types,+        RankNTypes,+        GeneralizedNewtypeDeriving,+        MultiParamTypeClasses +    if impl(ghc>=7.0)+      extensions:+        NoMonoLocalBinds+ -- ---------------------------------------------------------------------- -- darcs itself -- ----------------------------------------------------------------------@@ -467,6 +483,8 @@                     src/umask.c                     src/Crypt/sha2.c +  build-tools: ghc >= 6.10 && < 7.2+   -- We need optimizations, regardless of what Hackage says   -- Note: "if true" works around a cabal bug with order of flag composition   if true@@ -506,10 +524,10 @@   build-depends:   base          < 5,                    extensible-exceptions >= 0.1 && < 0.2,                    regex-compat >= 0.71 && < 0.94,-                   mtl          >= 1.0 && < 1.2,+                   mtl          >= 1.0 && < 2.1,                    parsec       >= 2.0 && < 3.1,                    html         == 1.0.*,-                   filepath     == 1.1.*,+                   filepath     >= 1.1.0.0 && < 1.3.0.0,                    haskeline    >= 0.6.2.2 && < 0.7,                    hashed-storage >= 0.5.2 && < 0.6,                    tar          == 0.3.*@@ -519,11 +537,11 @@    build-depends: base >= 3,                  bytestring >= 0.9.0 && < 0.10,-                 text >= 0.3,+                 text == 0.11.*,                    old-time   == 1.0.*,-                   directory  == 1.0.*,+                   directory  >= 1.0.0.0 && < 1.2.0.0,                    process    == 1.0.*,-                   containers >= 0.1 && < 0.4,+                   containers >= 0.1 && < 0.5,                    array      >= 0.1 && < 0.4,                    random     == 1.0.* @@ -535,8 +553,8 @@     cc-options:        -DHAVE_CURL    if flag(http)-      build-depends:    network == 2.2.*,-                        HTTP    >= 3000.0 && < 4000.1+      build-depends:    network >= 2.2 && < 2.4,+                        HTTP    >= 3000.0 && < 4000.2       cpp-options:      -DHAVE_HTTP       x-have-http: @@ -557,29 +575,34 @@   if flag(color)     x-use-color: -  extensions:-    CPP,-    ForeignFunctionInterface,-    BangPatterns,-    PatternGuards,-    MagicHash,-    UndecidableInstances,-    DeriveDataTypeable,-    GADTs,-    TypeOperators,-    ExistentialQuantification,-    FlexibleContexts,-    FlexibleInstances,-    ScopedTypeVariables,-    -- PatternSignatures is needed for GHC 6.8-    PatternSignatures,-    KindSignatures,-    TypeSynonymInstances,-    Rank2Types,-    RankNTypes,-    GeneralizedNewtypeDeriving,-    MultiParamTypeClasses+  if true+    extensions:+      CPP,+      ForeignFunctionInterface,+      BangPatterns,+      PatternGuards,+      MagicHash,+      UndecidableInstances,+      DeriveDataTypeable,+      GADTs,+      TypeOperators,+      ExistentialQuantification,+      FlexibleContexts,+      FlexibleInstances,+      ScopedTypeVariables,+      -- PatternSignatures is needed for GHC 6.8+      PatternSignatures,+      KindSignatures,+      TypeSynonymInstances,+      Rank2Types,+      RankNTypes,+      GeneralizedNewtypeDeriving,+      MultiParamTypeClasses +  if impl(ghc>=7.0)+    extensions:+      NoMonoLocalBinds+ -- ---------------------------------------------------------------------- -- unit test driver -- ----------------------------------------------------------------------@@ -591,13 +614,16 @@     buildable: False   else     buildable: True++    build-tools: ghc >= 6.10 && < 7.2+     build-depends:   base          < 5,                      extensible-exceptions >= 0.1 && < 0.2,                      regex-compat >= 0.71 && < 0.94,-                     mtl          >= 1.0 && < 1.2,+                     mtl          >= 1.0 && < 2.1,                      parsec       >= 2.0 && < 3.1,                      html         == 1.0.*,-                     filepath     == 1.1.*,+                     filepath     >= 1.1.0.0 && < 1.3.0.0,                      QuickCheck   >= 2.1.0.0,                      HUnit        >= 1.0,                      test-framework             >= 0.2.2,@@ -657,11 +683,11 @@     build-depends: base >= 3,                    bytestring >= 0.9.0 && < 0.10,                    haskeline    >= 0.6.2.2 && < 0.7,-                   text >= 0.3,+                   text == 0.11.*,                    old-time   == 1.0.*,-                   directory  == 1.0.*,+                   directory  >= 1.0.0.0 && < 1.2.0.0,                    process    == 1.0.*,-                   containers >= 0.1 && < 0.4,+                   containers >= 0.1 && < 0.5,                    array      >= 0.1 && < 0.4,                    hashed-storage >= 0.5.2 && < 0.6,                    random     == 1.0.*@@ -678,32 +704,37 @@       cpp-options:      -DHAVE_TERMINFO      if flag(http)-        build-depends:    network == 2.2.*,-                          HTTP    >= 3000.0 && < 4000.1+        build-depends:    network >= 2.2 && < 2.4,+                          HTTP    >= 3000.0 && < 4000.2      if flag(color)       x-use-color: -    extensions:-      CPP,-      ForeignFunctionInterface,-      BangPatterns,-      PatternGuards,-      MagicHash,-      UndecidableInstances,-      DeriveDataTypeable,-      GADTs,-      TypeOperators,-      ExistentialQuantification,-      FlexibleContexts,-      FlexibleInstances,-      ScopedTypeVariables,-      -- PatternSignatures is needed for GHC 6.8-      PatternSignatures,-      KindSignatures,-      TypeSynonymInstances,-      Rank2Types,-      RankNTypes,-      GeneralizedNewtypeDeriving,-      MultiParamTypeClasses-      OverlappingInstances+    if true+      extensions:+        CPP,+        ForeignFunctionInterface,+        BangPatterns,+        PatternGuards,+        MagicHash,+        UndecidableInstances,+        DeriveDataTypeable,+        GADTs,+        TypeOperators,+        ExistentialQuantification,+        FlexibleContexts,+        FlexibleInstances,+        ScopedTypeVariables,+        -- PatternSignatures is needed for GHC 6.8+        PatternSignatures,+        KindSignatures,+        TypeSynonymInstances,+        Rank2Types,+        RankNTypes,+        GeneralizedNewtypeDeriving,+        MultiParamTypeClasses+        OverlappingInstances++    if impl(ghc>=7.0)+      extensions:+        NoMonoLocalBinds

@@ -1,1 +1,1 @@-Just "\nContext:\n\n[TAG 2.5\nReinier Lamers <tux_rocker@reinier.de>**20101024151805\n Ignore-this: 1561ce30bfb1950a440c03371e0e2f20\n] \n"+Just "\nContext:\n\n[TAG 2.5.1\nGanesh Sittampalam <ganesh@earth.li>**20110210233529\n Ignore-this: 9e4daeb4ceaf1c2743235c68564c519b\n] \n"

@@ -271,8 +271,8 @@ getContent NonVerify = NoContent getContent NonForce = NoContent getContent DryRun = NoContent-getContent SetDefault = NoContent-getContent NoSetDefault = NoContent+getContent (SetDefault _) = NoContent+getContent (NoSetDefault _) = NoContent getContent FancyMoveAdd = NoContent getContent NoFancyMoveAdd = NoContent getContent Disable = NoContent@@ -347,6 +347,7 @@                           _ -> False  isin :: DarcsAtomicOption -> [DarcsFlag] -> Bool+(DarcsInternalOption f)             `isin` fs = f `elem` fs (DarcsNoArgOption _ _ f _)          `isin` fs = f `elem` fs (DarcsArgOption _ _ f _ _)          `isin` fs = any (`isa` f) fs (DarcsAbsPathOption _ _ f _ _)      `isin` fs = any (`isAnAbsolute` f) fs@@ -390,6 +391,11 @@     -- ^ @DarcsNoArgOption shortSwitches longSwitches mkFlag optDescr@     -- The constructon fon options with no arguments. +    | DarcsInternalOption DarcsFlag+    -- ^ @DarcsInternalOption@+    -- An option just for internal use (e.g. defaulting), not directly available to the user.++ data DarcsOption     = DarcsSingleOption DarcsAtomicOption     | DarcsMultipleChoiceOption [DarcsAtomicOption]@@ -423,6 +429,7 @@                      | otherwise = x : clear xs         clear [] = []         flags (DarcsNoArgOption _ _ fl _:xs) = fl : flags xs+        flags (DarcsInternalOption fl:xs) = fl : flags xs         flags (_:xs) = flags xs         flags [] = [] nubOptions (_:options) opts = nubOptions options opts@@ -433,15 +440,16 @@   getSetter (DarcsMutuallyExclusive _ f) = Just f   getSetter _ = Nothing -optionFromDarcsAtomicOption :: AbsolutePath -> DarcsAtomicOption -> OptDescr DarcsFlag-optionFromDarcsAtomicOption _ (DarcsNoArgOption a b c h) = Option a b (NoArg c) h-optionFromDarcsAtomicOption _ (DarcsArgOption a b c n h) = Option a b (ReqArg c n) h+optionFromDarcsAtomicOption :: AbsolutePath -> DarcsAtomicOption -> Maybe (OptDescr DarcsFlag)+optionFromDarcsAtomicOption wd (DarcsInternalOption _) = Nothing+optionFromDarcsAtomicOption _ (DarcsNoArgOption a b c h) = Just $ Option a b (NoArg c) h+optionFromDarcsAtomicOption _ (DarcsArgOption a b c n h) = Just $ Option a b (ReqArg c n) h optionFromDarcsAtomicOption wd (DarcsAbsPathOrStdOption a b c n h) =-  Option a b (ReqArg (c . makeAbsoluteOrStd wd) n) h+  Just $ Option a b (ReqArg (c . makeAbsoluteOrStd wd) n) h optionFromDarcsAtomicOption wd (DarcsAbsPathOption a b c n h) =-  Option a b (ReqArg (c . makeAbsolute wd) n) h+  Just $ Option a b (ReqArg (c . makeAbsolute wd) n) h optionFromDarcsAtomicOption wd (DarcsOptAbsPathOption a b d c n h) =-  Option a b (OptArg (c . makeAbsolute wd . fromMaybe d) n) h+  Just $ Option a b (OptArg (c . makeAbsolute wd . fromMaybe d) n) h  atomicOptions :: DarcsOption -> [DarcsAtomicOption] atomicOptions (DarcsSingleOption x) = [x]@@ -449,7 +457,7 @@ atomicOptions (DarcsMutuallyExclusive xs _) = xs  optionFromDarcsOption :: AbsolutePath -> DarcsOption -> [OptDescr DarcsFlag]-optionFromDarcsOption wd = map (optionFromDarcsAtomicOption wd) . atomicOptions+optionFromDarcsOption wd = mapMaybe (optionFromDarcsAtomicOption wd) . atomicOptions  -- | 'concat_option' creates a DarcsMultipleChoiceOption from a list of -- option, flattening any DarcsMultipleChoiceOption in the list.@@ -1098,13 +1106,17 @@  setDefault :: Bool -> DarcsOption setDefault wantYes-  | wantYes   = mkMutuallyExclusive [] yes [no]-  | otherwise = mkMutuallyExclusive [yes] no []+  | wantYes   = mkMutuallyExclusive [yes,no] defaultyes []+  | otherwise = mkMutuallyExclusive [yes,no] defaultno  []  where-  yes = ( DarcsNoArgOption [] ["set-default"], SetDefault-        , "set default repository" )-  no  = ( DarcsNoArgOption [] ["no-set-default"], NoSetDefault-        , "don't set default repository" )+  yes = ( DarcsNoArgOption [] ["set-default"], SetDefault True+        , "set default repository" ++ defaultText wantYes )+  no  = ( DarcsNoArgOption [] ["no-set-default"], NoSetDefault True+        , "don't set default repository" ++ defaultText (not wantYes) )+  defaultyes = ( \f _ -> DarcsInternalOption f, SetDefault False, "" )+  defaultno = ( \f _ -> DarcsInternalOption f, NoSetDefault False, "" )+  defaultText True = " [DEFAULT]"+  defaultText False = ""  verify = DarcsMultipleChoiceOption          [DarcsAbsPathOption [] ["verify"] Verify "PUBRING"@@ -1397,6 +1409,7 @@ optionListLatex (DarcsMutuallyExclusive os _) = unlines (map optionLatex os)  optionLatex :: DarcsAtomicOption -> String+optionLatex (DarcsInternalOption _) = "" optionLatex (DarcsNoArgOption a b _ h) =     showShortOptions a ++ showLongOptions b ++ latexHelp h ++ "\\\\" optionLatex (DarcsArgOption a b _ arg h) =

@@ -17,7 +17,7 @@  \begin{code} module Darcs.Commands ( CommandControl( CommandData, HiddenCommand, GroupName ),-                       DarcsCommand( DarcsCommand, commandName,+                       DarcsCommand( DarcsCommand, commandProgramName, commandName,                                      commandHelp, commandDescription,                                      commandBasicOptions, commandAdvancedOptions,                                      commandCommand,@@ -128,7 +128,7 @@                     | GroupName String  data DarcsCommand =-    DarcsCommand {commandName, commandHelp, commandDescription :: String,+    DarcsCommand {commandProgramName, commandName, commandHelp, commandDescription :: String,                   commandExtraArgs :: Int,                   commandExtraArgHelp :: [String],                   commandCommand :: [DarcsFlag] -> [String] -> IO (),@@ -137,7 +137,7 @@                   commandArgdefaults :: [DarcsFlag] -> AbsolutePath -> [String] -> IO [String],                   commandBasicOptions :: [DarcsOption],                   commandAdvancedOptions :: [DarcsOption]}-  | SuperCommand {commandName, commandHelp, commandDescription :: String,+  | SuperCommand {commandProgramName, commandName, commandHelp, commandDescription :: String,                   commandPrereq :: [DarcsFlag] -> IO (Either String ()),                   commandSubCommands :: [CommandControl]} @@ -171,9 +171,9 @@ commandAlias :: String -> Maybe DarcsCommand -> DarcsCommand -> DarcsCommand commandAlias n msuper c =   c { commandName = n-    , commandDescription = "Alias for `darcs " ++ cmdName ++ "'."-    , commandHelp = "The `darcs " ++ n ++ "' command is an alias for " ++-                     "`darcs " ++ cmdName ++ "'.\n" +++    , commandDescription = "Alias for `" ++ commandProgramName c ++ " " ++ cmdName ++ "'."+    , commandHelp = "The `" ++ commandProgramName c ++ " " ++ n ++ "' command is an alias for " +++                     "`" ++ commandProgramName c ++ " " ++ cmdName ++ "'.\n" ++                      commandHelp c     }  where@@ -201,7 +201,7 @@ subusage :: DarcsCommand -> String subusage super =     (usageInfo-     ("Usage: darcs "++commandName super++" SUBCOMMAND ... " +++     ("Usage: " ++ commandProgramName super ++ " "++commandName super++" SUBCOMMAND ... " ++       "\n\n"++ commandDescription super++       "\n\nSubcommands:\n" ++ usageHelper (getSubcommands super) ++ "\nOptions:")      (optionFromDarcsOption rootDirectory help))@@ -228,7 +228,7 @@ getCommandMiniHelp :: Maybe DarcsCommand -> DarcsCommand -> String getCommandMiniHelp msuper cmd =   getCommandHelpCore msuper cmd ++-  "\n\nSee darcs help "+  "\n\nSee " ++ commandProgramName cmd ++ " help "   ++ (maybe "" (\c -> commandName c ++ " ") msuper)   ++ commandName cmd ++ " for details." @@ -256,11 +256,11 @@  getCommandHelpCore :: Maybe DarcsCommand -> DarcsCommand -> String getCommandHelpCore msuper cmd =-    "Usage: darcs "++superName msuper++commandName cmd+++    "Usage: " ++ commandProgramName cmd ++ " "++superName msuper++commandName cmd++     " [OPTION]... " ++ unwords args_help ++     "\n"++ commandDescription cmd     where args_help = case cmd of-            (DarcsCommand _ _ _ _ _ _ _ _ _ _ _) ->+            (DarcsCommand {}) ->               commandExtraArgHelp cmd             _ -> [] 

@@ -69,7 +69,8 @@  "Adding symbolic links (symlinks) is not supported.\n\n"  add :: DarcsCommand-add = DarcsCommand {commandName = "add",+add = DarcsCommand {commandProgramName = "darcs",+                    commandName = "add",                     commandHelp = addHelp ++ addHelp' ++ addHelp'',                     commandDescription = addDescription,                     commandExtraArgs = -1,

@@ -103,7 +103,8 @@  "On Windows use C:/Documents And Settings/user/Application Data/darcs/defaults\n"  amendrecord :: DarcsCommand-amendrecord = DarcsCommand {commandName = "amend-record",+amendrecord = DarcsCommand {commandProgramName = "darcs",+                            commandName = "amend-record",                             commandHelp = amendrecordHelp,                             commandDescription = amendrecordDescription,                             commandExtraArgs = -1,

@@ -83,7 +83,8 @@  "option can be used to generate output for machine postprocessing.\n"  annotate :: DarcsCommand-annotate = DarcsCommand {commandName = "annotate",+annotate = DarcsCommand {commandProgramName = "darcs",+                         commandName = "annotate",                          commandHelp = annotateHelp,                          commandDescription = annotateDescription,                          commandExtraArgs = -1,

@@ -122,7 +122,8 @@ stdindefault _ [] = return ["-"] stdindefault _ x = return x apply :: DarcsCommand-apply = DarcsCommand {commandName = "apply",+apply = DarcsCommand {commandProgramName = "darcs",+                      commandName = "apply",                       commandHelp = applyHelp ++ "\n" ++ applyHelp',                       commandDescription = applyDescription,                       commandExtraArgs = 1,

@@ -85,7 +85,8 @@  "\n" ++ changesHelp''  changes :: DarcsCommand-changes = DarcsCommand {commandName = "changes",+changes = DarcsCommand {commandProgramName = "darcs",+                        commandName = "changes",                         commandHelp = changesHelp,                         commandDescription = changesDescription,                         commandExtraArgs = -1,

@@ -62,7 +62,8 @@  "by `darcs check'.  Use the --no-test option to disable this.\n"  check :: DarcsCommand-check = DarcsCommand {commandName = "check",+check = DarcsCommand {commandProgramName = "darcs",+                      commandName = "check",                       commandHelp = checkHelp,                       commandDescription = checkDescription,                       commandExtraArgs = 0,

@@ -116,7 +116,8 @@  "than once.)\n"  convert :: DarcsCommand-convert = DarcsCommand {commandName = "convert",+convert = DarcsCommand {commandProgramName = "darcs",+                    commandName = "convert",                     commandHelp = convertHelp,                     commandDescription = convertDescription,                     commandExtraArgs = -1,

@@ -75,7 +75,8 @@  "formatted as the output of a diff command\n"  diffCommand :: DarcsCommand-diffCommand = DarcsCommand {commandName = "diff",+diffCommand = DarcsCommand {commandProgramName = "darcs",+                             commandName = "diff",                              commandHelp = diffHelp,                              commandDescription = diffDescription,                              commandExtraArgs = -1,

@@ -31,12 +31,7 @@ import Prelude hiding ( writeFile ) import Data.ByteString.Lazy ( writeFile ) -import Darcs.Commands ( DarcsCommand(DarcsCommand, commandName, commandHelp,-                        commandDescription, commandExtraArgs,-                        commandExtraArgHelp, commandCommand,-                        commandPrereq, commandGetArgPossibilities,-                        commandArgdefaults,-                        commandAdvancedOptions, commandBasicOptions),+import Darcs.Commands ( DarcsCommand(..),                         nodefaults ) import Darcs.Arguments ( DarcsFlag(Verbose, DistName), distnameOption,                          workingRepoDir, matchOne, storeInMemory,@@ -85,7 +80,8 @@  -}  dist :: DarcsCommand-dist = DarcsCommand {commandName = "dist",+dist = DarcsCommand {commandProgramName = "darcs",+                     commandName = "dist",                      commandHelp = distHelp,                      commandDescription = distDescription,                      commandExtraArgs = 0,

@@ -119,7 +119,8 @@       when verbose $ hPutStrLn stderr $ unlines ("The following corrupt files were found:":files)  gzcrcs :: DarcsCommand-gzcrcs = DarcsCommand {commandName = "gzcrcs",+gzcrcs = DarcsCommand {commandProgramName = "darcs",+                       commandName = "gzcrcs",                        commandHelp = gzcrcsHelp,                        commandDescription = gzcrcsDescription,                        commandExtraArgs = 0,

@@ -117,7 +117,8 @@  "is required.\n"  get :: DarcsCommand-get = DarcsCommand {commandName = "get",+get = DarcsCommand {commandProgramName = "darcs",+                    commandName = "get",                     commandHelp = getHelp,                     commandDescription = getDescription,                     commandExtraArgs = -1,@@ -200,11 +201,15 @@                                    debugMessage "Identifying and copying repository..."                                    copyRepoHashed repository                                | hashUs -> do-                                   putInfo opts $  text "Converting old-fashioned repository to hashed format..."-                                               $$ text "*******************************************************************************"-                                               $$ text "Fetching a hashed repository would be faster.  Perhaps you could persuade"-                                               $$ text "the maintainer to run darcs optimize --upgrade with darcs 2.4.0 or higher?"-                                               $$ text "*******************************************************************************"+                                   putInfo opts $ text "***********************************************************************"+                                               $$ text "  _______   Sorry for the wait! The repository you are fetching is"+                                               $$ text " |       |  using the DEPRECATED 'old-fashioned' format. I'm getting a"+                                               $$ text " | O   O |  hashed copy instead, but this may take a while."+                                               $$ text " |  ___  |"+                                               $$ text " | /   \\ |  We recommend that the maintainer upgrade the remote copy"+                                               $$ text " |_______|  as well. See http://wiki.darcs.net/OF for more information."+                                               $$ text ""+                                               $$ text "***********************************************************************"                                    copyRepoHashed repository                                | hashThem -> do                                    putInfo opts $ text "Fetching a hashed repository as an old-fashioned one..."

@@ -53,7 +53,8 @@  "`darcs help foo' prints detailed help about the darcs command foo.\n"  help :: DarcsCommand-help = DarcsCommand {commandName = "help",+help = DarcsCommand {commandProgramName = "darcs",+                     commandName = "help",                      commandHelp = helpHelp,                      commandDescription = helpDescription,                      commandExtraArgs = -1,

@@ -70,7 +70,8 @@  "Initialize is commonly abbreviated to `init'.\n"  initialize :: DarcsCommand-initialize = DarcsCommand {commandName = "initialize",+initialize = DarcsCommand {commandProgramName = "darcs",+                         commandName = "initialize",                          commandHelp = initializeHelp,                          commandDescription = initializeDescription,                          commandExtraArgs = 0,

@@ -64,7 +64,8 @@  "alias still exists for backwards-compatibility.\n"  markconflicts :: DarcsCommand-markconflicts = DarcsCommand {commandName = "mark-conflicts",+markconflicts = DarcsCommand {commandProgramName = "darcs",+                              commandName = "mark-conflicts",                               commandHelp = markconflictsHelp,                               commandDescription = markconflictsDescription,                               commandExtraArgs = 0,

@@ -74,7 +74,8 @@  "unusable on those systems!\n"  move :: DarcsCommand-move = DarcsCommand {commandName = "move",+move = DarcsCommand {commandProgramName = "darcs",+                   commandName = "move",                    commandHelp = moveHelp,                    commandDescription = moveDescription,                    commandExtraArgs = -1,

@@ -122,7 +122,8 @@  "unversioned files in _darcs/prefs/ (such as _darcs/prefs/author).\n"  optimize :: DarcsCommand-optimize = DarcsCommand {commandName = "optimize",+optimize = DarcsCommand {commandProgramName = "darcs",+                         commandName = "optimize",                          commandHelp = optimizeHelp,                          commandDescription = optimizeDescription,                          commandExtraArgs = 0,

@@ -111,7 +111,8 @@  fetch :: DarcsCommand fetch = DarcsCommand {-         commandName = "fetch",+         commandProgramName = "darcs",+	 commandName = "fetch",          commandHelp = fetchHelp,          commandDescription = fetchDescription,          commandExtraArgs = -1,@@ -134,7 +135,8 @@                                   allowUnrelatedRepos]}  pull :: DarcsCommand-pull = DarcsCommand {commandName = "pull",+pull = DarcsCommand {commandProgramName = "darcs",+                     commandName = "pull",                      commandHelp = pullHelp,                      commandDescription = pullDescription,                      commandExtraArgs = -1,

@@ -75,7 +75,8 @@  "current repository into another repository.\n"  push :: DarcsCommand-push = DarcsCommand {commandName = "push",+push = DarcsCommand {commandProgramName = "darcs",+                     commandName = "push",                      commandHelp = pushHelp,                      commandDescription = pushDescription,                      commandExtraArgs = 1,

@@ -55,7 +55,8 @@  "appropriate.  See those commands for an explanation of each option.\n"  put ::DarcsCommand-put = DarcsCommand {commandName = "put",+put = DarcsCommand {commandProgramName = "darcs",+                    commandName = "put",                     commandHelp = putHelp,                     commandDescription = putDescription,                     commandExtraArgs = 1,

@@ -91,7 +91,8 @@  "\n" ++ recordHelp''  record :: DarcsCommand-record = DarcsCommand {commandName = "record",+record = DarcsCommand {commandProgramName = "darcs",+                       commandName = "record",                        commandHelp = recordHelp,                        commandDescription = recordDescription,                        commandExtraArgs = -1,

@@ -65,7 +65,8 @@  "the patch) will ALWAYS affect the working tree of that repository.\n"  remove :: DarcsCommand-remove = DarcsCommand {commandName = "remove",+remove = DarcsCommand {commandProgramName = "darcs",+                       commandName = "remove",                        commandHelp = removeHelp,                        commandDescription = removeDescription,                        commandExtraArgs = -1,

@@ -40,7 +40,8 @@  "which is where most corruption occurs.\n"  repair :: DarcsCommand-repair = DarcsCommand {commandName = "repair",+repair = DarcsCommand {commandProgramName = "darcs",+                       commandName = "repair",                        commandHelp = repairHelp,                        commandDescription = repairDescription,                        commandExtraArgs = 0,

@@ -26,11 +26,7 @@ import Control.Monad ( unless, filterM ) import Control.Applicative( (<$>) ) -import Darcs.Commands ( DarcsCommand(DarcsCommand, commandName, commandHelp,-                        commandDescription, commandExtraArgs,-                        commandExtraArgHelp, commandCommand, commandPrereq,-                        commandGetArgPossibilities, commandArgdefaults,-                        commandAdvancedOptions, commandBasicOptions),+import Darcs.Commands ( DarcsCommand(..),                         nodefaults ) import Darcs.Arguments ( DarcsFlag(ForceReplace, Toks), listRegisteredFiles,                          ignoretimes, umaskOption, tokens, forceReplace,@@ -146,7 +142,8 @@ \begin{code}  replace :: DarcsCommand-replace = DarcsCommand {commandName = "replace",+replace = DarcsCommand {commandProgramName = "darcs",+                        commandName = "replace",                         commandHelp = replaceHelp,                         commandDescription = replaceDescription,                         commandExtraArgs = -1,

@@ -65,7 +65,8 @@  "revert' ran.\n"  revert :: DarcsCommand-revert = DarcsCommand {commandName = "revert",+revert = DarcsCommand {commandProgramName = "darcs",+                       commandName = "revert",                        commandHelp = revertHelp,                        commandDescription = revertDescription,                        commandExtraArgs = -1,

@@ -79,7 +79,8 @@  "of its changes.\n"  rollback :: DarcsCommand-rollback = DarcsCommand {commandName = "rollback",+rollback = DarcsCommand {commandProgramName = "darcs",+                         commandName = "rollback",                          commandHelp = rollbackHelp,                          commandDescription = rollbackDescription,                          commandExtraArgs = -1,

@@ -115,7 +115,8 @@  \begin{code} send :: DarcsCommand-send = DarcsCommand {commandName = "send",+send = DarcsCommand {commandProgramName = "darcs",+                     commandName = "send",                      commandHelp = sendHelp,                      commandDescription = sendDescription,                      commandExtraArgs = 1,@@ -152,12 +153,12 @@         here <- getCurrentDirectory         when (repodir == toFilePath here) $            fail ("Can't send to current repository! Did you mean send --context?")-        repo <- identifyRepositoryFor repository repodir-        them <- readRepo repo         old_default <- getPreflist "defaultrepo"-        setDefaultrepo repodir input_opts         when (old_default == [repodir] && not (Quiet `elem` input_opts)) $              putStrLn $ "Creating patch to "++formatPath repodir++"..."+        repo <- identifyRepositoryFor repository repodir+        them <- readRepo repo+        setDefaultrepo repodir input_opts         wtds <- decideOnBehavior input_opts repo         sendToThem repository input_opts wtds repodir them     where the_context [] = return Nothing

@@ -73,7 +73,8 @@  "low-priority bug, because preferences are seldom set.\n"  setpref :: DarcsCommand-setpref = DarcsCommand {commandName = "setpref",+setpref = DarcsCommand {commandProgramName = "darcs",+                        commandName = "setpref",                         commandHelp = setprefHelp,                         commandDescription = setprefDescription,                         commandExtraArgs = 2,

@@ -43,7 +43,8 @@  "Currently this is a deprecated alias.\n"  showCommand :: DarcsCommand-showCommand = SuperCommand {commandName = "show",+showCommand = SuperCommand {commandProgramName = "darcs",+                      commandName = "show",                       commandHelp = showHelp,                       commandDescription = showDescription,                       commandPrereq = amInRepository,

@@ -89,6 +89,7 @@  showAuthors :: DarcsCommand showAuthors = DarcsCommand {+  commandProgramName = "darcs",   commandName = "authors",   commandHelp = showAuthorsHelp,   commandDescription = showAuthorsDescription,

@@ -36,7 +36,8 @@   ++"a bug in darcs.\n"  showBug :: DarcsCommand-showBug = DarcsCommand {commandName = "bug",+showBug = DarcsCommand {commandProgramName = "darcs",+                         commandName = "bug",                          commandHelp = showBugHelp,                          commandDescription = showBugDescription,                          commandExtraArgs = 0,

@@ -48,7 +48,8 @@   "version of the file(s).\n"  showContents :: DarcsCommand-showContents = DarcsCommand {commandName = "contents",+showContents = DarcsCommand {commandProgramName = "darcs",+                              commandName = "contents",                               commandHelp = showContentsHelp,                               commandDescription = showContentsDescription,                               commandExtraArgs = -1,

@@ -67,6 +67,7 @@  showFiles :: DarcsCommand showFiles = DarcsCommand {+  commandProgramName = "darcs",   commandName = "files",   commandHelp = showFilesHelp,   commandDescription = showFilesDescription,

@@ -44,6 +44,7 @@  showIndex :: DarcsCommand showIndex = DarcsCommand {+  commandProgramName = "darcs",   commandName = "index",   commandDescription = "Dump contents of working tree index.",   commandHelp =

@@ -56,7 +56,8 @@ showRepoDescription = "Show repository summary information"  showRepo :: DarcsCommand-showRepo = DarcsCommand { commandName = "repo",+showRepo = DarcsCommand { commandProgramName = "darcs",+                           commandName = "repo",                            commandHelp = showRepoHelp,                            commandDescription = showRepoDescription,                            commandExtraArgs = 0,

@@ -42,6 +42,7 @@  showTags :: DarcsCommand showTags = DarcsCommand {+  commandProgramName = "darcs",   commandName = "tags",   commandHelp = showTagsHelp,   commandDescription = showTagsDescription,

@@ -21,12 +21,7 @@ import System.Directory ( removeFile ) import Control.Monad ( when ) -import Darcs.Commands ( DarcsCommand(DarcsCommand, commandName, commandHelp,-                        commandDescription, commandExtraArgs,-                        commandExtraArgHelp, commandCommand, commandPrereq,-                        commandGetArgPossibilities, commandArgdefaults,-                        commandAdvancedOptions, commandBasicOptions),-                        nodefaults )+import Darcs.Commands ( DarcsCommand(..), nodefaults ) import Darcs.Arguments ( nocompress, umaskOption, patchnameOption, author,                          pipeInteractive, askLongComment,                          workingRepoDir, getAuthor )@@ -71,7 +66,8 @@  "described in `darcs record'.\n"  tag :: DarcsCommand-tag = DarcsCommand {commandName = "tag",+tag = DarcsCommand {commandProgramName = "darcs",+                    commandName = "tag",                     commandHelp = tagHelp,                     commandDescription = tagDescription,                     commandExtraArgs = -1,

@@ -60,7 +60,8 @@  "found at random."  trackdown :: DarcsCommand-trackdown = DarcsCommand {commandName = "trackdown",+trackdown = DarcsCommand {commandProgramName = "darcs",+                          commandName = "trackdown",                           commandHelp = trackdownHelp,                           commandDescription = trackdownDescription,                           commandExtraArgs = -1,

@@ -52,7 +52,8 @@  "hundreds of times!\n"  transferMode :: DarcsCommand-transferMode = DarcsCommand {commandName = "transfer-mode",+transferMode = DarcsCommand {commandProgramName = "darcs",+                              commandName = "transfer-mode",                               commandHelp = transferModeHelp,                               commandDescription = transferModeDescription,                               commandExtraArgs = 0,

@@ -147,7 +147,8 @@  "another user may have already pulled the patch.\n"  unrecord :: DarcsCommand-unrecord = DarcsCommand {commandName = "unrecord",+unrecord = DarcsCommand {commandProgramName = "darcs",+                         commandName = "unrecord",                          commandHelp = unrecordHelp,                          commandDescription = unrecordDescription,                          commandExtraArgs = 0,@@ -272,7 +273,8 @@  \begin{code} obliterate :: DarcsCommand-obliterate = DarcsCommand {commandName = "obliterate",+obliterate = DarcsCommand {commandProgramName = "darcs",+                           commandName = "obliterate",                            commandHelp = obliterateHelp,                            commandDescription = obliterateDescription,                            commandExtraArgs = 0,

@@ -71,7 +71,8 @@  "interactive command that will DEFINITELY prevent unreversion.\n"  unrevert :: DarcsCommand-unrevert = DarcsCommand {commandName = "unrevert",+unrevert = DarcsCommand {commandProgramName = "darcs",+                         commandName = "unrevert",                          commandHelp = unrevertHelp,                          commandDescription = unrevertDescription,                          commandExtraArgs = 0,

@@ -91,7 +91,8 @@  "there are no unrecorded changes.\n"  whatsnew :: DarcsCommand-whatsnew = DarcsCommand {commandName = "whatsnew",+whatsnew = DarcsCommand {commandProgramName = "darcs",+                         commandName = "whatsnew",                          commandHelp = whatsnewHelp,                          commandDescription = whatsnewDescription,                          commandExtraArgs = -1,

@@ -21,6 +21,7 @@ #include "gadts.h"  module Darcs.CommandsAux ( checkPaths, maliciousPatches, hasMaliciousPath,+                           isMaliciousPath, isMaliciousSubPath,                         ) where import Darcs.Flags ( DarcsFlag( RestrictPaths, DontRestrictPaths ) ) import Darcs.Patch ( Patchy, listTouchedFiles )@@ -28,7 +29,7 @@ import Darcs.Witnesses.Sealed ( Sealed2(..), unseal2 ) import Darcs.Global ( darcsdir ) import Data.List ( intersect )-import System.FilePath ( splitDirectories )+import System.FilePath ( splitDirectories, isRelative )  -- * File paths {-@@ -102,7 +103,17 @@ -} isMaliciousPath :: String -> Bool isMaliciousPath fp =-    not (isExplicitlyRelative fp) ||+    not (isExplicitlyRelative fp) || isGenerallyMalicious fp++-- | Warning : this is less rigorous than isMaliciousPath+--   but it's to allow for subpath representations that+--   don't start with ./+isMaliciousSubPath :: String -> Bool+isMaliciousSubPath fp =+    not (isRelative fp) || isGenerallyMalicious fp++isGenerallyMalicious :: String -> Bool+isGenerallyMalicious fp =     splitDirectories fp `contains_any` [ "..", darcsdir ]  where     contains_any a b = not . null $ intersect a b

@@ -83,7 +83,15 @@                | OnePattern PatchMatch | SeveralPattern PatchMatch                | AfterPattern PatchMatch | UpToPattern PatchMatch                | NonApply | NonVerify | NonForce-               | DryRun | SetDefault | NoSetDefault+               | DryRun++               -- The Bool parameters are a bit of a hack so that we can tell+               -- whether the user explicitly set the option or not.+               -- A more general mechanism would be better.+               -- True = explicitly set by user (on command-line or in prefs/defaults),+               -- False = defaulted by darcs+               | SetDefault Bool | NoSetDefault Bool+                | FancyMoveAdd | NoFancyMoveAdd                | Disable | SetScriptsExecutable | DontSetScriptsExecutable | Bisect                | UseHashedInventory | UseOldFashionedInventory

@@ -62,7 +62,8 @@                       substitute                     ) where -import Control.Monad.State( State(..) )+import Control.Monad.Identity ( Identity )+import Control.Monad.State( StateT(..) )  import Darcs.Patch import Darcs.Patch.Permutations ( commuteWhatWeCanRL, commuteWhatWeCanFL )@@ -252,8 +253,8 @@     settleB bubble = mapFL_FL (\tp -> PC tp True) $ reverseRL bubble  patchSlot' :: Patchy p =>-              TaggedPatch p C(a b) -> State (PatchChoices p C(x y)) Slot-patchSlot' = State . patchSlot+              TaggedPatch p C(a b) -> StateT (PatchChoices p C(x y)) Identity Slot+patchSlot' tp = StateT (return . patchSlot tp)  forceMatchingFirst :: forall p C(a b). Patchy p =>                       ( FORALL(x y) TaggedPatch p C(x y) -> Bool)

@@ -765,8 +765,9 @@           nchs = sort $ map (makeChunk l) newfs           filename = getAFilename pss           old = makeChunk l oldf-          new = [top] ++ concat (intersperse [middle] nchs) ++ [bottom]+          new = [top] ++ old ++ [initial] ++ concat (intersperse [middle] nchs) ++ [bottom]           top    = BC.pack $ "v v v v v v v" ++ eol_c+          initial= BC.pack $ "=============" ++ eol_c           middle = BC.pack $ "*************" ++ eol_c           bottom = BC.pack $ "^ ^ ^ ^ ^ ^ ^" ++ eol_c           eol_c  = if any (\ps -> not (B.null ps) && BC.last ps == '\r') old

@@ -133,6 +133,7 @@                                  , "   - To split removed text, copy back the part you want to retain"                                  , ""                                  ]+          hunk :: [B.ByteString] -> [B.ByteString] -> FL Prim C(a b)           hunk b a = canonize (FP fn (Hunk n b a))           mkSep s = BC.append sep (BC.pack s)           breakSep xs = case break (sep `BC.isPrefixOf`) xs of

@@ -54,7 +54,8 @@  import Darcs.Repository.Internal     (Repository(..), RepoType(..), ($-),-     maybeIdentifyRepository, identifyRepositoryFor, IdentifyRepo(..),+     maybeIdentifyRepository, identifyRepositoryFor, identifyDarcsRepository,+     IdentifyRepo(..),      findRepository, amInRepository, amNotInRepository,      makePatchLazy,      withRecorded,@@ -102,7 +103,8 @@                                , reverseRL ,lengthRL, (+>+), (:\/:)(..) ) import Darcs.Patch.Info ( PatchInfo ) import Darcs.Repository.Format ( RepoProperty ( HashedInventory ), RepoFormat,-                                 createRepoFormat, formatHas, writeRepoFormat )+                                 createRepoFormat, formatHas, writeRepoFormat,+                                 readfromAndWritetoProblem) import Darcs.Repository.Prefs ( writeDefaultPrefs ) import Darcs.Repository.Pristine ( createPristine, flagsToPristine, createPristineFromWorking ) import Darcs.Patch.Depends ( getPatchesBeyondTag, areUnrelatedRepos, findUncommon )@@ -170,7 +172,11 @@ copyInventory :: forall p C(r u t). RepoPatch p => Repository p C(r u t) -> IO () copyInventory fromRepo@(Repo fromDir opts fromFormat (DarcsRepository _ fromCache)) = do   toRepo@(Repo toDir opts' toFormat (DarcsRepository toPristine toCache)) <--    identifyRepositoryFor fromRepo "."+    identifyDarcsRepository opts "."+  let (_ :: Repository p C(r u t)) = toRepo --The witnesses are wrong, but cannot escape+  case readfromAndWritetoProblem fromFormat toFormat of+    Just e ->  fail $ "Incompatibility with repository " ++ fromDir ++ ":\n" ++ e+    Nothing -> return ()   toCache2 <- unionRemoteCaches toCache fromCache fromDir   let toRepo2 :: Repository p C(r u t)       toRepo2 = Repo toDir opts' toFormat $ DarcsRepository toPristine toCache2

@@ -21,7 +21,9 @@  module Darcs.Repository.HashedIO ( HashedIO,                                    copyHashed, copyPartialsHashed,-                                   cleanHashdir ) where+                                   cleanHashdir,+                                   RW(RW) -- only exported to make warning go away+                                 ) where  import Darcs.Global ( darcsdir ) import qualified Data.Set as Set@@ -31,15 +33,13 @@ import Control.Applicative ( (<$>) ) import Data.Maybe ( isJust ) import System.IO.Unsafe ( unsafeInterleaveIO )-import System.IO ( hPutStrLn, stderr )  import Darcs.Repository.Cache ( Cache(..), fetchFileUsingCache, writeFileUsingCache,                                 peekInCache, speculateFileUsingCache,                                 okayHash, cleanCachesWithHint, HashedDir(..), hashedDir )-import Darcs.Patch ( Patchy, apply ) import Darcs.RepoPath ( FilePathLike, toFilePath ) import Darcs.IO ( ReadableDirectory(..), WriteableDirectory(..) )-import Darcs.Flags ( DarcsFlag, Compression( .. ) )+import Darcs.Flags ( Compression( .. ) ) import Darcs.Lock ( writeAtomicFilePS, removeFileMayNotExist ) import Darcs.Utils ( withCurrentDirectory ) import Progress ( debugMessage, tediousSize, finishedOneIO )@@ -50,11 +50,10 @@ import qualified Data.ByteString       as B  (ByteString, length, empty) import qualified Data.ByteString.Char8 as BC (unpack, pack) -import Storage.Hashed.Darcs( hashedTreeIO, readDarcsHashedNosize, readDarcsHashed,-                             writeDarcsHashed, readDarcsHashedDir, darcsLocation,+import Storage.Hashed.Darcs( readDarcsHashedDir, darcsLocation,                              decodeDarcsHash, decodeDarcsSize )-import Storage.Hashed.Tree( treeHash, ItemType(..) )-import Storage.Hashed.Hash( encodeBase16, Hash(..) )+import Storage.Hashed.Tree( ItemType(..) )+import Darcs.CommandsAux  -- | @readHashFile c subdir hash@ reads the file with hash @hash@ in dir subdir, -- fetching it from 'Cache' @c@ if needed.@@ -255,7 +254,10 @@           cp (F,n,h) = do ps <- readhash h                           lift $ finishedOneIO k (fn2fp n)                           lift $ writeAtomicFilePS (fn2fp n) ps-          cp (D,n,h) = do lift $ createDirectoryIfMissing False (fn2fp n)+          cp (D,n,h) = if isMaliciousSubPath (fn2fp n)+                          then fail ("Caught malicious path: " ++ fn2fp n)+                          else do+                          lift $ createDirectoryIfMissing False (fn2fp n)                           lift $ finishedOneIO k (fn2fp n)                           lift $ withCurrentDirectory (fn2fp n) $ copyHashed k c compr h @@ -287,8 +289,8 @@           listone h = do let size = decodeDarcsSize $ BC.pack h                              hash = decodeDarcsHash $ BC.pack h                          x <- readDarcsHashedDir hashdir (size, hash)-                         let subs = [ fst $ darcsLocation "" (s, h) | (TreeType, _, s, h) <- x ]-                             hashes = h : [ fst $ darcsLocation "" (s, h) | (_, _, s, h) <- x ]+                         let subs = [ fst $ darcsLocation "" (s, h') | (TreeType, _, s, h') <- x ]+                             hashes = h : [ fst $ darcsLocation "" (s, h') | (_, _, s, h') <- x ]                          (hashes++) . concat <$> mapM listone subs       hs <- set . concat <$> mapM listone hashroots       fs <- set . filter okayHash <$> getDirectoryContents hashdir

@@ -22,7 +22,7 @@ #include "gadts.h"  module Darcs.Repository.Internal ( Repository(..), RepoType(..), RIO(unsafeUnRIO), ($-),-                    maybeIdentifyRepository, identifyDarcs1Repository, identifyRepositoryFor,+                    maybeIdentifyRepository, identifyDarcsRepository, identifyRepositoryFor,                     IdentifyRepo(..),                     findRepository, amInRepository, amNotInRepository,                     revertRepositoryChanges,@@ -195,6 +195,7 @@                              | NonRepository String -- ^ safest guess                              | GoodRepository (Repository p C(r u t)) +-- | Tries to identify the repository in a given directory maybeIdentifyRepository :: [DarcsFlag] -> String -> IO (IdentifyRepo p C(r u t)) maybeIdentifyRepository opts "." =     do darcs <- doesDirectoryExist darcsdir@@ -219,17 +220,22 @@                   Nothing ->  do cs <- getCaches opts url                                  return $ GoodRepository $ Repo url opts rf (DarcsRepository nopristine cs) -identifyDarcs1Repository :: [DarcsFlag] -> String -> IO (Repository Patch C(r u t))-identifyDarcs1Repository opts url =+-- | identifyDarcsRepository identifies the repo at 'url'. Warning:+-- you have to know what kind of patches are found in that repo.+identifyDarcsRepository :: forall p C(r u t). [DarcsFlag] -> String+                           -> IO (Repository p C(r u t))+identifyDarcsRepository opts url =     do er <- maybeIdentifyRepository opts url        case er of          BadRepository s -> fail s          NonRepository s -> fail s          GoodRepository r -> return r +-- | @identifyRepositoryFor repo url@ identifies (and returns) the repo at 'url',+-- but fails if it is not compatible for reading from and writing to. identifyRepositoryFor :: forall p C(r u t). RepoPatch p => Repository p C(r u t) -> String -> IO (Repository p C(r u t)) identifyRepositoryFor (Repo _ opts rf _) url =-    do Repo absurl _ rf_ t <- identifyDarcs1Repository opts url+    do Repo absurl _ rf_ t <- identifyDarcsRepository opts url        let t' = case t of DarcsRepository x c -> DarcsRepository x c        case readfromAndWritetoProblem rf_ rf of          Just e -> fail $ "Incompatibility with repository " ++ url ++ ":\n" ++ e@@ -441,7 +447,7 @@ checkUnrecordedConflicts :: forall p C(t y). RepoPatch p => [DarcsFlag] -> FL (Named p) C(t y) -> IO Bool checkUnrecordedConflicts opts _ | NoUpdateWorking `elem` opts = return False checkUnrecordedConflicts opts pc =-    do repository <- identifyDarcs1Repository opts "."+    do repository <- identifyDarcsRepository opts "."        cuc repository     where cuc :: Repository Patch C(r u t) -> IO Bool           cuc r = do Sealed mpend <- readPending r :: IO (Sealed (FL Prim C(t)))@@ -659,7 +665,7 @@ withRepositoryDirectory :: forall a. [DarcsFlag] -> String                         -> (forall p C(r u). RepoPatch p => Repository p C(r u r) -> IO a) -> IO a withRepositoryDirectory opts1 url job =-    do Repo dir opts rf rt <- identifyDarcs1Repository opts1 url+    do Repo dir opts rf rt <- identifyDarcsRepository opts1 url        let rt' = case rt of DarcsRepository t c -> DarcsRepository t c        if formatHas Darcs2 rf          then do debugMessage $ "Identified darcs-2 repo: " ++ dir

@@ -448,25 +448,26 @@  setDefaultrepo :: String -> [DarcsFlag] -> IO () setDefaultrepo r opts =  do olddef <- getPreflist "defaultrepo"-                            let doit = NoSetDefault `notElem` opts && greenLight+                            let doit = null noSetDefault && greenLight                                 greenLight = wetRun                                            && not rIsTmp                                            && (olddef /= [r] || olddef == [])                             if doit                                then setPreflist "defaultrepo" [r]-                               else when greenLight $ putStr . unlines $+                               else when (True `notElem` noSetDefault && greenLight) $ putStr . unlines $                                       -- the nuance here is that we should only notify when the                                       -- reason we're not setting default is the --no-set-default                                       -- flag, not the various automatic show stoppers-                                      [ "Note: if you want to change the default remote repository to"-                                      , r ++ ","-                                      , "quit now and issue the same command with the --set-default flag."+                                      [ "HINT: if you want to change the default remote repository to"+                                      , "      " ++ r ++ ","+                                      , "      quit now and issue the same command with the --set-default flag."                                       ]                             addToPreflist "repos" r                          `catchall` return () -- we don't care if this fails!  where   wetRun = DryRun `notElem` opts   rIsTmp = r `elem` [x | RemoteRepo x <- opts]+  noSetDefault = [x | NoSetDefault x <- opts] \end{code}  \paragraph{email}

@@ -30,9 +30,10 @@ import Data.Maybe ( catMaybes, isJust, fromJust ) import Data.Char ( toUpper ) import Control.Monad ( when, (>=>) )+import Control.Monad.Identity ( Identity(..) ) import Control.Monad.Trans ( liftIO ) import Control.Monad.Reader ( ReaderT, Reader, asks, runReader, runReaderT )-import Control.Monad.State ( State(..), StateT, modify, gets, execStateT )+import Control.Monad.State ( StateT, modify, gets, runStateT, execStateT ) import System.Exit ( exitWith, ExitCode(ExitSuccess) )  import English ( Noun(..), englishNum  )@@ -313,7 +314,7 @@       o <- asks opts       if not $ isInteractive o        then return $ promote autoChoices-       else flip refineChoices autoChoices $ textSelect whch+       else refineChoices (textSelect whch) autoChoices     where forward = not $ backward whch           promote = if forward                     then makeEverythingSooner@@ -390,11 +391,11 @@  -- | Runs a function on the underlying @PatchChoices@ object liftChoices :: forall p a C(x y) . Patchy p =>-               State (PatchChoices p C(x y)) a+               StateT (PatchChoices p C(x y)) Identity a                    -> InteractiveSelectionM p C(x y) a liftChoices act = do   ch <- gets choices-  let (result, ch') = runState act ch+  let (result, ch') = runIdentity $ runStateT act ch   modify $ \isc -> isc {choices = ch}   return result 

@@ -27,7 +27,7 @@ import qualified Data.ByteString.Char8 as BC ( unpack ) import Data.List ( sort ) import Data.Maybe ( isNothing )-import Data.Text as T ( findBy, any )+import Data.Text as T ( find, any ) import Data.Text.Encoding ( decodeUtf8With ) import Data.Text.Encoding.Error ( lenientDecode ) import Foreign ( unsafePerformIO )@@ -121,7 +121,7 @@        \patchInfo -> encodingOK (_piAuthor patchInfo)                      && encodingOK (_piName patchInfo)                      && all encodingOK (_piLog patchInfo)-  where encodingOK = isNothing . T.findBy (=='\xfffd') . decodeUtf8With lenientDecode+  where encodingOK = isNothing . T.find (=='\xfffd') . decodeUtf8With lenientDecode  -- | Test that metadata in patches are decoded as UTF-8 or locale depending on -- whether they're valid UTF-8.

@@ -1,5 +1,5 @@ {-# OPTIONS_GHC -fno-warn-deprecations -fno-warn-orphans -fglasgow-exts #-}-{-# LANGUAGE CPP, UndecidableInstances, ScopedTypeVariables #-}+{-# LANGUAGE CPP, UndecidableInstances, ScopedTypeVariables, ViewPatterns #-}  #include "gadts.h" module Darcs.Test.Patch.QuickCheck ( WithStartState, RepoModel, Tree,@@ -308,18 +308,17 @@ propFail n xs = sizeTree xs < n  instance ArbitraryState s p => ArbitraryState s (WithState s p) where-  arbitraryState rm = do xandrm' <- arbitraryState rm-                         flip unseal xandrm' $ \(WithEndState x rm') ->-                           return $ seal $ WithEndState (WithState rm x rm') rm'+  arbitraryState rm = do Sealed (WithEndState x rm') <- arbitraryState rm+                         return $ seal $ WithEndState (WithState rm x rm') rm'  instance ArbitraryState s p => ArbitraryState s (FL p) where   arbitraryState rm1 = sized $ \n -> do k <- choose (0, n)                                         arbitraryList k rm1       where arbitraryList :: FORALL(x) Int -> s C(x) -> Gen (Sealed (WithEndState (FL p C(x)) s))             arbitraryList 0 rm = return $ seal $ WithEndState NilFL rm-            arbitraryList (n+1) rm = do Sealed (WithEndState x rm') <- arbitraryState rm-                                        Sealed (WithEndState xs rm'') <- arbitraryList n rm'-                                        return $ seal $ WithEndState (x :>: xs) rm''+            arbitraryList n rm = do Sealed (WithEndState x rm') <- arbitraryState rm+                                    Sealed (WithEndState xs rm'') <- arbitraryList (n-1) rm'+                                    return $ seal $ WithEndState (x :>: xs) rm''             arbitraryList _ _ = impossible  data Tree p C(x) where@@ -355,9 +354,8 @@ flattenTree :: (Commute p) => Tree p C(z) -> Sealed (G2 [] (FL p) C(z)) flattenTree NilTree = seal $ G2 $ return NilFL flattenTree (SeqTree p t) = mapSeal (G2 . map (p :>:) . unG2) $ flattenTree t-flattenTree (ParTree t1 t2) = flip unseal (flattenTree t1) $ \gpss1 ->-                              flip unseal (flattenTree t2) $ \gpss2 ->-                              seal $ G2 $+flattenTree (ParTree (flattenTree -> Sealed gpss1) (flattenTree -> Sealed gpss2))+                            = seal $ G2 $                               do ps1 <- unG2 gpss1                                  ps2 <- unG2 gpss2                                  ps2' :/\: ps1' <- return $ merge (ps1 :\/: ps2)@@ -441,7 +439,7 @@     | otherwise = (Hunk n (take pos' old ++ drop (pos'+1) old) new, Nothing)         where pos' = pos - n   shrinkPos _ _ = bug "foo1 in ShrinkablePos"-  shrinkPatch (Hunk (n+1) [] []) = [(Hunk n [] [], Nothing)]+  shrinkPatch (Hunk n [] []) | n > 0 = [(Hunk (n-1) [] [], Nothing)]   shrinkPatch (Hunk n old new)    = do i <- [0 .. length new - 1]         return (Hunk n old (take i new ++ drop (i+1) new), Just (n + i))@@ -508,10 +506,8 @@  flattenOne :: (FromPrim p, Commute p) => Tree Prim C(x) -> Sealed (FL p C(x)) flattenOne NilTree = seal NilFL-flattenOne (SeqTree p t) = flip unseal (flattenOne t) $ \ps -> seal (fromPrim p :>: ps)-flattenOne (ParTree t1 t2) =-    flip unseal (flattenOne t1) $ \ps1 ->-    flip unseal (flattenOne t2) $ \ps2 ->+flattenOne (SeqTree p (flattenOne -> Sealed ps)) = seal (fromPrim p :>: ps)+flattenOne (ParTree (flattenOne -> Sealed ps1) (flattenOne -> Sealed ps2)) =     --traceDoc (greenText "flattening two parallel series: ps1" $$ showPatch ps1 $$     --          greenText "ps2" $$ showPatch ps2) $     case merge (ps1 :\/: ps2) of

@@ -31,7 +31,7 @@ cd .. darcs get temp1 > log not grep fakessh log-not darcs get http://example.com/foo+not darcs get http://darcs.net/nonexistent not grep fakessh log cd .. rm -rf temp1

@@ -0,0 +1,85 @@+#!/usr/bin/env bash+## Test for issue2017 - apply should gracefully handle tag missing+## from context (complain, not crash)+##+## Copyright (C) 2010 Eric Kow+##+## 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 record -lam 'Add f'+cd ..++# variant 0 - this passes trivially+darcs get R R0+darcs get R0 S0+darcs tag 's' --repo S0+darcs get S0 T0+cd T0+echo 'More content.' > f+darcs record -lam 'Modify f'+darcs send -o foo.dpatch -a+cd ..+not darcs apply --repo R0 T0/foo.dpatch > log 2>&1+not grep bug log+grep missing log++# variant 1 - tag in shared context+darcs get R R1+darcs tag '1' --repo R1+darcs get R1 S1+darcs tag 's1' --repo S1+darcs get S1 T1+cd T1+echo 'More content.' > f+darcs record -lam 'Modify f'+darcs send -o foo.dpatch -a+cd ..+# sanity check: should be able to cherry pick+darcs get R1 R1b+cd R1b+[ `darcs changes --count` -eq 2 ]+darcs pull ../T1 --match 'touch f' --all+[ `darcs changes --count` -eq 3 ]+cd ..+# the test: can't apply this due to incorrect context+not darcs apply --repo R1 T1/foo.dpatch > log 2>&1+not grep 'bug' log+grep missing log++# variant 2 - tag created after the fact+darcs get R  R2+darcs get R2 S2+darcs tag 's2' --repo S2+darcs get S2 T2+cd T2+echo 'More content.' > f+darcs record -lam 'Modify f'+darcs send -o foo.dpatch -a+cd ..+darcs tag '2'  --repo R2  # only tag after+not darcs apply --repo R2 T2/foo.dpatch > log 2>&1+not grep 'bug' log+grep missing log

@@ -0,0 +1,39 @@+#!/usr/bin/env bash++# Test that darcs fails appropriately when the target repo inventory file is not writable.+# See issue612++. lib++abort_windows++if grep old-fashioned .darcs/defaults; then+  exit 200+fi++rm -rf temp1 temp2+mkdir temp1+cd temp1+darcs init+touch t.t+darcs add t.t+darcs record -am "initial add"+if [ -e _darcs/inventories ]; then+  chmod 0555 _darcs/inventories/*+  chmod 0555 _darcs/inventories+fi+if [ -e _darcs/inventory ]; then+  chmod 0555 _darcs/inventory+fi+cd ..++darcs get temp1 temp2+cd temp2+# this block may fail so we'd better make sure we clean up after+# ourselves to avoid a permissions mess for other tests+trap "cd ..; chmod -R 0755 temp1; rm -rf temp1 temp2" EXIT+echo new >> t.t+darcs record -am "new patch"+not darcs push -a ../temp1 2> log+grep failed log+

@@ -0,0 +1,46 @@+#!/usr/bin/env bash+## Test for hunk editor+##+## Copyright (C) 2011 Ganesh Sittampalam+##+## 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.+rm -rf R                        # Another script may have left a mess.++darcs init      --repo R++cd R++echo 'version1' > file+darcs record -lam "version1"++echo 'version2' > file+(echo e ; echo y ; echo n) | DARCS_EDITOR="sed -i -e s/version2/version1.5/" darcs record -m "version1.5"++cat > expected <<EOF+hunk ./file 1+-version1.5++version2+EOF++darcs whatsnew | diff -u expected -+

@@ -0,0 +1,35 @@+#!/usr/bin/env bash++. lib++mkdir future+cd future+darcs  init+touch titi+darcs add titi+darcs record -am titi+cat > _darcs/format <<EOF+hashed|gobbledygook+darcs-2+EOF+cat _darcs/format+cd ..++if grep 'old-fashioned' .darcs/defaults; then+    exit 200+fi++if grep hashed .darcs/defaults; then+    exit 200+fi++# get future repo: should be ok+darcs get future temp1+cd temp1+darcs changes+touch toto+darcs add toto+darcs record -am 'blah'+cd ..+rm -rf temp1 future+

@@ -0,0 +1,30 @@+#!/usr/bin/env bash+## Test for issue2035 - malicious subpaths+##+## Copyright (C) 2010 Eric Kow <kowey@darcs.net>+##+## 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.++TESTDATA=repos # remove this line in HEAD++. lib                  # Load some portability helpers.+tar zxf $TESTDATA/badrepo.tgz+not darcs get badrepo

@@ -1,42 +0,0 @@-#!/usr/bin/env bash--# Test that darcs fails appropriately when the target repo inventory file is not writable.-# See issue612--. lib--abort_windows--if grep old-fashioned .darcs/defaults; then-  echo This test does not work with old-fashioned inventories-  exit 0-fi--rm -rf temp1 temp2-mkdir temp1-cd temp1-darcs init-touch t.t-darcs add t.t-darcs record -am "initial add"-if [ -e _darcs/inventories ]; then-  chmod 0555 _darcs/inventories/*-  chmod 0555 _darcs/inventories-fi-if [ -e _darcs/inventory ]; then-  chmod 0555 _darcs/inventory-fi-cd ..--darcs get temp1 temp2-cd temp2-echo new >> t.t-darcs record -am "new patch"-not darcs push -a ../r1 2> log-grep failed log-cd ..--chmod -R 0755 temp1-rm -rf temp1 temp2--

@@ -13,7 +13,7 @@ }  pwd() {-    ghc --make "$TESTS_WD/hspwd.hs"+    ghc --make "$TESTS_WD/hspwd.hs" > /dev/null     "$TESTS_WD/hspwd" } 

@@ -2,13 +2,117 @@  . lib -rm -rf temp1 temp2-mkdir temp1-cd temp1+rm -rf garbage future+mkdir garbage+cd garbage darcs  init echo gobbledygook > _darcs/format cd .. -not darcs get temp1 temp2 2> log+mkdir future+cd future+darcs  init+touch titi+darcs add titi+darcs record -am titi+cat > _darcs/format <<EOF+hashed|gobbledygook+darcs-2+EOF+cd ..+++# check the rules for reading and writing++## garbage repo: we don't understand anything+# get garbage repo+not darcs get garbage temp1 2> log grep -i "can't understand repository format" log-rm -rf temp1 temp2 log+rm -rf temp1 log++# pull from garbage repo+mkdir temp1+cd temp1+darcs init+not darcs pull ../garbage 2> log+grep -i "can't understand repository format" log+cd ..+rm -rf temp1++# apply in garbage repo+mkdir temp1+cd temp1+darcs init+darcs changes --context > empty-context+darcs tag -m "just a patch"+darcs send -a --context=empty-context -o ../bundle.dpatch .+cd ../garbage+not darcs apply ../bundle.dpatch 2> log+grep -i "can't understand repository format" log+cd ..+rm -rf temp1 bundle.dpatch++# add in garbage repo+cd garbage+touch toto+not darcs add toto 2> log+grep -i "can't understand repository format" log+cd ..++rm -rf garbage+++## future repo: we don't understand one+#  alternative of a line of format+#  only look at future vs darcs2++if grep 'old-fashioned' .darcs/defaults; then+    exit 200+fi++if grep hashed .darcs/defaults; then+    exit 200+fi++# get future repo: ok+# --to-match is needed because of bug###+darcs get future temp1 --to-match "name titi"+cd temp1+darcs changes+touch toto+darcs add toto+darcs record -am 'blah'+cd ..+rm -rf temp1++# pull from future repo: ok+mkdir temp1+cd temp1+darcs init+darcs pull ../future -a+darcs cha | grep titi+cd ..+rm -rf temp1++# apply in future repo: !ok+mkdir temp1+cd temp1+darcs init+darcs changes --context > empty-context+darcs tag -m "just a patch"+darcs send -a --context=empty-context -o ../bundle.dpatch .+cd ../future+not darcs apply ../bundle.dpatch 2> log+cat log+grep -i "can't write repository format" log+cd ..+rm -rf temp1 bundle.dpatch++# record in future repo: !ok+cd future+touch toto+not darcs add toto 2> log+grep -i "can't write repository format" log+cd ..++rm -rf future #No future!

binary file changed (absent → 3537 bytes)

@@ -0,0 +1,51 @@+#!/usr/bin/env bash+## Test that set-default hint messages are produced at the right times+##+## Copyright (C) 2011 Ganesh Sittampalam+##+## 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.+rm -rf R1 R2 R3                 # Another script may have left a mess.++darcs init      --repo R1+darcs get R1 R2+darcs get R1 R3++HINTSTRING="issue the same command with the --set-default flag"++cd R3+for command in pull push send+do+   # R1 should be the default for R3+   darcs $command ../R1 | not grep "$HINTSTRING"+   darcs $command ../R2 | grep "$HINTSTRING"++   # can disable message on the command-line+   darcs $command --no-set-default ../R2 | not grep "$HINTSTRING"++   # or using defaults+   echo "$command no-set-default" >> ../.darcs/defaults+   darcs $command ../R2 | not grep "$HINTSTRING"++   darcs $command --set-default ../R2 | not grep "$HINTSTRING"+   darcs $command --set-default ../R1 | not grep "$HINTSTRING"+done