[WIP] Print actual results with --print

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 "")

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) [