2ca1b20a85
Apparently Cabal sets a `pandoc_datadir` environment variable so that the data files will be sought in the source directory rather than in the final destination (where they aren't yet installed). So we no longer need to set `--data-dir` in the tests. We just need to make sure `pandoc_datadir` is set in the environment when we call the program in the test suite. This will fix the issue with loading of pandoc.lua when pandoc is built with `-embed_data_files`, reported in #7163. Closes #7163.
354 lines
14 KiB
Haskell
354 lines
14 KiB
Haskell
{-# LANGUAGE TupleSections #-}
|
|
{- |
|
|
Module : Tests.Old
|
|
Copyright : © 2006-2021 John MacFarlane
|
|
License : GNU GPL, version 2 or above
|
|
|
|
Maintainer : John MacFarlane <jgm@berkeley@edu>
|
|
Stability : alpha
|
|
Portability : portable
|
|
|
|
"Old" style tests (comparing output to golden files).
|
|
-}
|
|
module Tests.Old (tests) where
|
|
|
|
import Data.Algorithm.Diff
|
|
import System.Exit
|
|
import System.FilePath ((<.>), (</>))
|
|
import qualified System.Environment as Env
|
|
import System.Environment.Executable (getExecutablePath)
|
|
import Text.Pandoc.Process (pipeProcess)
|
|
import Test.Tasty (TestTree, testGroup)
|
|
import Test.Tasty.Golden.Advanced (goldenTest)
|
|
import Tests.Helpers hiding (test)
|
|
import qualified Text.Pandoc.UTF8 as UTF8
|
|
import qualified Data.Text as T
|
|
|
|
tests :: FilePath -> [TestTree]
|
|
tests pandocPath =
|
|
[ testGroup "markdown"
|
|
[ testGroup "writer"
|
|
$ writerTests' "markdown" ++ lhsWriterTests' "markdown"
|
|
, testGroup "reader"
|
|
[ test' "basic" ["-r", "markdown", "-w", "native", "-s"]
|
|
"testsuite.txt" "testsuite.native"
|
|
, test' "tables" ["-r", "markdown", "-w", "native", "--columns=80"]
|
|
"tables.txt" "tables.native"
|
|
, test' "pipe tables" ["-r", "markdown", "-w", "native", "--columns=80"]
|
|
"pipe-tables.txt" "pipe-tables.native"
|
|
, test' "more" ["-r", "markdown", "-w", "native", "-s"]
|
|
"markdown-reader-more.txt" "markdown-reader-more.native"
|
|
, lhsReaderTest' "markdown+lhs"
|
|
]
|
|
, testGroup "citations"
|
|
[ test' "citations" ["-r", "markdown", "-w", "native"]
|
|
"markdown-citations.txt" "markdown-citations.native"
|
|
]
|
|
]
|
|
, testGroup "rst"
|
|
[ testGroup "writer" (writerTests' "rst" ++ lhsWriterTests' "rst")
|
|
, testGroup "reader"
|
|
[ test' "basic" ["-r", "rst+smart", "-w", "native",
|
|
"-s", "--columns=80"] "rst-reader.rst" "rst-reader.native"
|
|
, test' "tables" ["-r", "rst", "-w", "native", "--columns=80"]
|
|
"tables.rst" "tables-rstsubset.native"
|
|
, lhsReaderTest' "rst+lhs"
|
|
]
|
|
]
|
|
, testGroup "latex"
|
|
[ testGroup "writer"
|
|
(extWriterTests' "latex" ++ lhsWriterTests' "latex")
|
|
, testGroup "reader"
|
|
[ test' "basic" ["-r", "latex+raw_tex", "-w", "native", "-s"]
|
|
"latex-reader.latex" "latex-reader.native"
|
|
, lhsReaderTest' "latex+lhs"
|
|
]
|
|
]
|
|
, testGroup "html"
|
|
[ testGroup "writer" $ mconcat
|
|
[ extWriterTests' "html4"
|
|
, extWriterTests' "html5"
|
|
, lhsWriterTests' "html"
|
|
]
|
|
, test' "reader" ["-r", "html", "-w", "native", "-s"]
|
|
"html-reader.html" "html-reader.native"
|
|
]
|
|
, testGroup "s5"
|
|
[ s5WriterTest' "basic" ["-s"] "s5"
|
|
, s5WriterTest' "fancy" ["-s","--mathjax","-i"] "s5"
|
|
, s5WriterTest' "fragment" [] "html4"
|
|
, s5WriterTest' "inserts" ["-s", "-H", "insert",
|
|
"-B", "insert", "-A", "insert", "-c", "main.css"] "html4"
|
|
]
|
|
, testGroup "textile"
|
|
[ testGroup "writer" $ writerTests' "textile"
|
|
, test' "reader" ["-r", "textile", "-w", "native", "-s"]
|
|
"textile-reader.textile" "textile-reader.native"
|
|
]
|
|
, testGroup "docbook"
|
|
[ testGroup "writer" $ writerTests' "docbook4"
|
|
, test' "reader" ["-r", "docbook", "-w", "native", "-s"]
|
|
"docbook-reader.docbook" "docbook-reader.native"
|
|
, test' "reader" ["-r", "docbook", "-w", "native", "-s"]
|
|
"docbook-chapter.docbook" "docbook-chapter.native"
|
|
, test' "reader" ["-r", "docbook", "-w", "native", "-s"]
|
|
"docbook-xref.docbook" "docbook-xref.native"
|
|
]
|
|
, testGroup "docbook5"
|
|
[ testGroup "writer" $ writerTests' "docbook5"
|
|
]
|
|
, testGroup "jats"
|
|
[ testGroup "writer"
|
|
[ testGroup "jats_archiving" $
|
|
extWriterTests' "jats_archiving"
|
|
, testGroup "jats_articleauthoring" $
|
|
writerTests' "jats_articleauthoring"
|
|
, testGroup "jats_publishing" $
|
|
writerTests' "jats_publishing"
|
|
]
|
|
, test' "reader" ["-r", "jats", "-w", "native", "-s"]
|
|
"jats-reader.xml" "jats-reader.native"
|
|
]
|
|
, testGroup "jira"
|
|
[ testGroup "writer" $ writerTests' "jira"
|
|
, test' "reader" ["-r", "jira", "-w", "native", "-s"]
|
|
"jira-reader.jira" "jira-reader.native"
|
|
]
|
|
, testGroup "native"
|
|
[ testGroup "writer" $ writerTests' "native"
|
|
, test' "reader" ["-r", "native", "-w", "native", "-s"]
|
|
"testsuite.native" "testsuite.native"
|
|
]
|
|
, testGroup "fb2"
|
|
[ fb2WriterTest' "basic" [] "fb2/basic.markdown" "fb2/basic.fb2"
|
|
, fb2WriterTest' "titles" [] "fb2/titles.markdown" "fb2/titles.fb2"
|
|
, fb2WriterTest' "images" [] "fb2/images.markdown" "fb2/images.fb2"
|
|
, fb2WriterTest' "images-embedded" [] "fb2/images-embedded.html" "fb2/images-embedded.fb2"
|
|
, fb2WriterTest' "math" [] "fb2/math.markdown" "fb2/math.fb2"
|
|
, fb2WriterTest' "meta" [] "fb2/meta.markdown" "fb2/meta.fb2"
|
|
, fb2WriterTest' "tables" [] "tables.native" "tables.fb2"
|
|
, fb2WriterTest' "testsuite" [] "testsuite.native" "writer.fb2"
|
|
]
|
|
, testGroup "mediawiki"
|
|
[ testGroup "writer" $ writerTests' "mediawiki"
|
|
, test' "reader" ["-r", "mediawiki", "-w", "native", "-s"]
|
|
"mediawiki-reader.wiki" "mediawiki-reader.native"
|
|
]
|
|
, testGroup "vimwiki"
|
|
[ test' "reader" ["-r", "vimwiki", "-w", "native", "-s"]
|
|
"vimwiki-reader.wiki" "vimwiki-reader.native"
|
|
]
|
|
, testGroup "dokuwiki"
|
|
[ testGroup "writer" $ writerTests' "dokuwiki"
|
|
, test' "inline_formatting" ["-r", "native", "-w", "dokuwiki", "-s"]
|
|
"dokuwiki_inline_formatting.native" "dokuwiki_inline_formatting.dokuwiki"
|
|
, test' "multiblock table" ["-r", "native", "-w", "dokuwiki", "-s"]
|
|
"dokuwiki_multiblock_table.native" "dokuwiki_multiblock_table.dokuwiki"
|
|
, test' "external images" ["-r", "native", "-w", "dokuwiki", "-s"]
|
|
"dokuwiki_external_images.native" "dokuwiki_external_images.dokuwiki"
|
|
]
|
|
, testGroup "opml"
|
|
[ test' "basic" ["-r", "native", "-w", "opml", "--columns=78", "-s"]
|
|
"testsuite.native" "writer.opml"
|
|
, test' "reader" ["-r", "opml", "-w", "native", "-s"]
|
|
"opml-reader.opml" "opml-reader.native"
|
|
]
|
|
, testGroup "haddock"
|
|
[ testGroup "writer" $ writerTests' "haddock"
|
|
, test' "reader" ["-r", "haddock", "-w", "native", "-s"]
|
|
"haddock-reader.haddock" "haddock-reader.native"
|
|
]
|
|
, testGroup "txt2tags"
|
|
[ test' "reader" ["-r", "t2t", "-w", "native", "-s"]
|
|
"txt2tags.t2t" "txt2tags.native" ]
|
|
, testGroup "epub" [
|
|
test' "features" ["-r", "epub", "-w", "native"]
|
|
"epub/features.epub" "epub/features.native"
|
|
, test' "wasteland" ["-r", "epub", "-w", "native"]
|
|
"epub/wasteland.epub" "epub/wasteland.native"
|
|
, test' "formatting" ["-r", "epub", "-w", "native"]
|
|
"epub/formatting.epub" "epub/formatting.native"
|
|
]
|
|
, testGroup "twiki"
|
|
[ test' "reader" ["-r", "twiki", "-w", "native", "-s"]
|
|
"twiki-reader.twiki" "twiki-reader.native" ]
|
|
, testGroup "tikiwiki"
|
|
[ test' "reader" ["-r", "tikiwiki", "-w", "native", "-s"]
|
|
"tikiwiki-reader.tikiwiki" "tikiwiki-reader.native" ]
|
|
, testGroup "other writers" $ map (\f -> testGroup f $ writerTests' f)
|
|
[ "opendocument" , "context" , "texinfo", "icml", "tei"
|
|
, "man" , "plain" , "rtf", "org", "asciidoc", "asciidoctor"
|
|
, "xwiki", "zimwiki"
|
|
]
|
|
, testGroup "writers-lang-and-dir"
|
|
[ test' "latex" ["-f", "native", "-t", "latex", "-s"]
|
|
"writers-lang-and-dir.native" "writers-lang-and-dir.latex"
|
|
, test' "context" ["-f", "native", "-t", "context", "-s"]
|
|
"writers-lang-and-dir.native" "writers-lang-and-dir.context"
|
|
]
|
|
, testGroup "muse"
|
|
[ testGroup "writer" $ writerTests' "muse"
|
|
]
|
|
, testGroup "ms"
|
|
[ testGroup "writer" $ writerTests' "ms"
|
|
]
|
|
, testGroup "creole"
|
|
[ test' "reader" ["-r", "creole", "-w", "native", "-s"]
|
|
"creole-reader.txt" "creole-reader.native"
|
|
]
|
|
, testGroup "custom writer"
|
|
[ test' "basic" ["-f", "native", "-t", "../data/sample.lua"]
|
|
"testsuite.native" "writer.custom"
|
|
, test' "tables" ["-f", "native", "-t", "../data/sample.lua"]
|
|
"tables.native" "tables.custom"
|
|
]
|
|
, testGroup "man"
|
|
[ test' "reader" ["-r", "man", "-w", "native", "-s"]
|
|
"man-reader.man" "man-reader.native"
|
|
]
|
|
, testGroup "org"
|
|
[ test' "reader" ["-r", "org", "-w", "native", "-s"]
|
|
"org-select-tags.org" "org-select-tags.native"
|
|
]
|
|
, testGroup "ipynb"
|
|
[ test' "reader" ["-f", "ipynb-raw_html-raw_tex+raw_attribute",
|
|
"-t", "native", "-s"]
|
|
"ipynb/simple.ipynb" "ipynb/simple.out.native"
|
|
, test' "writer" ["-f", "native",
|
|
"--markdown-headings=setext", "-t",
|
|
"ipynb-raw_html-raw_tex+raw_attribute", "-s"]
|
|
"ipynb/simple.in.native" "ipynb/simple.ipynb"
|
|
]
|
|
]
|
|
where
|
|
test' = test pandocPath
|
|
writerTests' = writerTests pandocPath
|
|
s5WriterTest' = s5WriterTest pandocPath
|
|
fb2WriterTest' = fb2WriterTest pandocPath
|
|
lhsWriterTests' = lhsWriterTests pandocPath
|
|
lhsReaderTest' = lhsReaderTest pandocPath
|
|
extWriterTests' = extendedWriterTests pandocPath
|
|
|
|
-- makes sure file is fully closed after reading
|
|
readFile' :: FilePath -> IO String
|
|
readFile' f = do s <- UTF8.readFile f
|
|
return $! (T.length s `seq` T.unpack s)
|
|
|
|
lhsWriterTests :: FilePath -> String -> [TestTree]
|
|
lhsWriterTests pandocPath format
|
|
= [ t "lhs to normal" format
|
|
, t "lhs to lhs" (format ++ "+lhs")
|
|
]
|
|
where
|
|
t n f = test pandocPath
|
|
n ["--wrap=preserve", "-r", "native", "-s",
|
|
"--markdown-headings=setext", "-w", f]
|
|
"lhs-test.native" ("lhs-test" <.> f)
|
|
|
|
lhsReaderTest :: FilePath -> String -> TestTree
|
|
lhsReaderTest pandocPath format =
|
|
test pandocPath "lhs" ["-r", format, "-w", "native"]
|
|
("lhs-test" <.> format) norm
|
|
where norm = if format == "markdown+lhs"
|
|
then "lhs-test-markdown.native"
|
|
else "lhs-test.native"
|
|
|
|
writerTests :: FilePath -> String -> [TestTree]
|
|
writerTests pandocPath format
|
|
= [ test pandocPath
|
|
"basic" (opts ++ ["-s"]) "testsuite.native" ("writer" <.> format)
|
|
, test pandocPath
|
|
"tables" opts "tables.native" ("tables" <.> format)
|
|
]
|
|
where
|
|
opts = ["-r", "native", "-w", format, "--columns=78",
|
|
"--variable", "pandoc-version="]
|
|
|
|
extendedWriterTests :: FilePath -> String -> [TestTree]
|
|
extendedWriterTests pandocPath format
|
|
= writerTests pandocPath format ++
|
|
let testForTable name =
|
|
test pandocPath
|
|
(name ++ " table")
|
|
opts
|
|
("tables" </> name <.> "native")
|
|
("tables" </> name <.> format)
|
|
in map testForTable ["planets", "nordics", "students"]
|
|
where
|
|
opts = ["-r", "native", "-w", format, "--columns=78",
|
|
"--variable", "pandoc-version="]
|
|
|
|
s5WriterTest :: FilePath -> String -> [String] -> String -> TestTree
|
|
s5WriterTest pandocPath modifier opts format
|
|
= test pandocPath (format ++ " writer (" ++ modifier ++ ")")
|
|
(["-r", "native", "-w", format] ++ opts)
|
|
"s5.native" ("s5-" ++ modifier <.> "html")
|
|
|
|
fb2WriterTest :: FilePath -> String -> [String] -> String -> String -> TestTree
|
|
fb2WriterTest pandocPath title opts inputfile normfile =
|
|
testWithNormalize (ignoreBinary . formatXML) pandocPath
|
|
title (["-t", "fb2"]++opts) inputfile normfile
|
|
where
|
|
formatXML xml = splitTags $ zip xml (drop 1 xml)
|
|
splitTags [] = []
|
|
splitTags [end] = [fst end, snd end]
|
|
splitTags (('>','<'):rest) = ">\n" ++ splitTags rest
|
|
splitTags ((c,_):rest) = c : splitTags rest
|
|
ignoreBinary = unlines . filter (not . startsWith "<binary ") . lines
|
|
startsWith tag str = all (uncurry (==)) $ zip tag str
|
|
|
|
-- | Run a test without normalize function, return True if test passed.
|
|
test :: FilePath -- ^ Path of pandoc executable
|
|
-> String -- ^ Title of test
|
|
-> [String] -- ^ Options to pass to pandoc
|
|
-> String -- ^ Input filepath
|
|
-> FilePath -- ^ Norm (for test results) filepath
|
|
-> TestTree
|
|
test = testWithNormalize id
|
|
|
|
-- | Run a test with normalize function, return True if test passed.
|
|
testWithNormalize :: (String -> String) -- ^ Normalize function for output
|
|
-> FilePath -- ^ Path to pandoc executable
|
|
-> String -- ^ Title of test
|
|
-> [String] -- ^ Options to pass to pandoc
|
|
-> String -- ^ Input filepath
|
|
-> FilePath -- ^ Norm (for test results) filepath
|
|
-> TestTree
|
|
testWithNormalize normalizer pandocPath testname opts inp norm =
|
|
goldenTest testname getExpected getActual
|
|
(compareValues norm options) updateGolden
|
|
where getExpected = normalizer <$> readFile' norm
|
|
getActual = do
|
|
mldpath <- Env.lookupEnv "LD_LIBRARY_PATH"
|
|
mdyldpath <- Env.lookupEnv "DYLD_LIBRARY_PATH"
|
|
mpdd <- Env.lookupEnv "pandoc_datadir"
|
|
let env = ("TMP",".") :
|
|
("LANG","en_US.UTF-8") :
|
|
("HOME", "./") :
|
|
maybe [] ((:[]) . ("pandoc_datadir",)) mpdd ++
|
|
maybe [] ((:[]) . ("LD_LIBRARY_PATH",)) mldpath ++
|
|
maybe [] ((:[]) . ("DYLD_LIBRARY_PATH",)) mdyldpath
|
|
|
|
(ec, out) <- pipeProcess (Just env) pandocPath
|
|
("--emulate":options) mempty
|
|
if ec == ExitSuccess
|
|
then return $ filter (/='\r') . normalizer
|
|
$ UTF8.toStringLazy out
|
|
-- filter \r so the tests will work on Windows machines
|
|
else fail $ "Pandoc failed with error code " ++ show ec
|
|
updateGolden = UTF8.writeFile norm . T.pack
|
|
options = ["--quiet"] ++ [inp] ++ opts
|
|
|
|
compareValues :: FilePath -> [String] -> String -> String -> IO (Maybe String)
|
|
compareValues norm options expected actual = do
|
|
testExePath <- getExecutablePath
|
|
let cmd = testExePath ++ " --emulate " ++ unwords options
|
|
let dash = replicate 72 '-'
|
|
let diff = getDiff (lines actual) (lines expected)
|
|
if expected == actual
|
|
then return Nothing
|
|
else return $ Just $
|
|
'\n' : dash ++
|
|
"\n--- " ++ norm ++
|
|
"\n+++ " ++ cmd ++ "\n" ++
|
|
showDiff (1,1) diff ++ dash
|