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:
parent
e0abe18bb9
commit
49c7cf40fe
2 changed files with 59 additions and 19 deletions
|
@ -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
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in a new issue