80fde18fb1
[API change] This affects `readFile`, `getContents`, `writeFileWith`, `writeFile`, `putStrWith`, `putStr`, `putStrLnWith`, `putStrLn`. `hPutStrWith`, `hPutStr`, `hPutStrLnWith`, `hPutStrLn`, `hGetContents`. This avoids the need to uselessly create a linked list of characters when emiting output.
352 lines
14 KiB
Haskell
352 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"
|
|
let env = ("TMP",".") :
|
|
("LANG","en_US.UTF-8") :
|
|
("HOME", "./") :
|
|
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 = ["--data-dir=../data","--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
|