Tests: avoid calling findPandoc multiple times.

This commit is contained in:
John MacFarlane 2019-01-31 20:56:20 -08:00
parent fdf7f07f62
commit 7c424b315c
3 changed files with 207 additions and 194 deletions

View file

@ -53,13 +53,12 @@ runTest testname pandocpath cmd inp norm = testCase testname $ do
return $ TestError ec return $ TestError ec
assertBool (show result) (result == TestPassed) assertBool (show result) (result == TestPassed)
tests :: TestTree tests :: FilePath -> TestTree
{-# NOINLINE tests #-} {-# NOINLINE tests #-}
tests = unsafePerformIO $ do tests pandocPath = unsafePerformIO $ do
pandocpath <- findPandoc
files <- filter (".md" `isSuffixOf`) <$> files <- filter (".md" `isSuffixOf`) <$>
getDirectoryContents "command" getDirectoryContents "command"
let cmds = map (extractCommandTest pandocpath) files let cmds = map (extractCommandTest pandocPath) files
return $ testGroup "Command:" cmds return $ testGroup "Command:" cmds
isCodeBlock :: Block -> Bool isCodeBlock :: Block -> Bool

View file

@ -12,214 +12,226 @@ import Test.Tasty.Golden.Advanced (goldenTest)
import Tests.Helpers hiding (test) import Tests.Helpers hiding (test)
import qualified Text.Pandoc.UTF8 as UTF8 import qualified Text.Pandoc.UTF8 as UTF8
tests :: [TestTree] tests :: FilePath -> [TestTree]
tests = [ testGroup "markdown" tests pandocPath =
[ testGroup "writer" [ testGroup "markdown"
$ writerTests "markdown" ++ lhsWriterTests "markdown" [ testGroup "writer"
, testGroup "reader" $ writerTests' "markdown" ++ lhsWriterTests' "markdown"
[ test "basic" ["-r", "markdown", "-w", "native", "-s"] , testGroup "reader"
"testsuite.txt" "testsuite.native" [ test' "basic" ["-r", "markdown", "-w", "native", "-s"]
, test "tables" ["-r", "markdown", "-w", "native", "--columns=80"] "testsuite.txt" "testsuite.native"
"tables.txt" "tables.native" , test' "tables" ["-r", "markdown", "-w", "native", "--columns=80"]
, test "pipe tables" ["-r", "markdown", "-w", "native", "--columns=80"] "tables.txt" "tables.native"
"pipe-tables.txt" "pipe-tables.native" , test' "pipe tables" ["-r", "markdown", "-w", "native", "--columns=80"]
, test "more" ["-r", "markdown", "-w", "native", "-s"] "pipe-tables.txt" "pipe-tables.native"
"markdown-reader-more.txt" "markdown-reader-more.native" , test' "more" ["-r", "markdown", "-w", "native", "-s"]
, lhsReaderTest "markdown+lhs" "markdown-reader-more.txt" "markdown-reader-more.native"
] , lhsReaderTest' "markdown+lhs"
, testGroup "citations" ]
[ test "citations" ["-r", "markdown", "-w", "native"] , testGroup "citations"
"markdown-citations.txt" "markdown-citations.native" [ test' "citations" ["-r", "markdown", "-w", "native"]
] "markdown-citations.txt" "markdown-citations.native"
] ]
, testGroup "rst" ]
[ testGroup "writer" (writerTests "rst" ++ lhsWriterTests "rst") , testGroup "rst"
, testGroup "reader" [ testGroup "writer" (writerTests' "rst" ++ lhsWriterTests' "rst")
[ test "basic" ["-r", "rst+smart", "-w", "native", , testGroup "reader"
"-s", "--columns=80"] "rst-reader.rst" "rst-reader.native" [ test' "basic" ["-r", "rst+smart", "-w", "native",
, test "tables" ["-r", "rst", "-w", "native", "--columns=80"] "-s", "--columns=80"] "rst-reader.rst" "rst-reader.native"
"tables.rst" "tables-rstsubset.native" , test' "tables" ["-r", "rst", "-w", "native", "--columns=80"]
, lhsReaderTest "rst+lhs" "tables.rst" "tables-rstsubset.native"
] , lhsReaderTest' "rst+lhs"
] ]
, testGroup "latex" ]
[ testGroup "writer" (writerTests "latex" ++ lhsWriterTests "latex") , testGroup "latex"
, testGroup "reader" [ testGroup "writer"
[ test "basic" ["-r", "latex+raw_tex", "-w", "native", "-s"] (writerTests' "latex" ++ lhsWriterTests' "latex")
"latex-reader.latex" "latex-reader.native" , testGroup "reader"
, lhsReaderTest "latex+lhs" [ test' "basic" ["-r", "latex+raw_tex", "-w", "native", "-s"]
] "latex-reader.latex" "latex-reader.native"
] , lhsReaderTest' "latex+lhs"
, testGroup "html" ]
[ testGroup "writer" (writerTests "html4" ++ writerTests "html5" ++ ]
lhsWriterTests "html") , testGroup "html"
, test "reader" ["-r", "html", "-w", "native", "-s"] [ testGroup "writer" (writerTests' "html4" ++ writerTests' "html5" ++
"html-reader.html" "html-reader.native" lhsWriterTests' "html")
] , test' "reader" ["-r", "html", "-w", "native", "-s"]
, testGroup "s5" "html-reader.html" "html-reader.native"
[ s5WriterTest "basic" ["-s"] "s5" ]
, s5WriterTest "fancy" ["-s","--mathjax","-i"] "s5" , testGroup "s5"
, s5WriterTest "fragment" [] "html4" [ s5WriterTest' "basic" ["-s"] "s5"
, s5WriterTest "inserts" ["-s", "-H", "insert", , s5WriterTest' "fancy" ["-s","--mathjax","-i"] "s5"
"-B", "insert", "-A", "insert", "-c", "main.css"] "html4" , s5WriterTest' "fragment" [] "html4"
] , s5WriterTest' "inserts" ["-s", "-H", "insert",
, testGroup "textile" "-B", "insert", "-A", "insert", "-c", "main.css"] "html4"
[ testGroup "writer" $ writerTests "textile" ]
, test "reader" ["-r", "textile", "-w", "native", "-s"] , testGroup "textile"
"textile-reader.textile" "textile-reader.native" [ testGroup "writer" $ writerTests' "textile"
] , test' "reader" ["-r", "textile", "-w", "native", "-s"]
, testGroup "docbook" "textile-reader.textile" "textile-reader.native"
[ testGroup "writer" $ writerTests "docbook4" ]
, test "reader" ["-r", "docbook", "-w", "native", "-s"] , testGroup "docbook"
"docbook-reader.docbook" "docbook-reader.native" [ testGroup "writer" $ writerTests' "docbook4"
, test "reader" ["-r", "docbook", "-w", "native", "-s"] , test' "reader" ["-r", "docbook", "-w", "native", "-s"]
"docbook-xref.docbook" "docbook-xref.native" "docbook-reader.docbook" "docbook-reader.native"
] , test' "reader" ["-r", "docbook", "-w", "native", "-s"]
, testGroup "docbook5" "docbook-xref.docbook" "docbook-xref.native"
[ testGroup "writer" $ writerTests "docbook5" ]
] , testGroup "docbook5"
, testGroup "jats" [ testGroup "writer" $ writerTests' "docbook5"
[ testGroup "writer" $ writerTests "jats" ]
, test "reader" ["-r", "jats", "-w", "native", "-s"] , testGroup "jats"
"jats-reader.xml" "jats-reader.native" [ testGroup "writer" $ writerTests' "jats"
] , test' "reader" ["-r", "jats", "-w", "native", "-s"]
, testGroup "native" "jats-reader.xml" "jats-reader.native"
[ testGroup "writer" $ writerTests "native" ]
, test "reader" ["-r", "native", "-w", "native", "-s"] , testGroup "native"
"testsuite.native" "testsuite.native" [ testGroup "writer" $ writerTests' "native"
] , test' "reader" ["-r", "native", "-w", "native", "-s"]
, testGroup "fb2" "testsuite.native" "testsuite.native"
[ fb2WriterTest "basic" [] "fb2/basic.markdown" "fb2/basic.fb2" ]
, fb2WriterTest "titles" [] "fb2/titles.markdown" "fb2/titles.fb2" , testGroup "fb2"
, fb2WriterTest "images" [] "fb2/images.markdown" "fb2/images.fb2" [ fb2WriterTest' "basic" [] "fb2/basic.markdown" "fb2/basic.fb2"
, fb2WriterTest "images-embedded" [] "fb2/images-embedded.html" "fb2/images-embedded.fb2" , fb2WriterTest' "titles" [] "fb2/titles.markdown" "fb2/titles.fb2"
, fb2WriterTest "math" [] "fb2/math.markdown" "fb2/math.fb2" , fb2WriterTest' "images" [] "fb2/images.markdown" "fb2/images.fb2"
, fb2WriterTest "meta" [] "fb2/meta.markdown" "fb2/meta.fb2" , fb2WriterTest' "images-embedded" [] "fb2/images-embedded.html" "fb2/images-embedded.fb2"
, fb2WriterTest "tables" [] "tables.native" "tables.fb2" , fb2WriterTest' "math" [] "fb2/math.markdown" "fb2/math.fb2"
, fb2WriterTest "testsuite" [] "testsuite.native" "writer.fb2" , fb2WriterTest' "meta" [] "fb2/meta.markdown" "fb2/meta.fb2"
] , fb2WriterTest' "tables" [] "tables.native" "tables.fb2"
, testGroup "mediawiki" , fb2WriterTest' "testsuite" [] "testsuite.native" "writer.fb2"
[ testGroup "writer" $ writerTests "mediawiki" ]
, test "reader" ["-r", "mediawiki", "-w", "native", "-s"] , testGroup "mediawiki"
"mediawiki-reader.wiki" "mediawiki-reader.native" [ testGroup "writer" $ writerTests' "mediawiki"
] , test' "reader" ["-r", "mediawiki", "-w", "native", "-s"]
, testGroup "vimwiki" "mediawiki-reader.wiki" "mediawiki-reader.native"
[ test "reader" ["-r", "vimwiki", "-w", "native", "-s"] ]
"vimwiki-reader.wiki" "vimwiki-reader.native" , testGroup "vimwiki"
] [ test' "reader" ["-r", "vimwiki", "-w", "native", "-s"]
, testGroup "dokuwiki" "vimwiki-reader.wiki" "vimwiki-reader.native"
[ testGroup "writer" $ writerTests "dokuwiki" ]
, test "inline_formatting" ["-r", "native", "-w", "dokuwiki", "-s"] , testGroup "dokuwiki"
"dokuwiki_inline_formatting.native" "dokuwiki_inline_formatting.dokuwiki" [ testGroup "writer" $ writerTests' "dokuwiki"
, test "multiblock table" ["-r", "native", "-w", "dokuwiki", "-s"] , test' "inline_formatting" ["-r", "native", "-w", "dokuwiki", "-s"]
"dokuwiki_multiblock_table.native" "dokuwiki_multiblock_table.dokuwiki" "dokuwiki_inline_formatting.native" "dokuwiki_inline_formatting.dokuwiki"
, test "external images" ["-r", "native", "-w", "dokuwiki", "-s"] , test' "multiblock table" ["-r", "native", "-w", "dokuwiki", "-s"]
"dokuwiki_external_images.native" "dokuwiki_external_images.dokuwiki" "dokuwiki_multiblock_table.native" "dokuwiki_multiblock_table.dokuwiki"
] , test' "external images" ["-r", "native", "-w", "dokuwiki", "-s"]
, testGroup "opml" "dokuwiki_external_images.native" "dokuwiki_external_images.dokuwiki"
[ test "basic" ["-r", "native", "-w", "opml", "--columns=78", "-s"] ]
"testsuite.native" "writer.opml" , testGroup "opml"
, test "reader" ["-r", "opml", "-w", "native", "-s"] [ test' "basic" ["-r", "native", "-w", "opml", "--columns=78", "-s"]
"opml-reader.opml" "opml-reader.native" "testsuite.native" "writer.opml"
] , test' "reader" ["-r", "opml", "-w", "native", "-s"]
, testGroup "haddock" "opml-reader.opml" "opml-reader.native"
[ testGroup "writer" $ writerTests "haddock" ]
, test "reader" ["-r", "haddock", "-w", "native", "-s"] , testGroup "haddock"
"haddock-reader.haddock" "haddock-reader.native" [ testGroup "writer" $ writerTests' "haddock"
] , test' "reader" ["-r", "haddock", "-w", "native", "-s"]
, testGroup "txt2tags" "haddock-reader.haddock" "haddock-reader.native"
[ test "reader" ["-r", "t2t", "-w", "native", "-s"] ]
"txt2tags.t2t" "txt2tags.native" ] , testGroup "txt2tags"
, testGroup "epub" [ [ test' "reader" ["-r", "t2t", "-w", "native", "-s"]
test "features" ["-r", "epub", "-w", "native"] "txt2tags.t2t" "txt2tags.native" ]
"epub/features.epub" "epub/features.native" , testGroup "epub" [
, test "wasteland" ["-r", "epub", "-w", "native"] test' "features" ["-r", "epub", "-w", "native"]
"epub/wasteland.epub" "epub/wasteland.native" "epub/features.epub" "epub/features.native"
, test "formatting" ["-r", "epub", "-w", "native"] , test' "wasteland" ["-r", "epub", "-w", "native"]
"epub/formatting.epub" "epub/formatting.native" "epub/wasteland.epub" "epub/wasteland.native"
] , test' "formatting" ["-r", "epub", "-w", "native"]
, testGroup "twiki" "epub/formatting.epub" "epub/formatting.native"
[ test "reader" ["-r", "twiki", "-w", "native", "-s"] ]
"twiki-reader.twiki" "twiki-reader.native" ] , testGroup "twiki"
, testGroup "tikiwiki" [ test' "reader" ["-r", "twiki", "-w", "native", "-s"]
[ test "reader" ["-r", "tikiwiki", "-w", "native", "-s"] "twiki-reader.twiki" "twiki-reader.native" ]
"tikiwiki-reader.tikiwiki" "tikiwiki-reader.native" ] , testGroup "tikiwiki"
, testGroup "other writers" $ map (\f -> testGroup f $ writerTests f) [ test' "reader" ["-r", "tikiwiki", "-w", "native", "-s"]
[ "opendocument" , "context" , "texinfo", "icml", "tei" "tikiwiki-reader.tikiwiki" "tikiwiki-reader.native" ]
, "man" , "plain" , "rtf", "org", "asciidoc", "zimwiki" , testGroup "other writers" $ map (\f -> testGroup f $ writerTests' f)
] [ "opendocument" , "context" , "texinfo", "icml", "tei"
, testGroup "writers-lang-and-dir" , "man" , "plain" , "rtf", "org", "asciidoc", "zimwiki"
[ test "latex" ["-f", "native", "-t", "latex", "-s"] ]
"writers-lang-and-dir.native" "writers-lang-and-dir.latex" , testGroup "writers-lang-and-dir"
, test "context" ["-f", "native", "-t", "context", "-s"] [ test' "latex" ["-f", "native", "-t", "latex", "-s"]
"writers-lang-and-dir.native" "writers-lang-and-dir.context" "writers-lang-and-dir.native" "writers-lang-and-dir.latex"
] , test' "context" ["-f", "native", "-t", "context", "-s"]
, testGroup "muse" "writers-lang-and-dir.native" "writers-lang-and-dir.context"
[ testGroup "writer" $ writerTests "muse" ]
] , testGroup "muse"
, testGroup "ms" [ testGroup "writer" $ writerTests' "muse"
[ testGroup "writer" $ writerTests "ms" ]
] , testGroup "ms"
, testGroup "creole" [ testGroup "writer" $ writerTests' "ms"
[ test "reader" ["-r", "creole", "-w", "native", "-s"] ]
"creole-reader.txt" "creole-reader.native" , testGroup "creole"
] [ test' "reader" ["-r", "creole", "-w", "native", "-s"]
, testGroup "custom writer" "creole-reader.txt" "creole-reader.native"
[ test "basic" ["-f", "native", "-t", "../data/sample.lua"] ]
"testsuite.native" "writer.custom" , testGroup "custom writer"
, test "tables" ["-f", "native", "-t", "../data/sample.lua"] [ test' "basic" ["-f", "native", "-t", "../data/sample.lua"]
"tables.native" "tables.custom" "testsuite.native" "writer.custom"
] , test' "tables" ["-f", "native", "-t", "../data/sample.lua"]
, testGroup "man" "tables.native" "tables.custom"
[ test "reader" ["-r", "man", "-w", "native", "-s"] ]
"man-reader.man" "man-reader.native" , testGroup "man"
] [ test' "reader" ["-r", "man", "-w", "native", "-s"]
, testGroup "org" "man-reader.man" "man-reader.native"
[ test "reader" ["-r", "org", "-w", "native", "-s"] ]
"org-select-tags.org" "org-select-tags.native" , testGroup "org"
] [ test' "reader" ["-r", "org", "-w", "native", "-s"]
] "org-select-tags.org" "org-select-tags.native"
]
]
where
test' = test pandocPath
writerTests' = writerTests pandocPath
s5WriterTest' = s5WriterTest pandocPath
fb2WriterTest' = fb2WriterTest pandocPath
lhsWriterTests' = lhsWriterTests pandocPath
lhsReaderTest' = lhsReaderTest pandocPath
-- makes sure file is fully closed after reading -- makes sure file is fully closed after reading
readFile' :: FilePath -> IO String readFile' :: FilePath -> IO String
readFile' f = do s <- UTF8.readFile f readFile' f = do s <- UTF8.readFile f
return $! (length s `seq` s) return $! (length s `seq` s)
lhsWriterTests :: String -> [TestTree] lhsWriterTests :: FilePath -> String -> [TestTree]
lhsWriterTests format lhsWriterTests pandocPath format
= [ t "lhs to normal" format = [ t "lhs to normal" format
, t "lhs to lhs" (format ++ "+lhs") , t "lhs to lhs" (format ++ "+lhs")
] ]
where where
t n f = test n ["--wrap=preserve", "-r", "native", "-s", "-w", f] t n f = test pandocPath
n ["--wrap=preserve", "-r", "native", "-s", "-w", f]
"lhs-test.native" ("lhs-test" <.> f) "lhs-test.native" ("lhs-test" <.> f)
lhsReaderTest :: String -> TestTree lhsReaderTest :: FilePath -> String -> TestTree
lhsReaderTest format = lhsReaderTest pandocPath format =
test "lhs" ["-r", format, "-w", "native"] test pandocPath "lhs" ["-r", format, "-w", "native"]
("lhs-test" <.> format) norm ("lhs-test" <.> format) norm
where norm = if format == "markdown+lhs" where norm = if format == "markdown+lhs"
then "lhs-test-markdown.native" then "lhs-test-markdown.native"
else "lhs-test.native" else "lhs-test.native"
writerTests :: String -> [TestTree] writerTests :: FilePath -> String -> [TestTree]
writerTests format writerTests pandocPath format
= [ test "basic" (opts ++ ["-s"]) "testsuite.native" ("writer" <.> format) = [ test pandocPath
, test "tables" opts "tables.native" ("tables" <.> format) "basic" (opts ++ ["-s"]) "testsuite.native" ("writer" <.> format)
, test pandocPath
"tables" opts "tables.native" ("tables" <.> format)
] ]
where where
opts = ["-r", "native", "-w", format, "--columns=78", opts = ["-r", "native", "-w", format, "--columns=78",
"--variable", "pandoc-version="] "--variable", "pandoc-version="]
s5WriterTest :: String -> [String] -> String -> TestTree s5WriterTest :: FilePath -> String -> [String] -> String -> TestTree
s5WriterTest modifier opts format s5WriterTest pandocPath modifier opts format
= test (format ++ " writer (" ++ modifier ++ ")") = test pandocPath (format ++ " writer (" ++ modifier ++ ")")
(["-r", "native", "-w", format] ++ opts) (["-r", "native", "-w", format] ++ opts)
"s5.native" ("s5-" ++ modifier <.> "html") "s5.native" ("s5-" ++ modifier <.> "html")
fb2WriterTest :: String -> [String] -> String -> String -> TestTree fb2WriterTest :: FilePath -> String -> [String] -> String -> String -> TestTree
fb2WriterTest title opts inputfile normfile = fb2WriterTest pandocPath title opts inputfile normfile =
testWithNormalize (ignoreBinary . formatXML) testWithNormalize (ignoreBinary . formatXML) pandocPath
title (["-t", "fb2"]++opts) inputfile normfile title (["-t", "fb2"]++opts) inputfile normfile
where where
formatXML xml = splitTags $ zip xml (drop 1 xml) formatXML xml = splitTags $ zip xml (drop 1 xml)
@ -231,7 +243,8 @@ fb2WriterTest title opts inputfile normfile =
startsWith tag str = all (uncurry (==)) $ zip tag str startsWith tag str = all (uncurry (==)) $ zip tag str
-- | Run a test without normalize function, return True if test passed. -- | Run a test without normalize function, return True if test passed.
test :: String -- ^ Title of test test :: FilePath -- ^ Path of pandoc executable
-> String -- ^ Title of test
-> [String] -- ^ Options to pass to pandoc -> [String] -- ^ Options to pass to pandoc
-> String -- ^ Input filepath -> String -- ^ Input filepath
-> FilePath -- ^ Norm (for test results) filepath -> FilePath -- ^ Norm (for test results) filepath
@ -240,17 +253,17 @@ test = testWithNormalize id
-- | Run a test with normalize function, return True if test passed. -- | Run a test with normalize function, return True if test passed.
testWithNormalize :: (String -> String) -- ^ Normalize function for output testWithNormalize :: (String -> String) -- ^ Normalize function for output
-> FilePath -- ^ Path to pandoc executable
-> String -- ^ Title of test -> String -- ^ Title of test
-> [String] -- ^ Options to pass to pandoc -> [String] -- ^ Options to pass to pandoc
-> String -- ^ Input filepath -> String -- ^ Input filepath
-> FilePath -- ^ Norm (for test results) filepath -> FilePath -- ^ Norm (for test results) filepath
-> TestTree -> TestTree
testWithNormalize normalizer testname opts inp norm = testWithNormalize normalizer pandocPath testname opts inp norm =
goldenTest testname getExpected getActual goldenTest testname getExpected getActual
(compareValues norm options) updateGolden (compareValues norm options) updateGolden
where getExpected = normalizer <$> readFile' norm where getExpected = normalizer <$> readFile' norm
getActual = do getActual = do
pandocPath <- findPandoc
let mbDynlibDir = findDynlibDir (reverse $ let mbDynlibDir = findDynlibDir (reverse $
splitDirectories pandocPath) splitDirectories pandocPath)
let dynlibEnv = case mbDynlibDir of let dynlibEnv = case mbDynlibDir of

View file

@ -44,9 +44,10 @@ import qualified Tests.Writers.TEI
import Tests.Helpers (findPandoc) import Tests.Helpers (findPandoc)
import Text.Pandoc.Shared (inDirectory) import Text.Pandoc.Shared (inDirectory)
tests :: TestTree tests :: FilePath -> TestTree
tests = testGroup "pandoc tests" [ Tests.Command.tests tests pandocPath = testGroup "pandoc tests"
, testGroup "Old" Tests.Old.tests [ Tests.Command.tests pandocPath
, testGroup "Old" (Tests.Old.tests pandocPath)
, testGroup "Shared" Tests.Shared.tests , testGroup "Shared" Tests.Shared.tests
, testGroup "Writers" , testGroup "Writers"
[ testGroup "Native" Tests.Writers.Native.tests [ testGroup "Native" Tests.Writers.Native.tests
@ -92,4 +93,4 @@ main = do
inDirectory "test" $ do inDirectory "test" $ do
fp <- findPandoc fp <- findPandoc
putStrLn $ "Using pandoc executable at " ++ fp putStrLn $ "Using pandoc executable at " ++ fp
defaultMain tests defaultMain $ tests fp