Draft to print actual output

Author: schoettl

src/Parse.hs

@@ -14,7 +14,7 @@ import Preprocessor
 import System.IO hiding (stdin)
 
 
-parseFromFileWithPreprocessor :: (Parser [ShellTest]) -> PreProcessor -> FilePath -> IO (Either ParseError [ShellTest])
+parseFromFileWithPreprocessor :: Parser [ShellTest] -> PreProcessor -> FilePath -> IO (Either ParseError [ShellTest])
 parseFromFileWithPreprocessor p preproc fname =
     do
         h <- openFile fname ReadMode
@@ -82,7 +82,7 @@ shelltestfile = do
 
 format1test = do
   ptrace_ " format1test 0"
-  skipMany whitespaceorcommentline
+  comments <- many whitespaceorcommentline
   ptrace_ " format1test 1"
   ln <- sourceLine <$> getPosition
   c <- command1 <?> "command line"
@@ -97,7 +97,7 @@ format1test = do
   ptrace " format1test x" x
   when (null (show c) && (isNothing i) && (null $ catMaybes [o,e]) && null (show x)) $ fail ""
   f <- sourceName . statePos <$> getParserState
-  let t = ShellTest{testname=f,command=c,stdin=i,stdoutExpected=o,stderrExpected=e,exitCodeExpected=x,lineNumber=ln}
+  let t = ShellTest{testname=f,command=c,stdin=i,stdoutExpected=o,stderrExpected=e,exitCodeExpected=x,lineNumber=ln,comments=comments}
   ptrace " format1test ." t
   return t
 
@@ -151,7 +151,7 @@ format2testgroup inputRequiresDelimiter = do
 format2test :: Maybe String -> Parser ShellTest
 format2test i = do
   ptrace_ "  format2test 0"
-  skipMany whitespaceorcommentline
+  comments <- many whitespaceorcommentline
   ptrace_ "  format2test 1"
   ln <- sourceLine <$> getPosition
   c <- command2 <?> "command line"
@@ -166,7 +166,7 @@ format2test i = do
   ptrace "  format2test x" x
   when (null (show c) && (isNothing i) && (null $ catMaybes [o,e]) && null (show x)) $ fail ""
   f <- sourceName . statePos <$> getParserState
-  let t = ShellTest{testname=f,command=c,stdin=i,stdoutExpected=o,stderrExpected=e,exitCodeExpected=x,lineNumber=ln}
+  let t = ShellTest{testname=f,command=c,stdin=i,stdoutExpected=o,stderrExpected=e,exitCodeExpected=x,lineNumber=ln,comments=comments}
   ptrace "  format2test ." t
   return t
 
@@ -249,7 +249,7 @@ format3testgroup inputRequiresDelimiter = do
 format3test :: Maybe String -> Parser ShellTest
 format3test i = do
   ptrace_ "  format3test 0"
-  skipMany whitespaceorcommentline
+  comments <- many whitespaceorcommentline
   ptrace_ "  format3test 1"
   ln <- sourceLine <$> getPosition
   c <- command3 <?> "command line"
@@ -264,7 +264,7 @@ format3test i = do
   ptrace "  format3test x" x
   when (null (show c) && (isNothing i) && (null $ catMaybes [o,e]) && null (show x)) $ fail ""
   f <- sourceName . statePos <$> getParserState
-  let t = ShellTest{testname=f,command=c,stdin=i,stdoutExpected=o,stderrExpected=e,exitCodeExpected=x,lineNumber=ln}
+  let t = ShellTest{testname=f,command=c,stdin=i,stdoutExpected=o,stderrExpected=e,exitCodeExpected=x,lineNumber=ln,comments=comments}
   ptrace "  format3test ." t
   return t
 

src/Types.hs

@@ -4,9 +4,10 @@ where
 import Import
 import Utils
 import Text.Parsec
-  
+
 data ShellTest = ShellTest {
-     command          :: TestCommand
+     comments         :: [String] -- # COMMENTS OR BLANK LINES before test
+    ,command          :: TestCommand
     ,stdin            :: Maybe String
     ,stdoutExpected   :: Maybe Matcher
     ,stderrExpected   :: Maybe Matcher

src/Utils.hs

@@ -66,3 +66,6 @@ replace old new = replace'
                           else h : replace' ts
      len = length old
 
+-- | Show a message, usage string, and terminate with exit status 1.
+warn :: String -> IO ()
+warn s = putStrLn s >> exitWith (ExitFailure 1)

src/shelltest.hs

@@ -28,6 +28,7 @@ import Import
 import Utils
 import Types
 import Parse
+import Print
 import Preprocessor
 
 
@@ -66,6 +67,8 @@ data Args = Args {
     ,debug       :: Bool
     ,debug_parse :: Bool
     ,testpaths   :: [FilePath]
+    ,print_      :: Maybe String
+    ,actual      :: Maybe String
     } deriving (Show, Data, Typeable)
 
 argdefs = Args {
@@ -88,6 +91,8 @@ argdefs = Args {
     ,debug       = def     &= help "Show debug info while running"
     ,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). 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
@@ -132,33 +137,41 @@ main = do
   when (debug args) $ printf "processing %d test files: %s\n" (length testfiles) (intercalate ", " testfiles)
   parseresults <- mapM (parseShellTestFile (debug args || debug_parse args) preprocessor) testfiles
 
-  -- run tests
-  when (debug args) $ printf "running tests:\n"
+  -- run tests / print
   unless (debug_parse args) $
-    defaultMainWithArgs (concatMap (hUnitTestToTests . testFileParseToHUnitTest args) parseresults) tfopts
+    if isJust $ print_ args
+      then mapM_ (printShellTestsWithResults args) parseresults
+      else do
+          when (debug args) $ printf "running tests:\n"
+          defaultMainWithArgs (concatMap (hUnitTestToTests . testFileParseToHUnitTest args) parseresults) tfopts
+
+
+printShellTestsWithResults :: Args -> Either ParseError [ShellTest] -> IO ()
+printShellTestsWithResults args (Right ts) = mapM_ (prepareShellTest args True) ts
+printShellTestsWithResults _ (Left e) = putStrLn $ "*** parse error in " ++ (sourceName $ errorPos e)
 
 -- | Additional argument checking.
 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."
+  when (fromMaybe "v3" (print_ args) /= "v3") $
+       warn "Currently, --print only supports test format v3."
   return args
 
--- | Show a message, usage string, and terminate with exit status 1.
-warn :: String -> IO ()
-warn s = putStrLn s >> exitWith (ExitFailure 1)
-
-
 -- running tests
 
 testFileParseToHUnitTest :: Args -> Either ParseError [ShellTest] -> Test.HUnit.Test
-testFileParseToHUnitTest args (Right ts) = TestList $ map (shellTestToHUnitTest args) ts
+testFileParseToHUnitTest args (Right ts) = TestList $ map (\t -> testname t ~: prepareShellTest args False t) ts
 testFileParseToHUnitTest _ (Left e) = ("parse error in " ++ (sourceName $ errorPos e)) ~: (assertFailure :: (String -> IO ())) $ show e
 
-shellTestToHUnitTest :: Args -> ShellTest -> Test.HUnit.Test
-shellTestToHUnitTest args ShellTest{testname=n,command=c,stdin=i,stdoutExpected=o_expected,
-                                    stderrExpected=e_expected,exitCodeExpected=x_expected,lineNumber=ln} =
- n ~: do
+-- | Prepare test as IO action and optionally print it (as specified in args).
+prepareShellTest :: Args -> Bool -> ShellTest -> IO ()
+prepareShellTest args printTests st@ShellTest{testname=n,command=c,stdin=i,stdoutExpected=o_expected,
+                                stderrExpected=e_expected,exitCodeExpected=x_expected,lineNumber=ln} =
+ do
   let e = with args
       cmd = case (e,c) of (_:_, ReplaceableCommand s) -> e ++ " " ++ dropWhile (/=' ') s
                           (_, ReplaceableCommand s)   -> s
@@ -191,6 +204,8 @@ shellTestToHUnitTest args ShellTest{testname=n,command=c,stdin=i,stdoutExpected=
               then ""
               else showExpectedActual args{diff=False} "exit code" x_expected (show x_actual)
             ]
+  when printTests $
+   printShellTest (actual args) st (mkEither outputMatch o_actual) (mkEither errorMatch e_actual) (mkEither exitCodeMatch x_actual)
 
 -- | Run a shell command line, passing it standard input if provided,
 -- and return the standard output, standard error output and exit code.