From 2a4612a5ae96ab7599f249e75d20fd2a8d64fcf9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jakob=20Sch=C3=B6ttl?= Date: Mon, 24 Aug 2020 23:07:37 +0200 Subject: [PATCH 1/9] Revert "Remove --actual" This reverts commit 531c67fe88b10bfa551e52d035afe79b45d2b670. --- src/Print.hs | 126 ++++++++++++++++++++++++++++------------------- src/shelltest.hs | 6 ++- 2 files changed, 79 insertions(+), 53 deletions(-) diff --git a/src/Print.hs b/src/Print.hs index 1f899d3..0c5785f 100644 --- a/src/Print.hs +++ b/src/Print.hs @@ -10,51 +10,66 @@ module Print where -import Safe (lastMay) import Import import Types --- | Print a shell test. See CLI documentation for details. +-- TODO Print output depending on --print=FORMAT (currently only v3) +-- | Print a shell test considering the @--actual=mode@ option. See CLI +-- documentation for details on. -- For v3 (the preferred, lightweight format), avoid printing most unnecessary things -- (stdout delimiter, 0 exit status value). 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 exit status + -> Either String String -- ^ Non-matching or matching exit status + -> 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 - case format of - "v1" -> do - printComments comments - printCommand "" c - printStdin "<<<" i - printStdouterr False ">>>" o_expected - printStdouterr False ">>>2" e_expected - printExitStatus True True ">>>=" x_expected - printComments trailingComments - "v2" -> do - printComments comments - printStdin "<<<" i - printCommand "$$$ " c - printStdouterr True ">>>" o_expected - printStdouterr True ">>>2" e_expected - printExitStatus trailingblanklines True ">>>=" x_expected - printComments trailingComments - "v3" -> do - printComments comments - printStdin "<" i - printCommand "$ " c - printStdouterr True ">" o_expected - printStdouterr True ">2" e_expected - printExitStatus trailingblanklines False ">=" x_expected - printComments trailingComments - _ -> fail $ "Unsupported --print format: " ++ format + o_actual e_actual x_actual = do + (o,e,x) <- computeResults actualMode + case format of + "v1" -> do + printComments comments + printCommand "" c + printStdin "<<<" i + printStdouterr ">>>" $ justMatcherOutErr o + printStdouterr ">>>2" $ justMatcherOutErr e + printExitStatus True ">>>=" x + printComments trailingComments + "v2" -> do + printComments comments + printStdin "<<<" i + printCommand "$$$ " c + printStdouterr ">>>" o_expected + printStdouterr ">>>2" e_expected + printExitStatus False ">>>=" x_expected + printComments trailingComments + "v3" -> do + printComments comments + printStdin "<" i + printCommand "$ " c + printStdouterr ">" o_expected + printStdouterr ">2" e_expected + printExitStatus False ">=" x_expected + printComments trailingComments + _ -> fail $ "Unsupported --print format: " ++ format where - trailingblanklines = case (o_expected, e_expected) of - (Just (Lines _ o), Just (Lines _ e)) -> hasblanks $ if null e then o else e - _ -> False - where hasblanks s = maybe False null $ lastMay $ lines s + 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 -- TODO what about 0? how is it in parser? + ,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 @@ -68,23 +83,30 @@ printCommand :: String -> TestCommand -> IO () printCommand prefix (ReplaceableCommand s) = printf "%s%s\n" prefix s printCommand prefix (FixedCommand s) = printf "%s %s\n" prefix s --- Print an expected stdout or stderr test, prefixed with the given delimiter. --- If no expected value is specified, print nothing if first argument is true --- (for format 1, which ignores unspecified out/err), otherwise print a dummy test. -printStdouterr :: Bool -> String -> Maybe Matcher -> IO () -printStdouterr alwaystest prefix Nothing = when alwaystest $ printf "%s //\n" prefix -printStdouterr _ _ (Just (Lines _ "")) = return () -printStdouterr _ _ (Just (Numeric _)) = fail "FATAL: Cannot handle Matcher (Numeric) for stdout/stderr." -printStdouterr _ _ (Just (NegativeNumeric _)) = fail "FATAL: Cannot handle Matcher (NegativeNumeric) for stdout/stderr." -printStdouterr _ prefix (Just (Lines _ s)) | prefix==">" = printf "%s" s -- omit v3's > delimiter, really no need for it -printStdouterr _ prefix (Just (Lines _ s)) = printf "%s\n%s" prefix s -printStdouterr _ prefix (Just regex) = printf "%s %s\n" prefix (show regex) +printStdouterr :: String -> Maybe Matcher -> IO () +printStdouterr _ Nothing = return () +printStdouterr _ (Just (Lines _ "")) = return () +printStdouterr _ (Just (Numeric _)) = fail "FATAL: Cannot handle Matcher (Numeric) for stdout/stderr." +printStdouterr _ (Just (NegativeNumeric _)) = fail "FATAL: Cannot handle Matcher (NegativeNumeric) for stdout/stderr." +printStdouterr prefix (Just (Lines _ s)) = printf "%s\n%s\n" prefix s -- TODO trailing \n ? +printStdouterr prefix (Just regex) = printf "%s %s\n" prefix (show regex) + -- | Print an expected exit status clause, prefixed with the given delimiter. --- If zero is expected: --- if the first argument is not true, nothing will be printed; --- otherwise if the second argument is not true, only the delimiter will be printed. -printExitStatus :: Bool -> Bool -> String -> Matcher -> IO () -printExitStatus _ _ _ (Lines _ _) = fail "FATAL: Cannot handle Matcher (Lines) for exit status." -printExitStatus always showzero prefix (Numeric "0") = when always $ printf "%s %s\n" prefix (if showzero then "0" else "") -printExitStatus _ _ prefix s = printf "%s %s\n" prefix (show s) +-- First arg says 'alwaysPrintEvenIfZero'. +printExitStatus :: Bool -> String -> Matcher -> IO () +printExitStatus _ _ (Lines _ _) = fail "FATAL: Cannot handle Matcher (Lines) for exit status." +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 825d50c..ba06949 100644 --- a/src/shelltest.hs +++ b/src/shelltest.hs @@ -73,6 +73,7 @@ data Args = Args { ,testpaths :: [FilePath] ,print_ :: Maybe String ,hspec_ :: Bool + ,actual :: Maybe String } deriving (Show, Data, Typeable) argdefs = Args { @@ -98,6 +99,7 @@ argdefs = Args { ,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)." ,hspec_ = def &= name"hspec" &= help "Use hspec to run tests." + ,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 @@ -178,6 +180,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 @@ -209,7 +213,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) [ From 9245da90e6f7ecd60b0ff28f5d47b4a7d1974946 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jakob=20Sch=C3=B6ttl?= Date: Mon, 24 Aug 2020 23:15:11 +0200 Subject: [PATCH 2/9] Fix comments --- src/Print.hs | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/src/Print.hs b/src/Print.hs index 0c5785f..3890ede 100644 --- a/src/Print.hs +++ b/src/Print.hs @@ -13,7 +13,6 @@ where import Import import Types --- TODO Print output depending on --print=FORMAT (currently only v3) -- | Print a shell test considering the @--actual=mode@ option. See CLI -- documentation for details on. -- For v3 (the preferred, lightweight format), avoid printing most unnecessary things @@ -62,7 +61,7 @@ printShellTest format actualMode ShellTest{command=c,stdin=i,comments=comments,t return (o_expected, e_expected, x_expected) computeResults (Just mode) | mode `isPrefixOf` "all" = return - (Just $ Lines 0 $ fromEither o_actual -- TODO what about 0? how is it in parser? + (Just $ Lines 0 $ fromEither o_actual ,Just $ Lines 0 $ fromEither e_actual ,Numeric $ show $ fromEither x_actual) | mode `isPrefixOf` "update" = return @@ -88,7 +87,7 @@ printStdouterr _ Nothing = return () printStdouterr _ (Just (Lines _ "")) = return () printStdouterr _ (Just (Numeric _)) = fail "FATAL: Cannot handle Matcher (Numeric) for stdout/stderr." printStdouterr _ (Just (NegativeNumeric _)) = fail "FATAL: Cannot handle Matcher (NegativeNumeric) for stdout/stderr." -printStdouterr prefix (Just (Lines _ s)) = printf "%s\n%s\n" prefix s -- TODO trailing \n ? +printStdouterr prefix (Just (Lines _ s)) = printf "%s\n%s" prefix s printStdouterr prefix (Just regex) = printf "%s %s\n" prefix (show regex) From 5ca1178afd74c4a7c17288580b82266a21d44406 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jakob=20Sch=C3=B6ttl?= Date: Mon, 24 Aug 2020 23:24:53 +0200 Subject: [PATCH 3/9] Bugfix and fix comments --- src/Print.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Print.hs b/src/Print.hs index 3890ede..cc91d05 100644 --- a/src/Print.hs +++ b/src/Print.hs @@ -21,8 +21,8 @@ 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 exit status - -> Either String String -- ^ Non-matching or matching exit status + -> 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 actualMode ShellTest{command=c,stdin=i,comments=comments,trailingComments=trailingComments, From 95fb389ae97a3d83eed22954cd2f988fbb18c9e2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jakob=20Sch=C3=B6ttl?= Date: Mon, 5 Jan 2026 22:13:25 +0100 Subject: [PATCH 4/9] Simplify condition --- src/shelltest.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/shelltest.hs b/src/shelltest.hs index ba06949..d90112a 100644 --- a/src/shelltest.hs +++ b/src/shelltest.hs @@ -180,7 +180,7 @@ 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))) $ + when (isJust (actual args) && isNothing (print_ args)) $ warn "Option --actual can only be used with --print." return args From 071f48dc2521cd8672acf73b7df3bc4aec37fa3c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jakob=20Sch=C3=B6ttl?= Date: Mon, 5 Jan 2026 22:37:33 +0100 Subject: [PATCH 5/9] Refactoring --- src/Print.hs | 12 ++++++++---- src/shelltest.hs | 4 ++-- 2 files changed, 10 insertions(+), 6 deletions(-) diff --git a/src/Print.hs b/src/Print.hs index cc91d05..2240a3e 100644 --- a/src/Print.hs +++ b/src/Print.hs @@ -8,6 +8,9 @@ -- may lose other data module Print + ( printShellTest + , packResult + ) where import Import @@ -99,13 +102,14 @@ 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 +-- | Wrap result @a@ into 'Either' depending on wether it matches the expected result. +packResult :: Bool -> a -> Either a a +packResult True = Right +packResult False = Left fromEither :: Either a a -> a fromEither = either id id --- | Make a Matcher out of Nothing. +-- | Return the default 'Matcher' for 'Nothing'. justMatcherOutErr :: Maybe Matcher -> Maybe Matcher justMatcherOutErr = Just . fromMaybe (Lines 0 "") diff --git a/src/shelltest.hs b/src/shelltest.hs index d90112a..b9e6ad7 100644 --- a/src/shelltest.hs +++ b/src/shelltest.hs @@ -31,7 +31,7 @@ import Import import Utils import Types import Parse -import Print +import Print (printShellTest, packResult) import Preprocessor @@ -213,7 +213,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 (actual args) st (mkEither outputMatch o_actual) (mkEither errorMatch e_actual) (mkEither exitCodeMatch x_actual) + Just format -> printShellTest format (actual args) st (packResult outputMatch o_actual) (packResult errorMatch e_actual) (packResult 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) [ From 378d985eceb9ff246f0a5a2ccdc7a56f28f50454 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jakob=20Sch=C3=B6ttl?= Date: Mon, 5 Jan 2026 22:45:36 +0100 Subject: [PATCH 6/9] Fix indentation and doc --- src/Print.hs | 60 ++++++++++++++++++++++++++-------------------------- 1 file changed, 30 insertions(+), 30 deletions(-) diff --git a/src/Print.hs b/src/Print.hs index 2240a3e..e0851b5 100644 --- a/src/Print.hs +++ b/src/Print.hs @@ -24,40 +24,40 @@ 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 + -> Either String String -- ^ Actual stdout, non-matching or matching + -> Either String String -- ^ Actual stderr, non-matching or matching + -> Either Int Int -- ^ Actual exit status, non-matching or matching -> IO () printShellTest format actualMode ShellTest{command=c,stdin=i,comments=comments,trailingComments=trailingComments, stdoutExpected=o_expected,stderrExpected=e_expected,exitCodeExpected=x_expected} o_actual e_actual x_actual = do - (o,e,x) <- computeResults actualMode - case format of - "v1" -> do - printComments comments - printCommand "" c - printStdin "<<<" i - printStdouterr ">>>" $ justMatcherOutErr o - printStdouterr ">>>2" $ justMatcherOutErr e - printExitStatus True ">>>=" x - printComments trailingComments - "v2" -> do - printComments comments - printStdin "<<<" i - printCommand "$$$ " c - printStdouterr ">>>" o_expected - printStdouterr ">>>2" e_expected - printExitStatus False ">>>=" x_expected - printComments trailingComments - "v3" -> do - printComments comments - printStdin "<" i - printCommand "$ " c - printStdouterr ">" o_expected - printStdouterr ">2" e_expected - printExitStatus False ">=" x_expected - printComments trailingComments - _ -> fail $ "Unsupported --print format: " ++ format + (o,e,x) <- computeResults actualMode + case format of + "v1" -> do + printComments comments + printCommand "" c + printStdin "<<<" i + printStdouterr ">>>" $ justMatcherOutErr o + printStdouterr ">>>2" $ justMatcherOutErr e + printExitStatus True ">>>=" x + printComments trailingComments + "v2" -> do + printComments comments + printStdin "<<<" i + printCommand "$$$ " c + printStdouterr ">>>" o_expected + printStdouterr ">>>2" e_expected + printExitStatus False ">>>=" x_expected + printComments trailingComments + "v3" -> do + printComments comments + printStdin "<" i + printCommand "$ " c + printStdouterr ">" o_expected + printStdouterr ">2" e_expected + printExitStatus False ">=" x_expected + printComments trailingComments + _ -> fail $ "Unsupported --print format: " ++ format where computeResults :: Maybe String -> IO (Maybe Matcher, Maybe Matcher, Matcher) computeResults Nothing = do From deeab679032b21d10614a1a92f43f163fa591631 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jakob=20Sch=C3=B6ttl?= Date: Mon, 5 Jan 2026 23:02:44 +0100 Subject: [PATCH 7/9] Print even simple v3 format --- src/Print.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/src/Print.hs b/src/Print.hs index e0851b5..1f5b919 100644 --- a/src/Print.hs +++ b/src/Print.hs @@ -90,6 +90,7 @@ printStdouterr _ Nothing = return () printStdouterr _ (Just (Lines _ "")) = return () printStdouterr _ (Just (Numeric _)) = fail "FATAL: Cannot handle Matcher (Numeric) for stdout/stderr." printStdouterr _ (Just (NegativeNumeric _)) = fail "FATAL: Cannot handle Matcher (NegativeNumeric) for stdout/stderr." +printStdouterr ">" (Just (Lines _ s)) = printf "%s" s -- omit the optional ">" in format v3 printStdouterr prefix (Just (Lines _ s)) = printf "%s\n%s" prefix s printStdouterr prefix (Just regex) = printf "%s %s\n" prefix (show regex) From c471a0a988bec9618c6a7d915abbce475fa1da57 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jakob=20Sch=C3=B6ttl?= Date: Mon, 5 Jan 2026 23:35:36 +0100 Subject: [PATCH 8/9] Fix forgotten --actual output for v2 and v3 --- src/Print.hs | 15 +++++++-------- 1 file changed, 7 insertions(+), 8 deletions(-) diff --git a/src/Print.hs b/src/Print.hs index 1f5b919..286c1e7 100644 --- a/src/Print.hs +++ b/src/Print.hs @@ -45,23 +45,22 @@ printShellTest format actualMode ShellTest{command=c,stdin=i,comments=comments,t printComments comments printStdin "<<<" i printCommand "$$$ " c - printStdouterr ">>>" o_expected - printStdouterr ">>>2" e_expected - printExitStatus False ">>>=" x_expected + printStdouterr ">>>" $ justMatcherOutErr o + printStdouterr ">>>2" $ justMatcherOutErr e + printExitStatus False ">>>=" x printComments trailingComments "v3" -> do printComments comments printStdin "<" i printCommand "$ " c - printStdouterr ">" o_expected - printStdouterr ">2" e_expected - printExitStatus False ">=" x_expected + printStdouterr ">" $ justMatcherOutErr o + printStdouterr ">2" $ justMatcherOutErr e + printExitStatus False ">=" x 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 Nothing = return (o_expected, e_expected, x_expected) computeResults (Just mode) | mode `isPrefixOf` "all" = return (Just $ Lines 0 $ fromEither o_actual From 92467ca6d7224b981a31cda5c908c97c3895ff97 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jakob=20Sch=C3=B6ttl?= Date: Mon, 5 Jan 2026 23:35:57 +0100 Subject: [PATCH 9/9] Add tests --- tests/print/print-actual-no-results.test.txt | 5 +++++ tests/print/print-actual.test | 11 +++++++++++ tests/print/print-format3.test | 6 ++++++ 3 files changed, 22 insertions(+) create mode 100644 tests/print/print-actual-no-results.test.txt create mode 100644 tests/print/print-actual.test diff --git a/tests/print/print-actual-no-results.test.txt b/tests/print/print-actual-no-results.test.txt new file mode 100644 index 0000000..5551b1d --- /dev/null +++ b/tests/print/print-actual-no-results.test.txt @@ -0,0 +1,5 @@ +$ echo foo + +$ cat --invalid-option + +$ false diff --git a/tests/print/print-actual.test b/tests/print/print-actual.test new file mode 100644 index 0000000..8301c02 --- /dev/null +++ b/tests/print/print-actual.test @@ -0,0 +1,11 @@ +$ echo foo +foo + +$ cat --invalid-option +>2 +cat: unrecognized option '--invalid-option' +Try 'cat --help' for more information. +>= 1 + +$ false +>= 1 diff --git a/tests/print/print-format3.test b/tests/print/print-format3.test index cd89065..3e4342d 100644 --- a/tests/print/print-format3.test +++ b/tests/print/print-format3.test @@ -2,3 +2,9 @@ $ shelltest --print=v3 tests/format3/ideal.test | diff -u - tests/format3/ideal.test $ shelltest --print tests/format3/ideal.test | diff -u - tests/format3/ideal.test + +$ shelltest --print --actual=update tests/format3/ideal.test | diff -u - tests/format3/ideal.test + +$ shelltest --print --actual=all tests/print/print-actual.test | diff -u - tests/print/print-actual.test + +$ cp tests/print/print-actual-no-results.test.txt /tmp/print-actual-no-results.test && shelltest --print --actual=all /tmp/print-actual-no-results.test | diff -u - tests/print/print-actual.test