git.iko.soy/typeable/pandoc
on master help sign in
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.

commit49c7cf40fecf64f1da1ff9e2e341117cb299afa8 authorJohn MacFarlane <jgm@berkeley.edu> dateSat 4 Feb 2017, 21:07 (10 years ago) parente0abe18
2 files changed+59−19
test/Tests/Command.hs+57−17 test/test-pandoc.hs+2−2
test/Tests/Command.hs+57−17
@@ -1,19 +1,22 @@
11module Tests.Command (findPandoc, runTest, tests)
22where
33
4−import Test.Framework (testGroup, Test )
4+import Test.Framework
55import Test.Framework.Providers.HUnit
66import Test.HUnit ( assertBool )
77import System.Environment.Executable (getExecutablePath)
88import System.FilePath ( (</>), takeDirectory, splitDirectories,
99 joinPath )
10+import System.Process
1011import System.Directory
1112import System.Exit
13+import Text.Pandoc
1214import Data.Algorithm.Diff
1315import Prelude hiding ( readFile )
1416import qualified Text.Pandoc.UTF8 as UTF8
1517import Text.Printf
16−import Text.Pandoc.Process (pipeProcess)
18+import Data.List (isSuffixOf)
19+import Text.Pandoc.Shared (trimr)
1720
1821data TestResult = TestPassed
1922 | TestError ExitCode
@@ -53,28 +56,27 @@ findPandoc = do
5356 xs -> joinPath (init xs) </> "pandoc" </> "pandoc"
5457
5558-- | Run a test with normalize function, return True if test passed.
56−runTest :: FilePath -- ^ pandoc executable path
57− -> String -- ^ Title of test
58− -> [String] -- ^ Options to pass to pandoc
59+runTest :: String -- ^ Title of test
60+ -> String -- ^ Shell command
5961 -> String -- ^ Input text
6062 -> String -- ^ Expected output
6163 -> Test
62−runTest pandocPath testname opts inp norm = testCase testname $ do
63− let options = ["--quiet", "--data-dir", ".." </> "data"] ++ opts
64− let cmd = unwords ((pandocPath </> "pandoc") : options)
64+runTest testname cmd inp norm = testCase testname $ do
65+ let cmd' = cmd ++ " --quiet --data-dir ../data"
6566 let findDynlibDir [] = Nothing
6667 findDynlibDir ("build":xs) = Just $ joinPath (reverse xs) </> "build"
6768 findDynlibDir (_:xs) = findDynlibDir xs
68− let mbDynlibDir = findDynlibDir (reverse $ splitDirectories pandocPath)
69+ let mbDynlibDir = findDynlibDir (reverse $ splitDirectories $
70+ takeDirectory $ takeWhile (/=' ') cmd)
6971 let dynlibEnv = case mbDynlibDir of
7072 Nothing -> []
7173 Just d -> [("DYLD_LIBRARY_PATH", d),
7274 ("LD_LIBRARY_PATH", d)]
73− let env = dynlibEnv ++ [("TMP","."),("LANG","en_US.UTF-8"),("HOME", "./")]
74− (ec, outbs) <- pipeProcess (Just env) pandocPath options
75− (UTF8.fromStringLazy inp)
75+ let env' = dynlibEnv ++ [("TMP","."),("LANG","en_US.UTF-8"),("HOME", "./")]
76+ let pr = (shell cmd'){ env = Just env' }
77+ (ec, out', _err) <- readCreateProcessWithExitCode pr inp
7678 -- filter \r so the tests will work on Windows machines
77− let out = filter (/= '\r') $ UTF8.toStringLazy outbs
79+ let out = filter (/= '\r') out'
7880 result <- if ec == ExitSuccess
7981 then do
8082 if out == norm
@@ -85,7 +87,45 @@ runTest pandocPath testname opts inp norm = testCase testname $ do
8587 else return $ TestError ec
8688 assertBool (show result) (result == TestPassed)
8789
88−tests :: [Test]
89−tests = [ testGroup "commands"
90− [ ]
91− ]
90+tests :: Test
91+tests = buildTest $ do
92+ files <- filter (".md" `isSuffixOf`) <$>
93+ getDirectoryContents "command"
94+ let cmds = map extractCommandTest files
95+ return $ testGroup "Command:" cmds
96+
97+isCodeBlock :: Block -> Bool
98+isCodeBlock (CodeBlock _ _) = True
99+isCodeBlock _ = False
100+
101+extractCode :: Block -> String
102+extractCode (CodeBlock _ code) = code
103+extractCode _ = ""
104+
105+dropPercent :: String -> String
106+dropPercent ('%':xs) = dropWhile (== ' ') xs
107+dropPercent xs = xs
108+
109+runCommandTest :: FilePath -> (Int, String) -> IO Test
110+runCommandTest pandocpath (num, code) = do
111+ let codelines = lines code
112+ let (continuations, r1) = span ("\\" `isSuffixOf`) codelines
113+ let (cmd, r2) = (dropPercent (unwords (map init continuations ++ take 1 r1)),
114+ drop 1 r1)
115+ let (inplines, r3) = break (=="^D") r2
116+ let normlines = takeWhile (/=".") (drop 1 r3)
117+ let input = unlines inplines
118+ let norm = unlines normlines
119+ let shcmd = trimr $ takeDirectory pandocpath </> cmd
120+ return $ runTest ("#" ++ show num) shcmd input norm
121+
122+extractCommandTest :: FilePath -> Test
123+extractCommandTest fp = buildTest $ do
124+ pandocpath <- findPandoc
125+ contents <- UTF8.readFile ("command" </> fp)
126+ Pandoc _ blocks <- runIOorExplode (readMarkdown
127+ def{ readerExtensions = pandocExtensions } contents)
128+ let codeblocks = map extractCode $ filter isCodeBlock $ blocks
129+ cases <- mapM (runCommandTest pandocpath) $ zip [1..] codeblocks
130+ return $ testGroup fp cases
131+
test/test-pandoc.hs+2−2
@@ -31,8 +31,8 @@ import Text.Pandoc.Shared (inDirectory)
3131import System.Environment (getArgs)
3232
3333tests :: [Test]
34−tests = [ testGroup "Old" Tests.Old.tests
35− , testGroup "Command" Tests.Command.tests
34+tests = [ Tests.Command.tests
35+ , testGroup "Old" Tests.Old.tests
3636 , testGroup "Shared" Tests.Shared.tests
3737 , testGroup "Writers"
3838 [ testGroup "Native" Tests.Writers.Native.tests