mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

test: Add --test-debug option

Browse source 
This work is supported by the NIH-funded NICEMAN (ReproNim TR&D3) project.
This commit is contained in:
Joey Hess 2022-11-28 15:12:53 -04:00
parent 022c14ec02
commit 2b5e6ff20a
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
6 changed files with 84 additions and 4 deletions
Download patch file Download diff file Expand all files Collapse all files

19
Test/Framework.hs
View file

@ -65,11 +65,20 @@ import qualified Command.Uninit
-- Run a process. The output and stderr is captured, and is only
-- displayed if the process does not return the expected value.
--
-- In debug mode, the output is allowed to pass through.
testProcess :: String -> [String] -> Maybe [(String, String)] -> (Bool -> Bool) -> String -> Assertion
testProcess command params environ expectedret faildesc = do
let p = (proc command params) { env = environ }
(transcript, ret) <- Utility.Process.Transcript.processTranscript' p Nothing
(expectedret ret) @? (faildesc ++ " failed (transcript follows)\n" ++ transcript)
debug <- testDebug . testOptions <$> getTestMode
if debug
then do
ret <- withCreateProcess p $ \_ _ _ pid ->
waitForProcess pid
(expectedret (ret == ExitSuccess)) @? (faildesc ++ " failed")
else do
(transcript, ret) <- Utility.Process.Transcript.processTranscript' p Nothing
(expectedret ret) @? (faildesc ++ " failed (transcript follows)\n" ++ transcript)
-- Run git. (Do not use to run git-annex as the one being tested
-- may not be in path.)
@ -98,7 +107,11 @@ git_annex_shouldfail' = git_annex'' (== False)
git_annex'' :: (Bool -> Bool) -> String -> [String] -> Maybe [(String, String)] -> String -> Assertion
git_annex'' expectedret command params environ faildesc = do
pp <- Annex.Path.programPath
testProcess pp (command:params) environ expectedret faildesc
debug <- testDebug . testOptions <$> getTestMode
let params' = if debug
then "--debug":params
else params
testProcess pp (command:params') environ expectedret faildesc
{- Runs git-annex and returns its standard output. -}
git_annex_output :: String -> [String] -> IO String