mirror of
https://github.com/jgm/pandoc.git
synced 2026-09-26 01:15:53 +00:00
Evan Silberman
c4716d41c5
Pod ("Plain old documentation") is a markup languaged used principally
to document Perl modules and programs. Since it was originally meant to
be translated pretty directly to man, the semantics are fairly simple.
This Pod reader was developed with reference to the canonical user and
implementer documentation of Pod: https://perldoc.perl.org/perlpod and
https://perldoc.perl.org/perlpodspec.
There are 1490 .pod, .pl, and .pm in the Perl 5.34 distribution found in
/System/Library/Perl on my mac. Of those, this reader dies with a parse
error on 7 of them. All of them seem to be cases where pod commands are
found within a non-colon-prefixed =begin/=end. perlpodspec says I may
treat this as an error.
[API change] adds readPod
377 lines
15 KiB
Haskell
377 lines
15 KiB
Haskell
{- |
|
|
Module : Tests.Old
|
|
Copyright : © 2006-2024 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 System.Environment (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 "djot"
|
|
[ testGroup "writer" $ writerTests' "djot"
|
|
, test' "reader" ["-f", "djot", "-t" ,"native", "-s"]
|
|
"djot-reader.djot" "djot-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" $ mconcat [
|
|
writerTests' "mediawiki"
|
|
, extWriterTests' "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=80", "-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", "-s"]
|
|
"epub/features.epub" "epub/features.native"
|
|
, test' "wasteland" ["-r", "epub", "-w", "native", "-s"]
|
|
"epub/wasteland.epub" "epub/wasteland.native"
|
|
, test' "formatting" ["-r", "epub", "-w", "native", "-s"]
|
|
"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" , "asciidoc", "asciidoc_legacy"
|
|
, "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 "typst"
|
|
[ testGroup "writer" $ writerTests' "typst" ++ extWriterTests' "typst"
|
|
, testGroup "reader"
|
|
[ test' "typst-reader" ["-r", "typst", "-w", "native", "-s"]
|
|
"typst-reader.typ" "typst-reader.native"
|
|
]
|
|
]
|
|
|
|
, testGroup "creole"
|
|
[ test' "reader" ["-r", "creole", "-w", "native", "-s"]
|
|
"creole-reader.txt" "creole-reader.native"
|
|
]
|
|
, 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 "writer" $ writerTests' "org"
|
|
]
|
|
, testGroup "rtf"
|
|
[ testGroup "writer" $ writerTests' "rtf" ]
|
|
, testGroup "endnotexml"
|
|
[ test' "reader" ["-r", "endnotexml", "-w", "native", "-s"]
|
|
"endnotexml-reader.xml" "endnotexml-reader.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"
|
|
, test' "reader" ["-t", "native", "-f", "ipynb",
|
|
"--ipynb-output=all"]
|
|
"ipynb/mime.ipynb" "ipynb/mime.native"
|
|
, test' "writer" ["-f", "native", "-t", "ipynb",
|
|
"--wrap=preserve"]
|
|
"ipynb/mime.native" "ipynb/mime.out.ipynb"
|
|
, test' "reader" ["-f", "ipynb", "-t", "html"]
|
|
"ipynb/rank.ipynb" "ipynb/rank.out.html"
|
|
]
|
|
, testGroup "markua" [ testGroup "writer" $ writerTests' "markua"]
|
|
, testGroup "ansi"
|
|
[ test' "ansi" ["-f", "markdown", "-t", "ansi"]
|
|
"ansi-test.txt" "ansi-test.ansi"
|
|
]
|
|
, testGroup "pod"
|
|
[ test' "pod" ["-f", "pod", "-t", "native"]
|
|
"pod-reader.pod" "pod-reader.native"
|
|
]
|
|
]
|
|
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",
|
|
"--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=80",
|
|
"--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=80",
|
|
"--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
|
|
env <- setupEnvironment pandocPath
|
|
(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
|