diff --git a/src/Print.hs b/src/Print.hs index f8f8c0e..416cc05 100644 --- a/src/Print.hs +++ b/src/Print.hs @@ -4,22 +4,28 @@ where import Import import Types --- | Print a shell test. See CLI documentation for details. +-- | Print a shell test considering the @--actual=mode@ option. See CLI +-- documentation for details on. printShellTest :: String -- ^ Shelltest format. Value of option @--print[=FORMAT]@. + -> Maybe String -- ^ Value of option @--actual[=MODE]@. @Nothing@ if option is not given. -> ShellTest -- ^ Test to print + -> Either String String -- ^ Non-matching or matching stdout + -> Either String String -- ^ Non-matching or matching stderr + -> Either Int Int -- ^ Non-matching or matching exit status -> IO () -printShellTest format ShellTest{command=c,stdin=i,comments=comments,trailingComments=trailingComments, +printShellTest format actualMode ShellTest{command=c,stdin=i,comments=comments,trailingComments=trailingComments, stdoutExpected=o_expected,stderrExpected=e_expected,exitCodeExpected=x_expected} - = do + o_actual e_actual x_actual = do + (o,e,x) <- computeResults actualMode case format of "v1" -> do printComments comments printCommand "" c printStdin "<<<" i - printStdouterr ">>>" o_expected - printStdouterr ">>>2" e_expected - printExitStatus True ">>>=" x_expected + printStdouterr ">>>" $ justMatcherOutErr o + printStdouterr ">>>2" $ justMatcherOutErr e + printExitStatus True ">>>=" x printComments trailingComments "v2" -> do printComments comments @@ -38,6 +44,20 @@ printShellTest format ShellTest{command=c,stdin=i,comments=comments,trailingComm printExitStatus False ">=" x_expected printComments trailingComments _ -> fail $ "Unsupported --print format: " ++ format + where + computeResults :: Maybe String -> IO (Maybe Matcher, Maybe Matcher, Matcher) + computeResults Nothing = do + return (o_expected, e_expected, x_expected) + computeResults (Just mode) + | mode `isPrefixOf` "all" = return + (Just $ Lines 0 $ fromEither o_actual + ,Just $ Lines 0 $ fromEither e_actual + ,Numeric $ show $ fromEither x_actual) + | mode `isPrefixOf` "update" = return + (either (Just . Lines 0) (const o_expected) o_actual + ,either (Just . Lines 0) (const e_expected) e_actual + ,either (Numeric . show) (const x_expected) x_actual) + | otherwise = fail "Unsupported argument for --actual option. Allowed: all, update, or a prefix thereof." printComments :: [String] -> IO () printComments = mapM_ putStrLn @@ -65,3 +85,14 @@ printExitStatus _ _ (Lines _ _) = fail "FATAL: Cannot handle Matcher (Lines) for printExitStatus False _ (Numeric "0") = return () printExitStatus True prefix (Numeric "0") = printf "%s 0\n" prefix printExitStatus _ prefix s = printf "%s %s\n" prefix (show s) + +mkEither :: Bool -> a -> Either a a +mkEither True = Right +mkEither False = Left + +fromEither :: Either a a -> a +fromEither = either id id + +-- | Make a Matcher out of Nothing. +justMatcherOutErr :: Maybe Matcher -> Maybe Matcher +justMatcherOutErr = Just . fromMaybe (Lines 0 "") diff --git a/src/shelltest.hs b/src/shelltest.hs index 0a9e40f..05ba4c8 100644 --- a/src/shelltest.hs +++ b/src/shelltest.hs @@ -68,6 +68,7 @@ data Args = Args { ,debug_parse :: Bool ,testpaths :: [FilePath] ,print_ :: Maybe String + ,actual :: Maybe String } deriving (Show, Data, Typeable) argdefs = Args { @@ -91,6 +92,7 @@ argdefs = Args { ,debug_parse = def &= help "Show test file parsing results and stop" ,testpaths = def &= args &= typ "TESTFILES|TESTDIRS" ,print_ = def &= typ "FORMAT" &= opt "v3" &= groupname "Print test file" &= help "Print test files in specified format (default: v3)." + ,actual = def &= typ "MODE" &= opt "all" &= help "Combined with --print, print test files with actual results (stdout, stderr, exit status). This can be used to generate or update tests. Mode 'all' prints all actual results (default). Mode 'update' prints actual results only for non-matching results, i.e. regular expressions in tests are retained." } &= helpArg [explicit, name "help", name "h"] &= program progname @@ -153,6 +155,8 @@ checkArgs :: Args -> IO Args checkArgs args = do when (null $ testpaths args) $ warn $ printf "Please specify at least one test file or directory, eg: %s tests" progname + when (isJust (actual args) && not (isJust (print_ args))) $ + warn "Option --actual can only be used with --print." return args -- running tests @@ -184,7 +188,7 @@ prepareShellTest args st@ShellTest{testname=n,command=c,stdin=i,stdoutExpected=o let errorMatch = maybe True (e_actual `matches`) e_expected let exitCodeMatch = show x_actual `matches` x_expected case print_ args of - Just format -> printShellTest format st + Just format -> printShellTest format (actual args) st (mkEither outputMatch o_actual) (mkEither errorMatch e_actual) (mkEither exitCodeMatch x_actual) Nothing -> if (x_actual == 127) -- catch bad executable - should work on posix systems at least then ioError $ userError $ unwords $ filter (not . null) [e_actual, printf "Command: '%s' Exit code: %i" cmd x_actual] -- XXX still a test failure; should be an error else assertString $ concat $ filter (not . null) [