[darcs-users] darcs patch: fix bug in check. (and 1 more)
Dmitry Kurochkin
dmitry.kurochkin at gmail.com
Fri Dec 12 10:17:39 UTC 2008
Hi David, Eric.
Sorry for delay with review...
Patches look good. Summary: the first patch makes darcs check run
tests on recorded instead of tentative, the second one introduces
testByDefault function to add Test flag unless NoTest option given and
cleans up all test running code to use this function.
Detailed comments below.
Regards,
Dmitry
fix bug in check.
-----------------
David Roundy <droundy at darcs.net>**20081207141115
hunk ./src/Darcs/Commands/Check.lhs 31
> )
> import Darcs.Repository.Repair( replayRepository,
> RepositoryConsistency(..) )
> -import Darcs.Repository ( Repository, amInRepository, withRepository, ($-), slurp_recorded,
> - testTentative )
> +import Darcs.Repository ( Repository, amInRepository, withRepository, slurp_recorded,
> + testRecorded )
> import Darcs.Patch ( RepoPatch, showPatch )
> import Darcs.Ordered ( FL(..) )
> import Darcs.Diff ( unsafeDiff )
($-) is not used now.
hunk ./src/Darcs/Commands/Check.lhs 88
>
> \begin{code}
> check_cmd :: [DarcsFlag] -> [String] -> IO ()
> -check_cmd opts _ = withRepository opts $- \repo -> check' repo opts
> +check_cmd opts _ = withRepository opts (check' opts)
>
($-) is not used now, when check' argument order changed.
hunk ./src/Darcs/Commands/Check.lhs 90
> -check' :: (RepoPatch p) => Repository p -> [DarcsFlag] -> IO ()
> -check' repository opts = do
> - res <- replayRepository repository opts $ \ state -> do
> +check' :: (RepoPatch p) => [DarcsFlag] -> Repository p -> IO ()
> +check' opts repository = do
> + replayRepository repository opts $ \ state -> do
> case state of
> RepositoryConsistent -> do
> putInfo $ text "The repository is consistent!"
Arguments swapped. And no res value is needed from replayRepository since
exitWith is used directly.
hunk ./src/Darcs/Commands/Check.lhs 96
> - unless (NoTest `elem` opts) $ testTentative repository
> - return ExitSuccess
> + unless (NoTest `elem` opts) $ testRecorded repository
> + exitWith ExitSuccess
> BrokenPristine newpris -> do
> brokenPristine newpris
Use exitWith directly instead of return.
Run tests on recorded instead of tentative. I am not familiar with
this one, but I guess David knows how it should be :) This is the main
change.
hunk ./src/Darcs/Commands/Check.lhs 100
> - return $ ExitFailure 1
> + exitWith $ ExitFailure 1
> BrokenPatches newpris _ -> do
> brokenPristine newpris
> putInfo $ text "Found broken patches."
hunk ./src/Darcs/Commands/Check.lhs 104
> - return $ ExitFailure 1
> - exitWith res
> + exitWith $ ExitFailure 1
> where
> brokenPristine newpris = do
> putInfo $ text "Looks like we have a difference..."
Call exitWith directly instead of return.
hunk ./src/Darcs/Repository.hs 52
> PatchSet, SealedPatchSet, PatchInfoAnd,
> setScriptsExecutable,
> checkUnrelatedRepos,
> - testTentative
> + testTentative, testRecorded
> ) where
>
> import System.Exit ( ExitCode(..), exitWith )
hunk ./src/Darcs/Repository.hs 81
> optimizeInventory, cleanRepository,
> getMarkedupFile,
> setScriptsExecutable,
> - testTentative
> + testTentative, testRecorded
> )
> import Darcs.Repository.Cache ( unionCaches, fetchFileUsingCache, HashedDir(..) )
> import Darcs.Patch.Set ( PatchSet, SealedPatchSet )
hunk ./src/Darcs/Repository/Internal.hs 51
> PatchSet, SealedPatchSet,
> setScriptsExecutable,
> getRepository, rIO,
> - testTentative
> + testTentative, testRecorded
> ) where
>
> import Printer ( putDocLn, (<+>), text, ($$) )
Import and export changes for testRecorded.
hunk ./src/Darcs/Repository/Internal.hs 783
> finalize_pending repository
>
> testTentative :: RepoPatch p => Repository p C(r u t) -> IO ()
> -testTentative repository@(Repo dir opts _ _) =
> +testTentative = testAny withTentative
> +
> +testRecorded :: RepoPatch p => Repository p C(r u t) -> IO ()
> +testRecorded = testAny withRecorded
> +
> +testAny :: RepoPatch p => (Repository p C(r u t)
> + -> ((AbsolutePath -> IO ()) -> IO ())
> + -> (AbsolutePath -> IO ()) -> IO ())
> + -> Repository p C(r u t) -> IO ()
> +testAny withD repository@(Repo dir opts _ _) =
> when (Test `elem` opts) $ withCurrentDirectory dir $
> do let putInfo = if not $ Quiet `elem` opts then putStrLn else const (return ())
> debugMessage "About to run test if it exists."
hunk ./src/Darcs/Repository/Internal.hs 800
> case testline of
> Nothing -> return ()
> Just testcode ->
> - withTentative repository (wd "testing") $ \_ ->
> + withD repository (wd "testing") $ \_ ->
> do putInfo "Running test...\n"
> when (SetScriptsExecutable `elem` opts) setScriptsExecutable
> ec <- system testcode
Introduce testAny to run tests on tentative or recorded. Add
testRecorded function. Change testTentative to use testAny.
fix regression in default behavior or check.
--------------------------------------------
David Roundy <droundy at darcs.net>**20081208131416
hunk ./src/Darcs/Arguments.lhs 34
> help_on_match,
> any_verbosity, disable,
> notest, test, working_repo_dir,
> + testByDefault,
> remote_repo,
> leave_test_dir,
> possibly_remote_repo_dir, get_repourl,
hunk ./src/Darcs/Arguments.lhs 714
> LeaveTestDir "don't remove the test directory",
> DarcsNoArgOption [] ["remove-test-directory"]
> NoLeaveTestDir "remove the test directory"]
> +
> +testByDefault :: [DarcsFlag] -> [DarcsFlag]
> +testByDefault o = if NoTest `elem` o then o else Test:o
> \end{code}
>
> \begin{options}
Introduce testByDefault fuction to add Test flag to options unless it
contains NoTest flag. Similar code is used in several places where
tests are run. Now it is replaced with a proper function.
hunk ./src/Darcs/Commands/AmendRecord.lhs 49
> with_selected_patch_from_repo )
> import Darcs.Commands ( DarcsCommand(..), nodefaults )
> import Darcs.Commands.Record ( get_date, get_log )
> -import Darcs.Arguments ( DarcsFlag ( Test, NoTest, All ),
> +import Darcs.Arguments ( DarcsFlag ( All ),
> areFileArgs, fixSubPaths, defineChanges,
> all_interactive, ignoretimes,
> ask_long_comment, author, patchname_option,
Test, NoTest are not needed anymore.
hunk ./src/Darcs/Commands/AmendRecord.lhs 56
> leave_test_dir, nocompress, lookforadds,
> working_repo_dir,
> match_one_nontag, umask_option,
> - notest, list_registered_files,
> + notest, testByDefault, list_registered_files,
> get_easy_author, set_scripts_executable
> )
> import Darcs.Utils ( askUser )
hunk ./src/Darcs/Commands/AmendRecord.lhs 113
> \end{code}
> \begin{code}
> amendrecord_cmd :: [DarcsFlag] -> [String] -> IO ()
> -amendrecord_cmd origopts args =
> - let opts = if NoTest `elem` origopts then origopts else Test:origopts
> - edit_metadata = has_edit_metadata opts in
> - withRepoLock opts $- \repository -> do
> +amendrecord_cmd opts args =
> + let edit_metadata = has_edit_metadata opts in
> + withRepoLock (testByDefault opts) $- \repository -> do
> files <- sort `fmap` fixSubPaths opts args
> when (areFileArgs files) $
> putStrLn $ "Amending changes in "++unwords (map show files)++":\n"
Use testByDefault - simpler code, no duplication.
hunk ./src/Darcs/Commands/Check.lhs 21
> \subsection{darcs check}
> \begin{code}
> module Darcs.Commands.Check ( check ) where
> -import Control.Monad ( when, unless )
> +import Control.Monad ( when )
> import System.Exit ( ExitCode(..), exitWith )
>
> import Darcs.Commands ( DarcsCommand(..), nodefaults )
hunk ./src/Darcs/Commands/Check.lhs 25
> -import Darcs.Arguments ( DarcsFlag( Quiet, NoTest ),
> - partial_check, notest,
> +import Darcs.Arguments ( DarcsFlag( Quiet ),
> + partial_check, notest, testByDefault,
> leave_test_dir, working_repo_dir,
> )
> import Darcs.Repository.Repair( replayRepository,
hunk ./src/Darcs/Commands/Check.lhs 92
>
> check' :: (RepoPatch p) => [DarcsFlag] -> Repository p -> IO ()
> check' opts repository = do
> - replayRepository repository opts $ \ state -> do
> + replayRepository repository (testByDefault opts) $ \ state -> do
> case state of
> RepositoryConsistent -> do
> putInfo $ text "The repository is consistent!"
hunk ./src/Darcs/Commands/Check.lhs 96
> - unless (NoTest `elem` opts) $ testRecorded repository
> + testRecorded repository
> exitWith ExitSuccess
> BrokenPristine newpris -> do
> brokenPristine newpris
hunk ./src/Darcs/Commands/Record.lhs 56
> import Darcs.RepoPath ( FilePathLike, SubPath, sp2fn, toFilePath )
> import Darcs.SlurpDirectory ( Slurpy, empty_slurpy )
> import Darcs.Commands ( DarcsCommand(..), nodefaults, loggers, command_stub )
> -import Darcs.Arguments ( DarcsFlag( PromptLongComment, Test, NoTest, NoEditLongComment,
> +import Darcs.Arguments ( DarcsFlag( PromptLongComment, NoEditLongComment,
> EditLongComment, RmLogFile, LogFile, Pipe,
> PatchName, AskDeps, All ),
> get_author, working_repo_dir, lookforadds,
hunk ./src/Darcs/Commands/Record.lhs 60
> - fixSubPaths, defineChanges,
> + fixSubPaths, defineChanges, testByDefault,
> ask_long_comment, askdeps, patch_select_flag,
> all_pipe_interactive, leave_test_dir, notest,
> author, patchname_option, umask_option, ignoretimes,
hunk ./src/Darcs/Commands/Record.lhs 138
> where fp = toFilePath rp
>
> record_cmd :: [DarcsFlag] -> [String] -> IO ()
> -record_cmd origopts args = do
> - check_name_is_not_option origopts
> -
> +record_cmd opts args = do
> + check_name_is_not_option opts
> let (logMessage,_, _) = loggers opts
hunk ./src/Darcs/Commands/Record.lhs 141
> - opts = if NoTest `elem` origopts then origopts else Test:origopts
> -
> - withRepoLock opts $- \repository -> do
> + withRepoLock (testByDefault opts) $- \repository -> do
> rec <- if null args then return empty_slurpy
> else slurp_recorded repository
> files <- sort `fmap` fixSubPaths opts args
hunk ./src/Darcs/Commands/Record.lhs 166
> else logMessage "No changes!"
> Just ch -> do_record repository opts existing_files ch
> where allow_empty_with_askdeps NilFL
> - | AskDeps `elem` origopts = Just NilFL
> + | AskDeps `elem` opts = Just NilFL
> | otherwise = Nothing
> allow_empty_with_askdeps p = Just p
>
Similar changes. Use testByDefault instead of checking flags directly.
More information about the darcs-users
mailing list