Added new test framework Tests.Command.

Any files added under test/command will be treated as
shell tests (see smart.md for an example).

This makes it very easy to add regression tests etc.
This commit is contained in:
John MacFarlane 2017-02-04 21:07:03 +01:00
parent e0abe18bb9
commit 49c7cf40fe
2 changed files with 59 additions and 19 deletions

View file

@ -1,19 +1,22 @@
module Tests.Command (findPandoc, runTest, tests)
where
import Test.Framework (testGroup, Test )
import Test.Framework
import Test.Framework.Providers.HUnit
import Test.HUnit ( assertBool )
import System.Environment.Executable (getExecutablePath)
import System.FilePath ( (</>), takeDirectory, splitDirectories,
joinPath )
import System.Process
import System.Directory
import System.Exit
import Text.Pandoc
import Data.Algorithm.Diff
import Prelude hiding ( readFile )
import qualified Text.Pandoc.UTF8 as UTF8
import Text.Printf
import Text.Pandoc.Process (pipeProcess)
import Data.List (isSuffixOf)
import Text.Pandoc.Shared (trimr)
data TestResult = TestPassed
| TestError ExitCode
@ -53,28 +56,27 @@ findPandoc = do
xs -> joinPath (init xs) </> "pandoc" </> "pandoc"
-- | Run a test with normalize function, return True if test passed.
runTest :: FilePath -- ^ pandoc executable path
-> String -- ^ Title of test
-> [String] -- ^ Options to pass to pandoc
runTest :: String -- ^ Title of test
-> String -- ^ Shell command
-> String -- ^ Input text
-> String -- ^ Expected output
-> Test
runTest pandocPath testname opts inp norm = testCase testname $ do
let options = ["--quiet", "--data-dir", ".." </> "data"] ++ opts
let cmd = unwords ((pandocPath </> "pandoc") : options)
runTest testname cmd inp norm = testCase testname $ do
let cmd' = cmd ++ " --quiet --data-dir ../data"
let findDynlibDir [] = Nothing
findDynlibDir ("build":xs) = Just $ joinPath (reverse xs) </> "build"
findDynlibDir (_:xs) = findDynlibDir xs
let mbDynlibDir = findDynlibDir (reverse $ splitDirectories pandocPath)
let mbDynlibDir = findDynlibDir (reverse $ splitDirectories $
takeDirectory $ takeWhile (/=' ') cmd)
let dynlibEnv = case mbDynlibDir of
Nothing -> []
Just d -> [("DYLD_LIBRARY_PATH", d),
("LD_LIBRARY_PATH", d)]
let env = dynlibEnv ++ [("TMP","."),("LANG","en_US.UTF-8"),("HOME", "./")]
(ec, outbs) <- pipeProcess (Just env) pandocPath options
(UTF8.fromStringLazy inp)
let env' = dynlibEnv ++ [("TMP","."),("LANG","en_US.UTF-8"),("HOME", "./")]
let pr = (shell cmd'){ env = Just env' }
(ec, out', _err) <- readCreateProcessWithExitCode pr inp
-- filter \r so the tests will work on Windows machines
let out = filter (/= '\r') $ UTF8.toStringLazy outbs
let out = filter (/= '\r') out'
result <- if ec == ExitSuccess
then do
if out == norm
@ -85,7 +87,45 @@ runTest pandocPath testname opts inp norm = testCase testname $ do
else return $ TestError ec
assertBool (show result) (result == TestPassed)
tests :: [Test]
tests = [ testGroup "commands"
[ ]
]
tests :: Test
tests = buildTest $ do
files <- filter (".md" `isSuffixOf`) <$>
getDirectoryContents "command"
let cmds = map extractCommandTest files
return $ testGroup "Command:" cmds
isCodeBlock :: Block -> Bool
isCodeBlock (CodeBlock _ _) = True
isCodeBlock _ = False
extractCode :: Block -> String
extractCode (CodeBlock _ code) = code
extractCode _ = ""
dropPercent :: String -> String
dropPercent ('%':xs) = dropWhile (== ' ') xs
dropPercent xs = xs
runCommandTest :: FilePath -> (Int, String) -> IO Test
runCommandTest pandocpath (num, code) = do
let codelines = lines code
let (continuations, r1) = span ("\\" `isSuffixOf`) codelines
let (cmd, r2) = (dropPercent (unwords (map init continuations ++ take 1 r1)),
drop 1 r1)
let (inplines, r3) = break (=="^D") r2
let normlines = takeWhile (/=".") (drop 1 r3)
let input = unlines inplines
let norm = unlines normlines
let shcmd = trimr $ takeDirectory pandocpath </> cmd
return $ runTest ("#" ++ show num) shcmd input norm
extractCommandTest :: FilePath -> Test
extractCommandTest fp = buildTest $ do
pandocpath <- findPandoc
contents <- UTF8.readFile ("command" </> fp)
Pandoc _ blocks <- runIOorExplode (readMarkdown
def{ readerExtensions = pandocExtensions } contents)
let codeblocks = map extractCode $ filter isCodeBlock $ blocks
cases <- mapM (runCommandTest pandocpath) $ zip [1..] codeblocks
return $ testGroup fp cases

View file

@ -31,8 +31,8 @@ import Text.Pandoc.Shared (inDirectory)
import System.Environment (getArgs)
tests :: [Test]
tests = [ testGroup "Old" Tests.Old.tests
, testGroup "Command" Tests.Command.tests
tests = [ Tests.Command.tests
, testGroup "Old" Tests.Old.tests
, testGroup "Shared" Tests.Shared.tests
, testGroup "Writers"
[ testGroup "Native" Tests.Writers.Native.tests