From cb0a90cbd75051cbaa26c77e70017a79899e7a69 Mon Sep 17 00:00:00 2001
From: Simon Michael <simon@joyful.com>
Date: Sat, 11 Jul 2009 22:30:10 +0000
Subject: [PATCH] shelltestrunner now packaged separately, update tests for it

---
 Makefile                                      |  11 +-
 tests/add-bad-date-fails.test                 |   6 +-
 tests/add-blank-date.test                     |   6 +-
 tests/add-blank-description-fails.test        |   6 +-
 tests/amountless-virtual-postings.test        |   2 +-
 tests/comment-line-after-postings.test        |   2 +-
 tests/commented-posting.test                  |   2 +-
 tests/effective-balance.test                  |   2 +-
 tests/effective-print.test                    |   2 +-
 tests/effective-register.test                 |   2 +-
 tests/eliding-balance.test                    |   2 +-
 tests/missing-real-and-virtual-amt.test       |   2 +-
 tests/null-accountname-component.test         |   5 +-
 tests/parens-in-account-name.test             |   2 +-
 tests/unbalanced.test                         |   5 +-
 tests/unicode-account-matching.test           |   2 +-
 tests/unicode-balance.test                    |   2 +-
 tests/unicode-description-matching.test       |   2 +-
 .../unicode-error-message.test.notimplemented |   2 +-
 tests/unicode-print.test                      |   2 +-
 tests/unicode-register.test                   |   2 +-
 tests/virtual.test                            |   2 +-
 tools/shelltest.hs                            | 157 ------------------
 23 files changed, 35 insertions(+), 193 deletions(-)
 delete mode 100644 tools/shelltest.hs

diff --git a/Makefile b/Makefile
index 05693854b..4a8b682de 100644
--- a/Makefile
+++ b/Makefile
@@ -87,10 +87,6 @@ continuous ci: setversion
 tools/unittest: tools/unittest.hs
 	ghc --make -threaded -O2 tools/unittest.hs
 
-# build the shell test runner. Requires test-framework.
-tools/shelltest: tools/shelltest.hs
-	ghc --make -threaded -O2 tools/shelltest.hs
-
 # build the doctest runner
 tools/doctest: tools/doctest.hs
 	ghc --make tools/doctest.hs
@@ -134,9 +130,10 @@ unittesths:
 	@(runghc hledger.hs test \
 		&& echo $@ passed) || echo $@ FAILED
 
-# run functional tests
-functest: tools/shelltest
-	@(tools/shelltest tests/*.test -j8 \
+# run functional tests, requires shelltestrunner from hackage
+# -j8 not working yet
+functest: hledger
+	@(shelltestrunner ./hledger tests/*.test \
 		&& echo $@ passed) || echo $@ FAILED
 
 # run doc tests
diff --git a/tests/add-bad-date-fails.test b/tests/add-bad-date-fails.test
index 211b6cf3c..9256eea10 100644
--- a/tests/add-bad-date-fails.test
+++ b/tests/add-bad-date-fails.test
@@ -1,4 +1,4 @@
 # ignore the binary we are invoked with
--f/dev/null; echo "2009/1/32" | hledger add 2>&1 | tail -1 | sed -e's/\[[^]]*\]//g'
->>>
-date : date : 
+-f/dev/null; echo "2009/1/32" | hledger add 2>&1 | sed -e's/\[[^]]*\]//g' | grep -q 'date : date :'
+>>>=
+0
diff --git a/tests/add-blank-date.test b/tests/add-blank-date.test
index d2e312c05..b1e41c9a8 100644
--- a/tests/add-blank-date.test
+++ b/tests/add-blank-date.test
@@ -1,4 +1,4 @@
 # ignore the binary we are invoked with
--f/dev/null; echo | hledger add 2>&1 |tail -1 |sed -e's/\[[^]]*\]//g'
->>>
-date : description: 
+-f/dev/null; echo | hledger add 2>&1 |sed -e's/\[[^]]*\]//g' | grep -q 'date : description:'
+>>>=
+0
diff --git a/tests/add-blank-description-fails.test b/tests/add-blank-description-fails.test
index a1fb80988..c68343c40 100644
--- a/tests/add-blank-description-fails.test
+++ b/tests/add-blank-description-fails.test
@@ -1,4 +1,4 @@
 # ignore the binary we are invoked with
--f/dev/null; printf "\n\n" | hledger add 2>&1 |tail -1 | sed -e's/\[[^]]*\]//g'
->>>
-date : description: description: 
+-f/dev/null; printf "\n\n" | hledger add 2>&1 | sed -e's/\[[^]]*\]//g' | grep -q 'date : description: description:'
+>>>=
+0
diff --git a/tests/amountless-virtual-postings.test b/tests/amountless-virtual-postings.test
index 2ed85551a..dceba1196 100644
--- a/tests/amountless-virtual-postings.test
+++ b/tests/amountless-virtual-postings.test
@@ -1,4 +1,4 @@
-print
+-f - print
 <<<
 2009/1/1 x
  a  1
diff --git a/tests/comment-line-after-postings.test b/tests/comment-line-after-postings.test
index aff2dc92c..3700ab469 100644
--- a/tests/comment-line-after-postings.test
+++ b/tests/comment-line-after-postings.test
@@ -1,4 +1,4 @@
-print
+-f - print
 <<<
 2009/01/01 x
     a  1
diff --git a/tests/commented-posting.test b/tests/commented-posting.test
index 615a95253..19072e98e 100644
--- a/tests/commented-posting.test
+++ b/tests/commented-posting.test
@@ -1,4 +1,4 @@
-print
+-f - print
 <<<
 2009/01/01 x
     ; comment line within postings
diff --git a/tests/effective-balance.test b/tests/effective-balance.test
index 8c1a19cc9..4c0496900 100644
--- a/tests/effective-balance.test
+++ b/tests/effective-balance.test
@@ -1,4 +1,4 @@
-balance -p 'in 2009' --effective
+-f - balance -p 'in 2009' --effective
 <<<
 2009/1/1 x
   a  1
diff --git a/tests/effective-print.test b/tests/effective-print.test
index 1193144dc..99df8db80 100644
--- a/tests/effective-print.test
+++ b/tests/effective-print.test
@@ -1,4 +1,4 @@
-print --effective
+-f - print --effective
 <<<
 2009/1/1[=2010/1/1] x
   a  1
diff --git a/tests/effective-register.test b/tests/effective-register.test
index 3852c7e6a..154f8fa36 100644
--- a/tests/effective-register.test
+++ b/tests/effective-register.test
@@ -1,4 +1,4 @@
-register --effective
+-f - register --effective
 <<<
 2009/1/1[=2010/1/1] x
   a  1
diff --git a/tests/eliding-balance.test b/tests/eliding-balance.test
index 47513c7ab..d63adacf1 100644
--- a/tests/eliding-balance.test
+++ b/tests/eliding-balance.test
@@ -1,4 +1,4 @@
-balance
+-f - balance
 <<<
 2009/1/1 x
  aaaaaaaaaaaaaaaaaaaa:aaaaaaaaaaaaaaaaaaaa:aaaaaaaaaaaaaaaaaaaa  €1
diff --git a/tests/missing-real-and-virtual-amt.test b/tests/missing-real-and-virtual-amt.test
index a871764c9..ed47aba9f 100644
--- a/tests/missing-real-and-virtual-amt.test
+++ b/tests/missing-real-and-virtual-amt.test
@@ -1,4 +1,4 @@
-register
+-f - register
 <<<
 2009/6/24 carwash
     equity:draw:personal:transportation:car:carwash     $3.50
diff --git a/tests/null-accountname-component.test b/tests/null-accountname-component.test
index 944d3c66b..a963332e3 100644
--- a/tests/null-accountname-component.test
+++ b/tests/null-accountname-component.test
@@ -1,4 +1,4 @@
-balance -E
+-f - balance -E
 <<<
 2009/1/1 x
  a:  13
@@ -7,4 +7,5 @@ balance -E
 hledger: parse error at (line 1, column 4):
 unexpected " "
 accountname seems ill-formed: a:
-===1
+>>>=
+1
diff --git a/tests/parens-in-account-name.test b/tests/parens-in-account-name.test
index 658cc7bfb..6fbff5e7c 100644
--- a/tests/parens-in-account-name.test
+++ b/tests/parens-in-account-name.test
@@ -1,4 +1,4 @@
-print
+-f - print
 <<<
 2009-01-01 x
   a  2
diff --git a/tests/unbalanced.test b/tests/unbalanced.test
index 7f0ef802f..b4cdc4c40 100644
--- a/tests/unbalanced.test
+++ b/tests/unbalanced.test
@@ -1,5 +1,5 @@
 # shouldn't exit code be 1 ?
-register
+-f - register
 <<<
 2009/1/1 a
   b  1.1
@@ -13,4 +13,5 @@ could not balance this transaction, amounts do not add up to zero:
     c                                             -1
 
 
-===0
+>>>=
+0
diff --git a/tests/unicode-account-matching.test b/tests/unicode-account-matching.test
index 4565bf3cd..70f28fcdb 100644
--- a/tests/unicode-account-matching.test
+++ b/tests/unicode-account-matching.test
@@ -1,4 +1,4 @@
-register τράπ
+-f - register τράπ
 <<<
 2009-01-01 проверка
   τράπεζα  10 руб
diff --git a/tests/unicode-balance.test b/tests/unicode-balance.test
index 920a0fd81..afe0b0bd5 100644
--- a/tests/unicode-balance.test
+++ b/tests/unicode-balance.test
@@ -1,4 +1,4 @@
-balance
+-f - balance
 <<<
 2009-01-01 проверка
   τράπεζα  10 руб
diff --git a/tests/unicode-description-matching.test b/tests/unicode-description-matching.test
index bba167090..730b77d02 100644
--- a/tests/unicode-description-matching.test
+++ b/tests/unicode-description-matching.test
@@ -1,4 +1,4 @@
-register desc:аура
+-f - register desc:аура
 <<<
 2009-01-01 аура (cyrillic letters)
   bank  10
diff --git a/tests/unicode-error-message.test.notimplemented b/tests/unicode-error-message.test.notimplemented
index 4fb08acbf..76edf820c 100644
--- a/tests/unicode-error-message.test.notimplemented
+++ b/tests/unicode-error-message.test.notimplemented
@@ -1,4 +1,4 @@
-balance
+-f - balance
 <<<
 2009-01-01 broken entry
   дебит    1
diff --git a/tests/unicode-print.test b/tests/unicode-print.test
index 0fa923f4e..c15090377 100644
--- a/tests/unicode-print.test
+++ b/tests/unicode-print.test
@@ -1,4 +1,4 @@
-print
+-f - print
 <<<
 2009-01-01 проверка
  счёт:первый  1
diff --git a/tests/unicode-register.test b/tests/unicode-register.test
index b48aae8f6..a2d2ec55b 100644
--- a/tests/unicode-register.test
+++ b/tests/unicode-register.test
@@ -1,4 +1,4 @@
-register
+-f - register
 <<<
 2009-01-01 проверка
   τράπεζα  10 руб
diff --git a/tests/virtual.test b/tests/virtual.test
index dba62af89..af218fcd7 100644
--- a/tests/virtual.test
+++ b/tests/virtual.test
@@ -1,4 +1,4 @@
-print
+-f - print
 <<<
 2009/1/1 x
   (virtual)  100
diff --git a/tools/shelltest.hs b/tools/shelltest.hs
deleted file mode 100644
index f15865c7e..000000000
--- a/tools/shelltest.hs
+++ /dev/null
@@ -1,157 +0,0 @@
-#!/usr/bin/env runhaskell
-{-
-
-shelltest.hs (c) 2009 Simon Michael <simon@joyful.com>
-
-Run one or more hledger command-line tests, specified by .test files like
-those used in the ledger project. A ledger-style .test file contains a
-partial command line, input, expected output, expected error output, and
-expected exit code separated by delimiters.
-
-Usage: $ shelltest [OPTS] *.test
-
-This version uses the test-framework test runner. Any command-line arguments
-beginning with - are passed through to that. So avoid spaces: use -tpattern
-not -t pattern. To get a speedup, try adding -j8.
-
-Here is the .test file format:
-@
---option1 arg1 arg2
-<<<
-lines of
-input
->>>
-expected
-output
->>>2
-expected
-error output
-===0
-;
-; Lines whose first non-whitespace character is ; are ignored.
-; The first line is the command line. "hledger" is prepended, and "-f-" is
-; appended unless there is a -f or <... argument, in which case any
-; provided input is ignored.
-; Then there is a line containing <<< and 0 or more lines of input.
-; Then a line containing >>> (or >>>1 for ledger testrunner compatibility)
-; and 0 or more lines of expected output.
-; Then a line containing >>>2 and 0 or more lines of expected stderr output.
-; Then === and the expected exit code (on the same line).
-; All fields except for the command line are optional, when omitted they
-; are assumed to be "", "", "", and 0 respectively.
-@
--}
-
-module Main where
---import System (getArgs)
-import System.Environment (getArgs,withArgs)
-import System.Exit (exitFailure, exitWith, ExitCode(..))
-import System.IO (hGetContents, hPutStr, stderr {-, stdout, hFlush-})
-import System.Process (runInteractiveCommand, waitForProcess)
-import Text.Printf (printf)
-import Text.ParserCombinators.Parsec
-import Control.Monad (liftM,when)
-import Data.Maybe (fromMaybe)
-import Data.List (partition)
-
-import Test.Framework (defaultMain {-, testGroup-})
-import Test.Framework.Providers.HUnit (hUnitTestToTests)
---import Test.Framework.Providers.QuickCheck2 (testProperty)
-import Test.HUnit hiding (Test)
-import qualified Test.HUnit (Test)
---import Test.QuickCheck
---import Tests (tests)
-
-import Debug.Trace
-strace :: Show a => a -> a
-strace a = trace (show a) a
-
-
-exe :: String
-exe = "hledger"
-
-data ShellTest = ShellTest {
-     filename         :: String
-    ,command          :: String
-    ,stdin            :: Maybe String
-    ,stdoutExpected   :: Maybe String
-    ,stderrExpected   :: Maybe String
-    ,exitCodeExpected :: Maybe ExitCode
-    } deriving (Show)
-
-main :: IO ()
-main = do
-  args <- getArgs
-  let (opts,files) = partition ((=="-").take 1) args
-  shelltests <-  mapM parseShellTest files
-  withArgs opts $ defaultMain $ concatMap (hUnitTestToTests.shellTestToHUnitTest) shelltests
-
-shellTestToHUnitTest :: ShellTest -> Test.HUnit.Test
-shellTestToHUnitTest t = filename t ~: do {r <- runShellTest t; assertBool "" r}
-
-parseShellTest :: FilePath -> IO ShellTest
-parseShellTest = liftM (either (error.show) id) . parseFromFile shelltest
-
-shelltest :: Parser ShellTest
-shelltest = do
-  st <- getParserState
-  let f = sourceName $ statePos st
-  c <- commandline
-  i <- optionMaybe input
-  o <- optionMaybe expectedoutput
-  e <- optionMaybe expectederror
-  x <- optionMaybe expectedexitcode
-  return ShellTest{filename=f,command=c,stdin=i,stdoutExpected=o,stderrExpected=e,exitCodeExpected=x}
-
-commandline,input,expectedoutput,expectederror,delimiter,line :: Parser String
-commandline = line
-input = string "<<<\n" >> (liftM unlines) (line `manyTill` (lookAhead delimiter))
-expectedoutput = try $ string ">>>" >> optional (char '1') >> char '\n' >> (liftM unlines) (line `manyTill` (lookAhead delimiter))
-expectederror = string ">>>2" >> (liftM $ unlines.tail) (line `manyTill` (lookAhead delimiter)) -- why tail ?
-delimiter = choice [try $ string "<<<", try $ string ">>>", try $ string "===", (eof >> return "")]
-line =  do
-  l <- anyChar `manyTill` newline
-  if take 1 (strip l) == ";" then line else return l
-expectedexitcode :: Parser ExitCode
-expectedexitcode = string "===" >> liftM (toExitCode.read) line -- `catch` (\e -> fail (show e))
-
-runShellTest :: ShellTest -> IO Bool
-runShellTest ShellTest{
-    filename=_,command=c,stdin=i,stdoutExpected=o,stderrExpected=e,exitCodeExpected=x} = do
-  let cmd = unwords [exe,c,if (any isinputarg $ words c) then "" else "-f-"]
-            where isinputarg a = take 2 a == "-f" || (take 1 a == "<")
-      (i',o',e',x') = (fromMaybe "" i, fromMaybe "" o, fromMaybe "" e, fromMaybe ExitSuccess x)
-  -- printf "%s .. " f; hFlush stdout
-  (ih,oh,eh,ph) <- runInteractiveCommand cmd
-  hPutStr ih i'
-  out <- hGetContents oh
-  err <- hGetContents eh
-  exit <- waitForProcess ph
-  let (outputok, errorok, exitok) = (out==o', err==e', exit==x')
-  if outputok && errorok && exitok 
-   then do
-     -- putStrLn "ok"
-     return True 
-   else do
-     -- hPutStr stderr $ printf "FAIL\n"
-     when (not outputok) $ printExpectedActual "stdout" o' out
-     when (not errorok)  $ printExpectedActual "stderr" e' err
-     when (not exitok)   $ printExpectedActual "exit code" (show (fromExitCode x')++"\n") (show (fromExitCode exit)++"\n")
-     return False
-
-printExpectedActual :: String -> String -> String -> IO ()
-printExpectedActual f e a = hPutStr stderr $ printf "**Expected %s:\n%s**Got:\n%s" f e a
-
-toExitCode :: Int -> ExitCode
-toExitCode 0 = ExitSuccess
-toExitCode n = ExitFailure n
-
-fromExitCode :: ExitCode -> Int
-fromExitCode ExitSuccess     = 0
-fromExitCode (ExitFailure n) = n
-
-strip,lstrip,rstrip,dropws :: String -> String
-strip = lstrip . rstrip
-lstrip = dropws
-rstrip = reverse . dropws . reverse
-dropws = dropWhile (`elem` " \t")