New PR for --print option without printing --actual results

shelltestrunner.cabal

@@ -56,6 +56,7 @@ executable shelltest
     Import
     Parse
     Preprocessor
+    Print
     Types
     Utils
     Utils.Debug

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
@@ -69,11 +69,12 @@ shelltestfile = do
         <|>
         (many $ try format1test)
   ptrace_ "shelltestfile 1"
-  skipMany whitespaceorcommentline
+  trailingComments <- many whitespaceorcommentline
   ptrace_ "shelltestfile 2"
   eof
-  ptrace "shelltestfile ." ts
-  return ts
+  let ts' = appendTrailingComments trailingComments ts
+  ptrace "shelltestfile ." ts'
+  return ts'
 
 
 ----------------------------------------------------------------------
@@ -82,7 +83,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 +98,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,trailingComments=[]}
   ptrace " format1test ." t
   return t
 
@@ -151,7 +152,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 +167,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,trailingComments=[]}
   ptrace "  format2test ." t
   return t
 
@@ -249,7 +250,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 +265,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,trailingComments=[]}
   ptrace "  format3test ." t
   return t
 
@@ -327,6 +328,11 @@ delimiterNotNewTest3 = do
 ----------------------------------------------------------------------
 -- common
 
+appendTrailingComments :: [String] -> [ShellTest] -> [ShellTest]
+appendTrailingComments _ [] = [] -- in this case, trailing comment are discarded
+appendTrailingComments cs ts =
+      init ts ++ [(last ts) { trailingComments = cs }]
+
 linesBetween :: [String] -> [String] -> Parser String
 linesBetween startdelims enddelims = do
   let delimp "" = string ""
@@ -390,8 +396,14 @@ line = (anyChar `manyTill` newline) <?> "rest of line"
 whitespacechar = oneOf " \t"
 whitespace = many whitespacechar
 whitespaceline = try (newline >> return "") <|> try (whitespacechar >> whitespacechar `manyTill` newlineoreof)
+
 -- a line beginning with optional whitespace and #, or beginning with one or more * (an org node)
-commentline = try ((many1 (char '*') <|> (whitespace >> many1 (char '#'))) >> lineoreof) <?> "comments"
+commentline = try (do
+  prefix <- many1 (char '*') <|> (whitespace >> many1 (char '#'))
+  rest <- lineoreof
+  return $ prefix ++ rest
+  ) <?> "comments"
+
 whitespaceorcommentline = commentline <|> whitespaceline
 whitespaceorcommentlineoreof = choice [eofasstr, commentline, whitespaceline]
 eofasstr = eof >> return ""

src/Print.hs

@@ -0,0 +1,67 @@
+module Print
+where
+
+import Import
+import Types
+
+-- | Print a shell test. See CLI documentation for details.
+printShellTest
+  :: String               -- ^ Shelltest format. Value of option @--print[=FORMAT]@.
+  -> ShellTest            -- ^ Test to print
+  -> IO ()
+printShellTest format 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 ">>>" o_expected
+              printStdouterr ">>>2" e_expected
+              printExitStatus True ">>>=" x_expected
+              printComments trailingComments
+            "v2" -> do
+              printComments comments
+              printCommand "$$$ " c
+              printStdin "<<<" i
+              printStdouterr ">>>" o_expected
+              printStdouterr ">>>2" e_expected
+              printExitStatus False ">>>=" x_expected
+              printComments trailingComments
+            "v3" -> do
+              printComments comments
+              printCommand "$ "  c
+              printStdin "<" i
+              printStdouterr ">" o_expected
+              printStdouterr ">2" e_expected
+              printExitStatus False ">=" x_expected
+              printComments trailingComments
+            _ -> fail $ "Unsupported --print format: " ++ format
+
+printComments :: [String] -> IO ()
+printComments = mapM_ putStrLn
+
+printStdin :: String -> Maybe String -> IO ()
+printStdin _ (Just "") = return ()
+printStdin _ Nothing = return ()
+printStdin prefix (Just s) = printf "%s\n%s" prefix s
+
+printCommand :: String -> TestCommand -> IO ()
+printCommand prefix (ReplaceableCommand s) = printf "%s%s\n" prefix s
+printCommand prefix (FixedCommand s)       = printf "%s %s\n" prefix s
+
+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" prefix s
+printStdouterr prefix (Just regex)          = printf "%s %s\n" prefix (show regex)
+
+-- | Print exit status. 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)

src/Types.hs

@@ -4,9 +4,11 @@ where
 import Import
 import Utils
 import Text.Parsec
-  
+
 data ShellTest = ShellTest {
-     command          :: TestCommand
+     comments         :: [String] -- # COMMENTS OR BLANK LINES before test
+    ,trailingComments :: [String] -- # COMMENTS OR BLANK LINES after the last test
+    ,command          :: TestCommand
     ,stdin            :: Maybe String
     ,stdoutExpected   :: Maybe Matcher
     ,stderrExpected   :: Maybe Matcher
@@ -43,8 +45,8 @@ instance Show Matcher where show = showMatcherTrimmed
 showMatcherTrimmed :: Matcher -> String
 showMatcherTrimmed (PositiveRegex r)   = "/"++(trim r)++"/"
 showMatcherTrimmed (NegativeRegex r)   = "!/"++(trim r)++"/"
-showMatcherTrimmed (Numeric s)         = trim (show s)
-showMatcherTrimmed (NegativeNumeric s) = "!"++ trim (show s)
+showMatcherTrimmed (Numeric s)         = trim s
+showMatcherTrimmed (NegativeNumeric s) = "!"++ trim s
 showMatcherTrimmed (Lines _ s)         = trim s
 
 showMatcher :: Matcher -> String

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,7 @@ data Args = Args {
     ,debug       :: Bool
     ,debug_parse :: Bool
     ,testpaths   :: [FilePath]
+    ,print_      :: Maybe String
     } deriving (Show, Data, Typeable)
 
 argdefs = Args {
@@ -88,6 +90,7 @@ 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)."
     }
     &= helpArg [explicit, name "help", name "h"]
     &= program progname
@@ -132,10 +135,18 @@ 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) ts
+printShellTestsWithResults _ (Left e) = putStrLn $ "*** parse error in " ++ (sourceName $ errorPos e)
 
 -- | Additional argument checking.
 checkArgs :: Args -> IO Args
@@ -144,21 +155,17 @@ checkArgs args = do
        warn $ printf "Please specify at least one test file or directory, eg: %s tests" progname
   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 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 -> ShellTest -> IO ()
+prepareShellTest args 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
@@ -175,9 +182,11 @@ shellTestToHUnitTest args ShellTest{testname=n,command=c,stdin=i,stdoutExpected=
   let outputMatch = maybe True (o_actual `matches`) o_expected
   let errorMatch = maybe True (e_actual `matches`) e_expected
   let exitCodeMatch = show x_actual `matches` x_expected
-  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) [
+  case print_ args of
+    Just format -> printShellTest format st
+    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) [
              if any not [outputMatch, errorMatch, exitCodeMatch]
                then printf "Command (at line %s):\n%s\n" (show ln) cmd
                else ""

tests/examples/cat.test

@@ -5,7 +5,6 @@ cat
 foo
 >>>
 foo
->>>2
 >>>= 0
 
 # Test that cat prints an error containing "unrecognized option" 

tests/format2/ideal.test

@@ -0,0 +1,14 @@
+$$$  false
+>>>= 1
+
+# no comment at begin of file because they are currently not parsed because of shared input
+
+$$$  echo foo
+>>>
+foo
+
+$$$  cat --unknown-option
+>>>2 /option/
+>>>= 1
+
+# comment at end of file

tests/format3/ideal.test

@@ -0,0 +1,14 @@
+$  false
+>= 1
+
+# no comment at begin of file because they are currently not parsed because of shared input
+
+$  echo foo
+>
+foo
+
+$  cat --unknown-option
+>2 /option/
+>= 1
+
+# comment at end of file

tests/print/print-format1.test

@@ -0,0 +1,6 @@
+
+$ shelltest --print=v1 tests/examples/cat.test | diff -u - tests/examples/cat.test
+
+$ shelltest --print=v1 tests/examples/echo.test | diff -u - tests/examples/echo.test
+
+$ shelltest --print=v1 tests/format1/abstract-test-with-macros | diff -u - tests/format1/abstract-test-with-macros

tests/print/print-format2.test

@@ -0,0 +1,2 @@
+
+$ shelltest --print=v2 tests/format2/ideal.test | diff -u - tests/format2/ideal.test

tests/print/print-format3.test

@@ -0,0 +1,2 @@
+
+$ shelltest --print=v3 tests/format3/ideal.test | diff -u - tests/format3/ideal.test