aboutsummaryrefslogtreecommitdiff
path: root/test/Tests
diff options
context:
space:
mode:
Diffstat (limited to 'test/Tests')
-rw-r--r--test/Tests/Command.hs16
-rw-r--r--test/Tests/Helpers.hs23
-rw-r--r--test/Tests/Lua.hs101
-rw-r--r--test/Tests/Lua/Module.hs2
-rw-r--r--test/Tests/Old.hs20
-rw-r--r--test/Tests/Readers/Docx.hs16
-rw-r--r--test/Tests/Readers/FB2.hs2
-rw-r--r--test/Tests/Readers/Markdown.hs48
-rw-r--r--test/Tests/Readers/Org/Inline/Citation.hs87
-rw-r--r--test/Tests/Readers/Org/Meta.hs2
-rw-r--r--test/Tests/Readers/RST.hs9
-rw-r--r--test/Tests/Readers/RTF.hs42
-rw-r--r--test/Tests/Shared.hs16
-rw-r--r--test/Tests/Writers/AsciiDoc.hs16
-rw-r--r--test/Tests/Writers/Docx.hs3
-rw-r--r--test/Tests/Writers/HTML.hs120
-rw-r--r--test/Tests/Writers/JATS.hs48
-rw-r--r--test/Tests/Writers/Markua.hs40
-rw-r--r--test/Tests/Writers/OOXML.hs78
-rw-r--r--test/Tests/Writers/Powerpoint.hs322
20 files changed, 762 insertions, 249 deletions
diff --git a/test/Tests/Command.hs b/test/Tests/Command.hs
index 539be1a1a..f437e026b 100644
--- a/test/Tests/Command.hs
+++ b/test/Tests/Command.hs
@@ -12,6 +12,7 @@ Run commands, and test results, defined in markdown files.
module Tests.Command (runTest, tests)
where
+import Data.Maybe (fromMaybe)
import Data.Algorithm.Diff
import System.Environment (getExecutablePath)
import qualified Data.ByteString as BS
@@ -90,18 +91,19 @@ extractCode :: Block -> String
extractCode (CodeBlock _ code) = T.unpack code
extractCode _ = ""
-dropPercent :: String -> String
-dropPercent ('%':xs) = dropWhile (== ' ') xs
-dropPercent xs = xs
+dropPercent :: String -> Maybe String
+dropPercent ('%':xs) = Just $ dropWhile (== ' ') xs
+dropPercent _ = Nothing
runCommandTest :: FilePath -> FilePath -> Int -> String -> TestTree
-runCommandTest testExePath fp num code =
- goldenTest testname getExpected getActual compareValues updateGolden
+runCommandTest testExePath fp num code = do
+ goldenTest testname getExpected getActual compareValues' updateGolden
where
testname = "#" <> show num
codelines = lines code
(continuations, r1) = span ("\\" `isSuffixOf`) codelines
- cmd = dropPercent (unwords (map init continuations ++ take 1 r1))
+ cmd = fromMaybe (error "Command test line does not begin with %")
+ (dropPercent (unwords (map init continuations ++ take 1 r1)))
r2 = drop 1 r1
(inplines, r3) = break (=="^D") r2
normlines = takeWhile (/=".") (drop 1 r3)
@@ -109,7 +111,7 @@ runCommandTest testExePath fp num code =
norm = unlines normlines
getExpected = return norm
getActual = snd <$> execTest testExePath cmd input
- compareValues expected actual
+ compareValues' expected actual
| actual == expected = return Nothing
| otherwise = return $ Just $ "--- test/command/" ++ fp ++ "\n+++ " ++
cmd ++ "\n" ++ showDiff (1,1)
diff --git a/test/Tests/Helpers.hs b/test/Tests/Helpers.hs
index a48a5894e..6c06e3f71 100644
--- a/test/Tests/Helpers.hs
+++ b/test/Tests/Helpers.hs
@@ -16,6 +16,7 @@ module Tests.Helpers ( test
, TestResult(..)
, setupEnvironment
, showDiff
+ , testGolden
, (=?>)
, purely
, ToString(..)
@@ -23,13 +24,16 @@ module Tests.Helpers ( test
)
where
+import System.FilePath
import Data.Algorithm.Diff
import qualified Data.Map as M
+import qualified Text.Pandoc.UTF8 as UTF8
import Data.Text (Text, unpack)
+import qualified Data.Text as T
import System.Exit
-import System.FilePath (takeDirectory)
import qualified System.Environment as Env
import Test.Tasty
+import Test.Tasty.Golden.Advanced (goldenTest)
import Test.Tasty.HUnit
import Text.Pandoc.Builder (Blocks, Inlines, doc, plain)
import Text.Pandoc.Class
@@ -61,6 +65,23 @@ test fn name (input, expected) =
dashes "" = replicate 72 '-'
dashes x = replicate (72 - length x - 5) '-' ++ " " ++ x ++ " ---"
+testGolden :: TestName -> FilePath -> FilePath -> (Text -> IO Text) -> TestTree
+testGolden name expectedPath inputPath fn =
+ goldenTest
+ name
+ (UTF8.readFile expectedPath)
+ (UTF8.readFile inputPath >>= fn)
+ compareVals
+ (UTF8.writeFile expectedPath)
+ where
+ compareVals expected actual
+ | expected == actual = return Nothing
+ | otherwise = return $ Just $
+ "\n--- " ++ expectedPath ++ "\n+++\n" ++
+ showDiff (1,1)
+ (getDiff (lines . filter (/='\r') $ T.unpack actual)
+ (lines . filter (/='\r') $ T.unpack expected))
+
-- | Set up environment for pandoc command tests.
setupEnvironment :: FilePath -> IO [(String, String)]
setupEnvironment testExePath = do
diff --git a/test/Tests/Lua.hs b/test/Tests/Lua.hs
index 31c011900..00193614d 100644
--- a/test/Tests/Lua.hs
+++ b/test/Tests/Lua.hs
@@ -1,5 +1,6 @@
-{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
{- |
Module : Tests.Lua
Copyright : © 2017-2021 Albert Krewinkel
@@ -13,11 +14,10 @@ Unit and integration tests for pandoc's Lua subsystem.
-}
module Tests.Lua ( runLuaTest, tests ) where
-import Control.Monad (when)
+import HsLua as Lua hiding (Operation (Div), error)
import System.FilePath ((</>))
-import Test.Tasty (TestTree, localOption)
-import Test.Tasty.HUnit (Assertion, assertEqual, testCase)
-import Test.Tasty.QuickCheck (QuickCheckTests (..), ioProperty, testProperty)
+import Test.Tasty (TestTree, testGroup)
+import Test.Tasty.HUnit ((@=?), Assertion, HasCallStack, assertEqual, testCase)
import Text.Pandoc.Arbitrary ()
import Text.Pandoc.Builder (bulletList, definitionList, displayMath, divWith,
doc, doubleQuoted, emph, header, lineBlock,
@@ -25,8 +25,8 @@ import Text.Pandoc.Builder (bulletList, definitionList, displayMath, divWith,
singleQuoted, space, str, strong,
HasMeta (setMeta))
import Text.Pandoc.Class (runIOorExplode, setUserDataDir)
-import Text.Pandoc.Definition (Block (BlockQuote, Div, Para), Inline (Emph, Str),
- Attr, Meta, Pandoc, pandocTypesVersion)
+import Text.Pandoc.Definition (Attr, Block (BlockQuote, Div, Para), Pandoc,
+ Inline (Emph, Str), pandocTypesVersion)
import Text.Pandoc.Error (PandocError (PandocLuaError))
import Text.Pandoc.Filter (Filter (LuaFilter), applyFilters)
import Text.Pandoc.Lua (runLua)
@@ -34,25 +34,12 @@ import Text.Pandoc.Options (def)
import Text.Pandoc.Shared (pandocVersion)
import qualified Control.Monad.Catch as Catch
-import qualified Foreign.Lua as Lua
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
tests :: [TestTree]
-tests = map (localOption (QuickCheckTests 20))
- [ testProperty "inline elements can be round-tripped through the lua stack" $
- \x -> ioProperty (roundtripEqual (x::Inline))
-
- , testProperty "block elements can be round-tripped through the lua stack" $
- \x -> ioProperty (roundtripEqual (x::Block))
-
- , testProperty "meta blocks can be round-tripped through the lua stack" $
- \x -> ioProperty (roundtripEqual (x::Meta))
-
- , testProperty "documents can be round-tripped through the lua stack" $
- \x -> ioProperty (roundtripEqual (x::Pandoc))
-
- , testCase "macro expansion via filter" $
+tests =
+ [ testCase "macro expansion via filter" $
assertFilterConversion "a '{{helloworld}}' string is expanded"
"strmacro.lua"
(doc . para $ str "{{helloworld}}")
@@ -163,12 +150,12 @@ tests = map (localOption (QuickCheckTests 20))
Lua.getglobal "PANDOC_VERSION"
Lua.liftIO .
assertEqual "pandoc version is wrong" (TE.encodeUtf8 pandocVersion)
- =<< Lua.tostring' Lua.stackTop
+ =<< Lua.tostring' Lua.top
, testCase "Pandoc types version is set" . runLuaTest $ do
Lua.getglobal "PANDOC_API_VERSION"
Lua.liftIO . assertEqual "pandoc-types version is wrong" pandocTypesVersion
- =<< Lua.peek Lua.stackTop
+ =<< Lua.peek Lua.top
, testCase "require file" $
assertFilterConversion "requiring file failed"
@@ -177,38 +164,67 @@ tests = map (localOption (QuickCheckTests 20))
(doc $ para (str . T.pack $ "lua" </> "require-file.lua"))
, testCase "Allow singleton inline in constructors" . runLuaTest $ do
- Lua.liftIO . assertEqual "Not the expected Emph" (Emph [Str "test"])
- =<< Lua.callFunc "pandoc.Emph" (Str "test")
- Lua.liftIO . assertEqual "Unexpected element" (Para [Str "test"])
- =<< Lua.callFunc "pandoc.Para" ("test" :: String)
+ Lua.liftIO . assertEqual "Not the expected Emph"
+ (Emph [Str "test"]) =<< do
+ Lua.OK <- Lua.dostring "return pandoc.Emph"
+ Lua.push @Inline (Str "test")
+ Lua.call 1 1
+ Lua.peek @Inline top
+ Lua.liftIO . assertEqual "Unexpected element"
+ (Para [Str "test"]) =<< do
+ Lua.getglobal' "pandoc.Para"
+ Lua.pushString "test"
+ Lua.call 1 1
+ Lua.peek @Block top
Lua.liftIO . assertEqual "Unexptected element"
(BlockQuote [Para [Str "foo"]]) =<< (
do
Lua.getglobal' "pandoc.BlockQuote"
Lua.push (Para [Str "foo"])
_ <- Lua.call 1 1
- Lua.peek Lua.stackTop
+ Lua.peek @Block Lua.top
)
, testCase "Elements with Attr have `attr` accessor" . runLuaTest $ do
Lua.push (Div ("hi", ["moin"], [])
[Para [Str "ignored"]])
- Lua.getfield Lua.stackTop "attr"
+ Lua.getfield Lua.top "attr"
Lua.liftIO . assertEqual "no accessor" (("hi", ["moin"], []) :: Attr)
- =<< Lua.peek Lua.stackTop
+ =<< Lua.peek @Attr Lua.top
, testCase "module `pandoc.system` is present" . runLuaTest $ do
Lua.getglobal' "pandoc.system"
- ty <- Lua.ltype Lua.stackTop
+ ty <- Lua.ltype Lua.top
Lua.liftIO $ assertEqual "module should be a table" Lua.TypeTable ty
+ , testGroup "global modules"
+ [ testCase "module 'lpeg' is loaded into a global" . runLuaTest $ do
+ s <- Lua.dostring "assert(type(lpeg)=='table')"
+ Lua.liftIO $ Lua.OK @=? s
+
+ , testCase "module 're' is loaded into a global" . runLuaTest $ do
+ s <- Lua.dostring "assert(type(re)=='table')"
+ Lua.liftIO $ Lua.OK @=? s
+
+ , testCase "module 'lpeg' is available via `require`" . runLuaTest $ do
+ s <- Lua.dostring
+ "package.path = ''; package.cpath = ''; require 'lpeg'"
+ Lua.liftIO $ Lua.OK @=? s
+
+ , testCase "module 're' is available via `require`" . runLuaTest $ do
+ s <- Lua.dostring
+ "package.path = ''; package.cpath = ''; require 're'"
+ Lua.liftIO $ Lua.OK @=? s
+ ]
+
, testCase "informative error messages" . runLuaTest $ do
Lua.pushboolean True
- eitherPandoc <- Catch.try (Lua.peek Lua.stackTop :: Lua.Lua Pandoc)
+ -- Lua.newtable
+ eitherPandoc <- Catch.try (peek @Pandoc Lua.top)
case eitherPandoc of
Left (PandocLuaError msg) -> do
- let expectedMsg = "Could not get Pandoc value: "
- <> "table expected, got boolean"
+ let expectedMsg = "Pandoc expected, got boolean\n"
+ <> "\twhile retrieving Pandoc"
Lua.liftIO $ assertEqual "unexpected error message" expectedMsg msg
Left e -> error ("Expected a Lua error, but got " <> show e)
Right _ -> error "Getting a Pandoc element from a bool should fail."
@@ -221,21 +237,8 @@ assertFilterConversion msg filterPath docIn expectedDoc = do
applyFilters def [LuaFilter ("lua" </> filterPath)] ["HTML"] docIn
assertEqual msg expectedDoc actualDoc
-roundtripEqual :: (Eq a, Lua.Peekable a, Lua.Pushable a) => a -> IO Bool
-roundtripEqual x = (x ==) <$> roundtripped
- where
- roundtripped :: Lua.Peekable a => IO a
- roundtripped = runLuaTest $ do
- oldSize <- Lua.gettop
- Lua.push x
- size <- Lua.gettop
- when (size - oldSize /= 1) $
- error ("not exactly one additional element on the stack: " ++ show size)
- Lua.peek (-1)
-
-runLuaTest :: Lua.Lua a -> IO a
+runLuaTest :: HasCallStack => Lua.LuaE PandocError a -> IO a
runLuaTest op = runIOorExplode $ do
- setUserDataDir (Just "../data")
res <- runLua op
case res of
Left e -> error (show e)
diff --git a/test/Tests/Lua/Module.hs b/test/Tests/Lua/Module.hs
index 8be445f65..e4d1e8bd9 100644
--- a/test/Tests/Lua/Module.hs
+++ b/test/Tests/Lua/Module.hs
@@ -29,7 +29,7 @@ tests =
("lua" </> "module" </> "pandoc-path.lua")
, testPandocLua "pandoc.types"
("lua" </> "module" </> "pandoc-types.lua")
- , testPandocLua "pandoc.util"
+ , testPandocLua "pandoc.utils"
("lua" </> "module" </> "pandoc-utils.lua")
]
diff --git a/test/Tests/Old.hs b/test/Tests/Old.hs
index ad9f249c4..450449946 100644
--- a/test/Tests/Old.hs
+++ b/test/Tests/Old.hs
@@ -146,7 +146,7 @@ tests pandocPath =
"dokuwiki_external_images.native" "dokuwiki_external_images.dokuwiki"
]
, testGroup "opml"
- [ test' "basic" ["-r", "native", "-w", "opml", "--columns=78", "-s"]
+ [ 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"
@@ -175,7 +175,7 @@ tests pandocPath =
"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"
+ , "man" , "plain" , "asciidoc", "asciidoctor"
, "xwiki", "zimwiki"
]
, testGroup "writers-lang-and-dir"
@@ -207,7 +207,10 @@ tests pandocPath =
, 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 "ipynb"
[ test' "reader" ["-f", "ipynb-raw_html-raw_tex+raw_attribute",
"-t", "native", "-s"]
@@ -216,7 +219,16 @@ tests pandocPath =
"--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"]
]
where
test' = test pandocPath
@@ -259,7 +271,7 @@ writerTests pandocPath format
"tables" opts "tables.native" ("tables" <.> format)
]
where
- opts = ["-r", "native", "-w", format, "--columns=78",
+ opts = ["-r", "native", "-w", format, "--columns=80",
"--variable", "pandoc-version="]
extendedWriterTests :: FilePath -> String -> [TestTree]
@@ -273,7 +285,7 @@ extendedWriterTests pandocPath format
("tables" </> name <.> format)
in map testForTable ["planets", "nordics", "students"]
where
- opts = ["-r", "native", "-w", format, "--columns=78",
+ opts = ["-r", "native", "-w", format, "--columns=80",
"--variable", "pandoc-version="]
s5WriterTest :: FilePath -> String -> [String] -> String -> TestTree
diff --git a/test/Tests/Readers/Docx.hs b/test/Tests/Readers/Docx.hs
index 220c7d9c5..be5b89b88 100644
--- a/test/Tests/Readers/Docx.hs
+++ b/test/Tests/Readers/Docx.hs
@@ -148,6 +148,18 @@ tests = [ testGroup "document"
"docx/instrText_hyperlink.docx"
"docx/instrText_hyperlink.native"
, testCompare
+ "nested fields with <w:instrText> tag"
+ "docx/nested_instrText.docx"
+ "docx/nested_instrText.native"
+ , testCompare
+ "empty fields with <w:instrText> tag"
+ "docx/empty_field.docx"
+ "docx/empty_field.native"
+ , testCompare
+ "pageref hyperlinks in <w:instrText> tag"
+ "docx/pageref.docx"
+ "docx/pageref.native"
+ , testCompare
"inline image"
"docx/image.docx"
"docx/image_no_embed.native"
@@ -306,6 +318,10 @@ tests = [ testGroup "document"
"docx/block_quotes.docx"
"docx/block_quotes_parse_indent.native"
, testCompare
+ "blockquotes (parsing indent relative to the indent of the parent style as blockquote)"
+ "docx/relative_indentation_blockquotes.docx"
+ "docx/relative_indentation_blockquotes.native"
+ , testCompare
"hanging indents"
"docx/hanging_indent.docx"
"docx/hanging_indent.native"
diff --git a/test/Tests/Readers/FB2.hs b/test/Tests/Readers/FB2.hs
index 42054a235..d540f8b6a 100644
--- a/test/Tests/Readers/FB2.hs
+++ b/test/Tests/Readers/FB2.hs
@@ -7,7 +7,7 @@
Stability : alpha
Portability : portable
-Tests for the EPUB mediabag.
+Tests for the FB2 reader.
-}
module Tests.Readers.FB2 (tests) where
diff --git a/test/Tests/Readers/Markdown.hs b/test/Tests/Readers/Markdown.hs
index f055ab197..02fc0d8ce 100644
--- a/test/Tests/Readers/Markdown.hs
+++ b/test/Tests/Readers/Markdown.hs
@@ -36,6 +36,9 @@ markdownGH :: Text -> Pandoc
markdownGH = purely $ readMarkdown def {
readerExtensions = githubMarkdownExtensions }
+markdownMMD :: Text -> Pandoc
+markdownMMD = purely $ readMarkdown def {
+ readerExtensions = multimarkdownExtensions }
infix 4 =:
(=:) :: ToString c
=> String -> (Text, c) -> TestTree
@@ -360,6 +363,51 @@ tests = [ testGroup "inline code"
("**this should \"be bold**"
=?> para (strong "this should \8220be bold"))
]
+ , testGroup "sub- and superscripts"
+ [
+ test markdownMMD "normal subscript"
+ ("H~2~"
+ =?> para ("H" <> subscript "2"))
+ , test markdownMMD "normal superscript"
+ ("x^3^"
+ =?> para ("x" <> superscript "3"))
+ , test markdownMMD "short subscript delimeted by space"
+ ("O~2 is dangerous"
+ =?> para ("O" <> subscript "2" <> space <> "is dangerous"))
+ , test markdownMMD "short subscript delimeted by newline"
+ ("O~2\n"
+ =?> para ("O" <> subscript "2"))
+ , test markdownMMD "short subscript delimeted by EOF"
+ ("O~2"
+ =?> para ("O" <> subscript "2"))
+ , test markdownMMD "short subscript delimited by punctuation"
+ ("O~2."
+ =?> para ("O" <> subscript "2" <> "."))
+ , test markdownMMD "short subscript delimited by emph"
+ ("O~2*combustible!*"
+ =?> para ("O" <> subscript "2" <> emph "combustible!"))
+ , test markdownMMD "no nesting in short subscripts"
+ ("y~*2*"
+ =?> para ("y~" <> emph "2"))
+ , test markdownMMD "short superscript delimeted by space"
+ ("x^2 = y"
+ =?> para ("x" <> superscript "2" <> space <> "= y"))
+ , test markdownMMD "short superscript delimeted by newline"
+ ("x^2\n"
+ =?> para ("x" <> superscript "2"))
+ , test markdownMMD "short superscript delimeted by ExF"
+ ("x^2"
+ =?> para ("x" <> superscript "2"))
+ , test markdownMMD "short superscript delimited by punctuation"
+ ("x^2."
+ =?> para ("x" <> superscript "2" <> "."))
+ , test markdownMMD "short superscript delimited by emph"
+ ("x^2*combustible!*"
+ =?> para ("x" <> superscript "2" <> emph "combustible!"))
+ , test markdownMMD "no nesting in short superscripts"
+ ("y^*2*"
+ =?> para ("y^" <> emph "2"))
+ ]
, testGroup "footnotes"
[ "indent followed by newline and flush-left text" =:
"[^1]\n\n[^1]: my note\n\n \nnot in note\n"
diff --git a/test/Tests/Readers/Org/Inline/Citation.hs b/test/Tests/Readers/Org/Inline/Citation.hs
index a11804983..2d0d460a2 100644
--- a/test/Tests/Readers/Org/Inline/Citation.hs
+++ b/test/Tests/Readers/Org/Inline/Citation.hs
@@ -19,9 +19,9 @@ import Text.Pandoc.Builder
tests :: [TestTree]
tests =
- [ testGroup "Markdown-style citations"
+ [ testGroup "Org-cite citations"
[ "Citation" =:
- "[@nonexistent]" =?>
+ "[cite:@nonexistent]" =?>
let citation = Citation
{ citationId = "nonexistent"
, citationPrefix = []
@@ -29,10 +29,10 @@ tests =
, citationMode = NormalCitation
, citationNoteNum = 0
, citationHash = 0}
- in (para $ cite [citation] "[@nonexistent]")
+ in (para $ cite [citation] "[cite:@nonexistent]")
, "Citation containing text" =:
- "[see @item1 p. 34-35]" =?>
+ "[cite:see @item1 p. 34-35]" =?>
let citation = Citation
{ citationId = "item1"
, citationPrefix = [Str "see"]
@@ -40,7 +40,37 @@ tests =
, citationMode = NormalCitation
, citationNoteNum = 0
, citationHash = 0}
- in (para $ cite [citation] "[see @item1 p. 34-35]")
+ in (para $ cite [citation] "[cite:see @item1 p. 34-35]")
+
+ , "Author-in-text citation with locator and suffix" =:
+ "[cite/t:see @item1 p. 34-35 and *passim*; @item2]" =?>
+ let citations =
+ [ Citation
+ { citationId = "item1"
+ , citationPrefix = [ Str "see" ]
+ , citationSuffix =
+ [ Str "p."
+ , Space
+ , Str "34-35"
+ , Space
+ , Str "and"
+ , Space
+ , Strong [ Str "passim" ]
+ ]
+ , citationMode = AuthorInText
+ , citationNoteNum = 0
+ , citationHash = 0
+ }
+ , Citation
+ { citationId = "item2"
+ , citationPrefix = []
+ , citationSuffix = []
+ , citationMode = NormalCitation
+ , citationNoteNum = 0
+ , citationHash = 0
+ }
+ ]
+ in (para $ cite citations "[cite/t:see @item1 p. 34-35 and *passim*; @item2]")
]
, testGroup "org-ref citations"
@@ -169,53 +199,6 @@ tests =
in (para $ cite [citation] "[[citep:Dominik201408][See page 20::, for example]]")
]
- , testGroup "Berkeley-style citations" $
- let pandocCite = Citation
- { citationId = "Pandoc"
- , citationPrefix = mempty
- , citationSuffix = mempty
- , citationMode = NormalCitation
- , citationNoteNum = 0
- , citationHash = 0
- }
- pandocInText = pandocCite { citationMode = AuthorInText }
- dominikCite = Citation
- { citationId = "Dominik201408"
- , citationPrefix = mempty
- , citationSuffix = mempty
- , citationMode = NormalCitation
- , citationNoteNum = 0
- , citationHash = 0
- }
- dominikInText = dominikCite { citationMode = AuthorInText }
- in
- [ "Berkeley-style in-text citation" =:
- "See @Dominik201408." =?>
- para ("See "
- <> cite [dominikInText] "@Dominik201408"
- <> ".")
-
- , "Berkeley-style parenthetical citation list" =:
- "[(cite): see; @Dominik201408;also @Pandoc; and others]" =?>
- let pandocCite' = pandocCite {
- citationPrefix = toList "also"
- , citationSuffix = toList "and others"
- }
- dominikCite' = dominikCite {
- citationPrefix = toList "see"
- }
- in (para $ cite [dominikCite', pandocCite'] "")
-
- , "Berkeley-style plain citation list" =:
- "[cite: See; @Dominik201408; and @Pandoc; and others]" =?>
- let pandocCite' = pandocInText { citationPrefix = toList "and" }
- in (para $ "See "
- <> cite [dominikInText] ""
- <> "," <> space
- <> cite [pandocCite'] ""
- <> "," <> space <> "and others")
- ]
-
, "LaTeX citation" =:
"\\cite{Coffee}" =?>
let citation = Citation
diff --git a/test/Tests/Readers/Org/Meta.hs b/test/Tests/Readers/Org/Meta.hs
index 6363d84b0..41a41cb00 100644
--- a/test/Tests/Readers/Org/Meta.hs
+++ b/test/Tests/Readers/Org/Meta.hs
@@ -238,7 +238,7 @@ tests =
, " :setting: foo"
, " :END:"
] =?>
- (mempty::Blocks)
+ (setMeta "setting" ("foo" :: T.Text) (doc mempty))
, "Logbook drawer" =:
T.unlines [ " :LogBook:"
diff --git a/test/Tests/Readers/RST.hs b/test/Tests/Readers/RST.hs
index a12b59fc2..e9ab8cc11 100644
--- a/test/Tests/Readers/RST.hs
+++ b/test/Tests/Readers/RST.hs
@@ -179,6 +179,15 @@ tests = [ "line block with blank line" =:
, "custom code role with language field"
=: ".. role:: lhs(code)\n :language: haskell\n\n:lhs:`a`"
=?> para (codeWith ("", ["lhs", "haskell"], []) "a")
+ , "custom role with class field"
+ =: ".. role:: classy\n :class: myclass\n\n:classy:`a`"
+ =?> para (spanWith ("", ["myclass"], []) "a")
+ , "custom role with class field containing multiple whitespace-separated classes"
+ =: ".. role:: classy\n :class: myclass1 myclass2\n myclass3\n\n:classy:`a`"
+ =?> para (spanWith ("", ["myclass1", "myclass2", "myclass3"], []) "a")
+ , "custom role with inherited class field"
+ =: ".. role:: classy\n :class: myclass1\n.. role:: classier(classy)\n :class: myclass2\n\n:classier:`a`"
+ =?> para (spanWith ("", ["myclass2", "myclass1"], []) "a")
, "custom role with unspecified parent role"
=: ".. role:: classy\n\n:classy:`text`"
=?> para (spanWith ("", ["classy"], []) "text")
diff --git a/test/Tests/Readers/RTF.hs b/test/Tests/Readers/RTF.hs
new file mode 100644
index 000000000..1b335274b
--- /dev/null
+++ b/test/Tests/Readers/RTF.hs
@@ -0,0 +1,42 @@
+{- |
+ Module : Tests.Readers.RTF
+ Copyright : © 2021 John MacFarlane
+ License : GNU GPL, version 2 or above
+
+ Maintainer : jgm@berkeley.edu
+ Stability : alpha
+ Portability : portable
+
+Tests for the RTF reader.
+-}
+module Tests.Readers.RTF (tests) where
+
+import Test.Tasty
+import Tests.Helpers
+import Text.Pandoc
+import System.FilePath (replaceExtension, (</>), (<.>))
+
+rtfTest :: TestName -> TestTree
+rtfTest name = testGolden name native path
+ (\t -> runIOorExplode
+ (readRTF def t >>=
+ writeNative def{ writerTemplate = Just mempty }))
+ where native = replaceExtension path ".native"
+ path = "rtf" </> name <.> "rtf"
+
+
+tests :: [TestTree]
+tests = map rtfTest [ "footnote"
+ , "accent"
+ , "unicode"
+ , "image"
+ , "link"
+ , "heading"
+ , "formatting"
+ , "list_simple"
+ , "list_complex"
+ , "bookmark"
+ , "table_simple"
+ , "table_error_codes"
+ ]
+
diff --git a/test/Tests/Shared.hs b/test/Tests/Shared.hs
index e415ea153..5365812fe 100644
--- a/test/Tests/Shared.hs
+++ b/test/Tests/Shared.hs
@@ -56,6 +56,7 @@ testLegacyTable :: [TestTree]
testLegacyTable =
[ testCase "decomposes a table with head" $ gen1 @?= expect1
, testCase "decomposes a table without head" $ gen2 @?= expect2
+ , testCase "decomposes the table from issue 7683" $ gen3 @?= expect3
]
where
pln = toList . plain . str
@@ -110,3 +111,18 @@ testLegacyTable =
,[pln "j", mempty, mempty]]
)
gen2 = toLegacyTable emptyCaption spec1 (th []) [body1] (tf footRows1)
+
+ spec3 = replicate 4 (AlignDefault, ColWidthDefault)
+ body3 = tb 0
+ []
+ [[cl "a" 2 1, cl "b" 1 2, cl "c" 2 1]
+ ,[cl "d" 1 1, cl "e" 1 1]
+ ]
+ expect3 = ( []
+ , replicate 4 AlignDefault
+ , replicate 4 0
+ , []
+ , [[pln "a", pln "b", mempty, pln "c"]
+ ,[mempty, pln "d", pln "e", mempty]]
+ )
+ gen3 = toLegacyTable emptyCaption spec3 (th []) [body3] (tf [])
diff --git a/test/Tests/Writers/AsciiDoc.hs b/test/Tests/Writers/AsciiDoc.hs
index 04655635f..7b2dd11e8 100644
--- a/test/Tests/Writers/AsciiDoc.hs
+++ b/test/Tests/Writers/AsciiDoc.hs
@@ -38,6 +38,22 @@ tests = [ testGroup "emphasis"
para (singleQuoted (strong (text "foo"))) =?>
"`**foo**'"
]
+ , testGroup "blocks"
+ [ testAsciidoc "code block without line numbers" $
+ codeBlockWith ("", [ "haskell" ], []) "foo" =?> unlines
+ [ "[source,haskell]"
+ , "----"
+ , "foo"
+ , "----"
+ ]
+ , testAsciidoc "code block with line numbers" $
+ codeBlockWith ("", [ "haskell", "numberLines" ], []) "foo" =?> unlines
+ [ "[source%linesnum,haskell]"
+ , "----"
+ , "foo"
+ , "----"
+ ]
+ ]
, testGroup "tables"
[ testAsciidoc "empty cells" $
simpleTable [] [[mempty],[mempty]] =?> unlines
diff --git a/test/Tests/Writers/Docx.hs b/test/Tests/Writers/Docx.hs
index da25b95e0..93b56e1c2 100644
--- a/test/Tests/Writers/Docx.hs
+++ b/test/Tests/Writers/Docx.hs
@@ -31,7 +31,8 @@ tests = [ testGroup "inlines"
"docx/golden/links.docx"
, docxTest
"inline image"
- def
+ def{ writerExtensions =
+ enableExtension Ext_native_numbering (writerExtensions def) }
"docx/image_writer_test.native"
"docx/golden/image.docx"
, docxTest
diff --git a/test/Tests/Writers/HTML.hs b/test/Tests/Writers/HTML.hs
index 404f6da98..a81badae8 100644
--- a/test/Tests/Writers/HTML.hs
+++ b/test/Tests/Writers/HTML.hs
@@ -2,14 +2,18 @@
module Tests.Writers.HTML (tests) where
import Data.Text (unpack)
+import qualified Data.Text as T
import Test.Tasty
import Tests.Helpers
import Text.Pandoc
import Text.Pandoc.Arbitrary ()
import Text.Pandoc.Builder
+htmlWithOpts :: (ToPandoc a) => WriterOptions -> a -> String
+htmlWithOpts opts = unpack . purely (writeHtml4String opts{ writerWrapText = WrapNone }) . toPandoc
+
html :: (ToPandoc a) => a -> String
-html = unpack . purely (writeHtml4String def{ writerWrapText = WrapNone }) . toPandoc
+html = htmlWithOpts def
htmlQTags :: (ToPandoc a) => a -> String
htmlQTags = unpack
@@ -33,6 +37,21 @@ infix 4 =:
=> String -> (a, String) -> TestTree
(=:) = test html
+noteTestDoc :: Blocks
+noteTestDoc =
+ header 1 "Page title" <>
+ header 2 "First section" <>
+ para ("This is a footnote." <>
+ note (para "Down here.") <>
+ " And this is a " <>
+ link "https://www.google.com" "" "link" <>
+ ".") <>
+ blockQuote (para ("A note inside a block quote." <>
+ note (para "The second note.")) <>
+ para "A second paragraph.") <>
+ header 2 "Second section" <>
+ para "Some more text."
+
tests :: [TestTree]
tests =
[ testGroup "inline code"
@@ -50,7 +69,7 @@ tests =
, testGroup "blocks"
[ "definition list with empty <dt>" =:
definitionList [(mempty, [para $ text "foo bar"])]
- =?> "<dl><dt></dt><dd><p>foo bar</p></dd></dl>"
+ =?> "<dl>\n<dt></dt>\n<dd>\n<p>foo bar</p>\n</dd>\n</dl>"
, "heading with disallowed attributes" =:
headerWith ("", [], [("invalid","1"), ("lang", "en")]) 1 "test"
=?>
@@ -86,6 +105,103 @@ tests =
=?> ("<var><code class=\"sourceCode haskell\">" ++
"<span class=\"op\">&gt;&gt;=</span></code></var>")
]
+ , testGroup "footnotes"
+ [ test (htmlWithOpts def{writerReferenceLocation=EndOfDocument})
+ "at the end of a document" $
+ noteTestDoc =?>
+ T.unlines
+ [ "<h1>Page title</h1>"
+ , "<h2>First section</h2>"
+ , "<p>This is a footnote.<a href=\"#fn1\" class=\"footnote-ref\" id=\"fnref1\"><sup>1</sup></a> And this is a <a href=\"https://www.google.com\">link</a>.</p>"
+ , "<blockquote>"
+ , "<p>A note inside a block quote.<a href=\"#fn2\" class=\"footnote-ref\" id=\"fnref2\"><sup>2</sup></a></p>"
+ , "<p>A second paragraph.</p>"
+ , "</blockquote>"
+ , "<h2>Second section</h2>"
+ , "<p>Some more text.</p>"
+ , "<div class=\"footnotes footnotes-end-of-document\">"
+ , "<hr />"
+ , "<ol>"
+ , "<li id=\"fn1\"><p>Down here.<a href=\"#fnref1\" class=\"footnote-back\">↩︎</a></p></li>"
+ , "<li id=\"fn2\"><p>The second note.<a href=\"#fnref2\" class=\"footnote-back\">↩︎</a></p></li>"
+ , "</ol>"
+ , "</div>"
+ ]
+ , test (htmlWithOpts def{writerReferenceLocation=EndOfBlock})
+ "at the end of a block" $
+ noteTestDoc =?>
+ T.unlines
+ [ "<h1>Page title</h1>"
+ , "<h2>First section</h2>"
+ , "<p>This is a footnote.<a href=\"#fn1\" class=\"footnote-ref\" id=\"fnref1\"><sup>1</sup></a> And this is a <a href=\"https://www.google.com\">link</a>.</p>"
+ , "<div class=\"footnotes footnotes-end-of-block\">"
+ , "<ol>"
+ , "<li id=\"fn1\"><p>Down here.<a href=\"#fnref1\" class=\"footnote-back\">↩︎</a></p></li>"
+ , "</ol>"
+ , "</div>"
+ , "<blockquote>"
+ , "<p>A note inside a block quote.<a href=\"#fn2\" class=\"footnote-ref\" id=\"fnref2\"><sup>2</sup></a></p>"
+ , "<p>A second paragraph.</p>"
+ , "</blockquote>"
+ , "<div class=\"footnotes footnotes-end-of-block\">"
+ , "<ol start=\"2\">"
+ , "<li id=\"fn2\"><p>The second note.<a href=\"#fnref2\" class=\"footnote-back\">↩︎</a></p></li>"
+ , "</ol>"
+ , "</div>"
+ , "<h2>Second section</h2>"
+ , "<p>Some more text.</p>"
+ ]
+ , test (htmlWithOpts def{writerReferenceLocation=EndOfSection})
+ "at the end of a section" $
+ noteTestDoc =?>
+ T.unlines
+ [ "<h1>Page title</h1>"
+ , "<h2>First section</h2>"
+ , "<p>This is a footnote.<a href=\"#fn1\" class=\"footnote-ref\" id=\"fnref1\"><sup>1</sup></a> And this is a <a href=\"https://www.google.com\">link</a>.</p>"
+ , "<blockquote>"
+ , "<p>A note inside a block quote.<a href=\"#fn2\" class=\"footnote-ref\" id=\"fnref2\"><sup>2</sup></a></p>"
+ , "<p>A second paragraph.</p>"
+ , "</blockquote>"
+ , "<div class=\"footnotes footnotes-end-of-section\">"
+ , "<hr />"
+ , "<ol>"
+ , "<li id=\"fn1\"><p>Down here.<a href=\"#fnref1\" class=\"footnote-back\">↩︎</a></p></li>"
+ , "<li id=\"fn2\"><p>The second note.<a href=\"#fnref2\" class=\"footnote-back\">↩︎</a></p></li>"
+ , "</ol>"
+ , "</div>"
+ , "<h2>Second section</h2>"
+ , "<p>Some more text.</p>"
+ ]
+ , test (htmlWithOpts def{writerReferenceLocation=EndOfSection, writerSectionDivs=True})
+ "at the end of a section, with section divs" $
+ noteTestDoc =?>
+ -- Footnotes are rendered _after_ their section (in this case after the level2 section
+ -- that contains it).
+ T.unlines
+ [ "<div class=\"section level1\">"
+ , "<h1>Page title</h1>"
+ , "<div class=\"section level2\">"
+ , "<h2>First section</h2>"
+ , "<p>This is a footnote.<a href=\"#fn1\" class=\"footnote-ref\" id=\"fnref1\"><sup>1</sup></a> And this is a <a href=\"https://www.google.com\">link</a>.</p>"
+ , "<blockquote>"
+ , "<p>A note inside a block quote.<a href=\"#fn2\" class=\"footnote-ref\" id=\"fnref2\"><sup>2</sup></a></p>"
+ , "<p>A second paragraph.</p>"
+ , "</blockquote>"
+ , "</div>"
+ , "<div class=\"footnotes footnotes-end-of-section\">"
+ , "<hr />"
+ , "<ol>"
+ , "<li id=\"fn1\"><p>Down here.<a href=\"#fnref1\" class=\"footnote-back\">↩︎</a></p></li>"
+ , "<li id=\"fn2\"><p>The second note.<a href=\"#fnref2\" class=\"footnote-back\">↩︎</a></p></li>"
+ , "</ol>"
+ , "</div>"
+ , "<div class=\"section level2\">"
+ , "<h2>Second section</h2>"
+ , "<p>Some more text.</p>"
+ , "</div>"
+ , "</div>"
+ ]
+ ]
]
where
tQ :: (ToString a, ToPandoc a)
diff --git a/test/Tests/Writers/JATS.hs b/test/Tests/Writers/JATS.hs
index 5b96ed2ed..e605f55e1 100644
--- a/test/Tests/Writers/JATS.hs
+++ b/test/Tests/Writers/JATS.hs
@@ -61,21 +61,39 @@ tests =
, "</fn></p>"
])
]
- , "bullet list" =: bulletList [ plain $ text "first"
- , plain $ text "second"
- , plain $ text "third"
- ]
- =?> "<list list-type=\"bullet\">\n\
- \ <list-item>\n\
- \ <p>first</p>\n\
- \ </list-item>\n\
- \ <list-item>\n\
- \ <p>second</p>\n\
- \ </list-item>\n\
- \ <list-item>\n\
- \ <p>third</p>\n\
- \ </list-item>\n\
- \</list>"
+ , testGroup "bullet list"
+ [ "plain items" =: bulletList [ plain $ text "first"
+ , plain $ text "second"
+ , plain $ text "third"
+ ]
+ =?> "<list list-type=\"bullet\">\n\
+ \ <list-item>\n\
+ \ <p>first</p>\n\
+ \ </list-item>\n\
+ \ <list-item>\n\
+ \ <p>second</p>\n\
+ \ </list-item>\n\
+ \ <list-item>\n\
+ \ <p>third</p>\n\
+ \ </list-item>\n\
+ \</list>"
+
+ , "item with implicit figure" =:
+ bulletList [ simpleFigure (text "caption") "a.png" "" ] =?>
+ T.unlines
+ [ "<list list-type=\"bullet\">"
+ , " <list-item>"
+ , " <p specific-use=\"wrapper\">"
+ , " <fig>"
+ , " <caption><p>caption</p></caption>"
+ , " <graphic mimetype=\"image\" mime-subtype=\"png\"" <>
+ " xlink:href=\"a.png\" xlink:title=\"\" />"
+ , " </fig>"
+ , " </p>"
+ , " </list-item>"
+ , "</list>"
+ ]
+ ]
, testGroup "definition lists"
[ "with internal link" =: definitionList [(link "#go" "" (str "testing"),
[plain (text "hi there")])] =?>
diff --git a/test/Tests/Writers/Markua.hs b/test/Tests/Writers/Markua.hs
new file mode 100644
index 000000000..62239f3da
--- /dev/null
+++ b/test/Tests/Writers/Markua.hs
@@ -0,0 +1,40 @@
+{-# LANGUAGE OverloadedStrings #-}
+module Tests.Writers.Markua (tests) where
+
+import Test.Tasty
+import Tests.Helpers
+import Text.Pandoc
+import Text.Pandoc.Arbitrary ()
+import Text.Pandoc.Builder
+
+{-
+ "my test" =: X =?> Y
+
+is shorthand for
+
+ test html "my test" $ X =?> Y
+
+which is in turn shorthand for
+
+ test html "my test" (X,Y)
+-}
+
+infix 4 =:
+(=:) :: (ToString a, ToPandoc a)
+ => String -> (a, String) -> TestTree
+(=:) = test (purely (writeMarkua def) . toPandoc)
+
+tests :: [TestTree]
+tests = [ testGroup "simple blurb/aside"
+ ["blurb" =: divWith ("",["blurb"],[]) (bulletList [para "blurb content"])
+ =?> "B> * blurb content"
+ ,"aside" =: divWith ("",["aside"],[]) (bulletList [para "aside list"])
+ =?> "A> * aside list"
+ ]
+ ,testGroup "multiclass blurb/aside"
+ ["blurb" =: divWith ("",["blurb", "otherclass"],[]) (bulletList [para "blurb content"])
+ =?> "B> * blurb content"
+ ,"aside" =: divWith ("",["otherclass", "aside"],[]) (bulletList [para "aside list"])
+ =?> "A> * aside list"
+ ]
+ ]
diff --git a/test/Tests/Writers/OOXML.hs b/test/Tests/Writers/OOXML.hs
index 83f05cfec..43543954c 100644
--- a/test/Tests/Writers/OOXML.hs
+++ b/test/Tests/Writers/OOXML.hs
@@ -3,13 +3,15 @@
module Tests.Writers.OOXML (ooxmlTest) where
-import Text.Pandoc
+import Text.Pandoc hiding (Attr)
import Test.Tasty
import Test.Tasty.Golden.Advanced
+import Control.Applicative ((<|>))
import Codec.Archive.Zip
import Text.XML.Light
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BL
+import Data.Foldable (asum)
import qualified Data.Text.IO as T
import Data.List (isSuffixOf, sort, (\\), intercalate, union)
import Data.Maybe (catMaybes, mapMaybe)
@@ -17,34 +19,59 @@ import Tests.Helpers
import Data.Algorithm.Diff
import System.FilePath.Glob (compile, match)
-compareXMLBool :: Content -> Content -> Bool
+compareXML :: Content -> Content -> Maybe XMLDifference
-- We make a special exception for times at the moment, and just pass
-- them because we can't control the utctime when running IO. Besides,
-- so long as we have two times, we're okay.
-compareXMLBool (Elem myElem) (Elem goodElem)
+compareXML (Elem goodElem) (Elem myElem)
| (QName "created" _ (Just "dcterms")) <- elName myElem
, (QName "created" _ (Just "dcterms")) <- elName goodElem =
- True
-compareXMLBool (Elem myElem) (Elem goodElem)
+ Nothing
+compareXML (Elem goodElem) (Elem myElem)
| (QName "modified" _ (Just "dcterms")) <- elName myElem
, (QName "modified" _ (Just "dcterms")) <- elName goodElem =
- True
-compareXMLBool (Elem myElem) (Elem goodElem) =
- elName myElem == elName goodElem &&
- elAttribs myElem == elAttribs goodElem &&
- and (zipWith compareXMLBool (elContent myElem) (elContent goodElem))
-compareXMLBool (Text myCData) (Text goodCData) =
- cdVerbatim myCData == cdVerbatim goodCData &&
- cdData myCData == cdData goodCData &&
- cdLine myCData == cdLine goodCData
-compareXMLBool (CRef myStr) (CRef goodStr) =
- myStr == goodStr
-compareXMLBool _ _ = False
-
-displayDiff :: Content -> Content -> String
+ Nothing
+compareXML (Elem goodElem) (Elem myElem) =
+ (if elName myElem == elName goodElem
+ then Nothing
+ else Just
+ (ElemNamesDiffer
+ (Comparison {mine = elName myElem, good = elName goodElem}))
+ )
+ <|> (if sort (elAttribs myElem) == sort (elAttribs goodElem)
+ then Nothing
+ else Just
+ (ElemAttributesDiffer
+ (Comparison { mine = sort (elAttribs myElem)
+ , good = sort (elAttribs goodElem)
+ })))
+ <|> asum (zipWith compareXML (elContent myElem) (elContent goodElem))
+compareXML (Text goodCData) (Text myCData) =
+ (if cdVerbatim myCData == cdVerbatim goodCData
+ && cdData myCData == cdData goodCData
+ then Nothing
+ else Just (CDatasDiffer (Comparison { mine = myCData, good = goodCData })))
+compareXML (CRef goodStr) (CRef myStr) =
+ if myStr == goodStr
+ then Nothing
+ else Just (CRefsDiffer (Comparison { mine = myStr, good = goodStr }))
+compareXML g m = Just (OtherContentsDiffer (Comparison {mine = m, good = g}))
+
+data XMLDifference
+ = ElemNamesDiffer (Comparison QName)
+ | ElemAttributesDiffer (Comparison [Attr])
+ | CDatasDiffer (Comparison CData)
+ | CRefsDiffer (Comparison String)
+ | OtherContentsDiffer (Comparison Content)
+ deriving (Show)
+
+data Comparison a = Comparison { good :: a, mine :: a }
+ deriving (Show)
+
+displayDiff :: Element -> Element -> String
displayDiff elemA elemB =
showDiff (1,1)
- (getDiff (lines $ showContent elemA) (lines $ showContent elemB))
+ (getDiff (lines $ ppElement elemA) (lines $ ppElement elemB))
goldenArchive :: FilePath -> IO Archive
goldenArchive fp = toArchive . BL.fromStrict <$> BS.readFile fp
@@ -57,6 +84,7 @@ testArchive writerFn opts fp = do
txt <- T.readFile fp
bs <- runIOorExplode $ do
setTranslations "en-US"
+ setVerbosity ERROR -- otherwise test output is confusingly noisy
readNative def txt >>= writerFn opts
return $ toArchive bs
@@ -106,11 +134,13 @@ compareXMLFile' fp goldenArch testArch = do
let testContent = Elem testXMLDoc
goldenContent = Elem goldenXMLDoc
+ display difference = "Non-matching xml in "
+ ++ fp ++ ":\n"
+ ++ "* " ++ show difference ++ "\n"
+ ++ displayDiff testXMLDoc goldenXMLDoc
- if compareXMLBool goldenContent testContent
- then Right ()
- else Left $
- "Non-matching xml in " ++ fp ++ ":\n" ++ displayDiff testContent goldenContent
+
+ maybe (Right ()) (Left . display) (compareXML goldenContent testContent)
compareXMLFile :: FilePath -> Archive -> Archive -> Maybe String
compareXMLFile fp goldenArch testArch =
diff --git a/test/Tests/Writers/Powerpoint.hs b/test/Tests/Writers/Powerpoint.hs
index 87ebe990c..0e8ef076b 100644
--- a/test/Tests/Writers/Powerpoint.hs
+++ b/test/Tests/Writers/Powerpoint.hs
@@ -1,5 +1,6 @@
module Tests.Writers.Powerpoint (tests) where
+import Control.Arrow ((***))
import Tests.Writers.OOXML (ooxmlTest)
import Text.Pandoc
import Test.Tasty
@@ -12,13 +13,13 @@ import Data.Text (pack)
-- we want to run all our tests with both default formatting and a
-- template.
-modifyPptxName :: FilePath -> FilePath
-modifyPptxName fp =
- addExtension (dropExtension fp ++ "_templated") "pptx"
+modifyPptxName :: FilePath -> String -> FilePath
+modifyPptxName fp suffix =
+ addExtension (takeDirectory fp ++ suffix) "pptx"
pptxTests :: String -> WriterOptions -> FilePath -> FilePath -> (TestTree, TestTree)
pptxTests name opts native pptx =
- let referenceDoc = "pptx/reference_depth.pptx"
+ let referenceDoc = "pptx/reference-depth.pptx"
in
( ooxmlTest
writePowerpoint
@@ -31,7 +32,7 @@ pptxTests name opts native pptx =
name
opts{writerReferenceDoc=Just referenceDoc}
native
- (modifyPptxName pptx)
+ (modifyPptxName pptx "/templated")
)
groupPptxTests :: [(TestTree, TestTree)] -> [TestTree]
@@ -42,91 +43,230 @@ groupPptxTests pairs =
, testGroup "With `--reference-doc` pptx file" refs
]
+testGroup' :: String -> [(TestTree, TestTree)] -> (TestTree, TestTree)
+testGroup' descr = (testGroup descr *** testGroup descr) . unzip
+
tests :: [TestTree]
-tests = groupPptxTests [ pptxTests "Inline formatting"
- def
- "pptx/inline_formatting.native"
- "pptx/inline_formatting.pptx"
- , pptxTests "Slide breaks (default slide-level)"
- def
- "pptx/slide_breaks.native"
- "pptx/slide_breaks.pptx"
- , pptxTests "slide breaks (slide-level set to 1)"
- def{ writerSlideLevel = Just 1 }
- "pptx/slide_breaks.native"
- "pptx/slide_breaks_slide_level_1.pptx"
- , pptxTests "lists"
- def
- "pptx/lists.native"
- "pptx/lists.pptx"
- , pptxTests "start ordered list at specified num"
- def
- "pptx/start_numbering_at.native"
- "pptx/start_numbering_at.pptx"
- , pptxTests "tables"
- def
- "pptx/tables.native"
- "pptx/tables.pptx"
- , pptxTests "table of contents"
- def{ writerTableOfContents = True }
- "pptx/slide_breaks.native"
- "pptx/slide_breaks_toc.pptx"
- , pptxTests "end notes"
- def
- "pptx/endnotes.native"
- "pptx/endnotes.pptx"
- , pptxTests "end notes, with table of contents"
- def { writerTableOfContents = True }
- "pptx/endnotes.native"
- "pptx/endnotes_toc.pptx"
- , pptxTests "images"
- def
- "pptx/images.native"
- "pptx/images.pptx"
- , pptxTests "two-column layout"
- def
- "pptx/two_column.native"
- "pptx/two_column.pptx"
- , pptxTests "speaker notes"
- def
- "pptx/speaker_notes.native"
- "pptx/speaker_notes.pptx"
- , pptxTests "speaker notes after a separating block"
- def
- "pptx/speaker_notes_afterseps.native"
- "pptx/speaker_notes_afterseps.pptx"
- , pptxTests "speaker notes after a separating header"
- def
- "pptx/speaker_notes_afterheader.native"
- "pptx/speaker_notes_afterheader.pptx"
- , pptxTests "speaker notes after metadata"
- def
- "pptx/speaker_notes_after_metadata.native"
- "pptx/speaker_notes_after_metadata.pptx"
- , pptxTests "remove empty slides"
- def
- "pptx/remove_empty_slides.native"
- "pptx/remove_empty_slides.pptx"
- , pptxTests "raw ooxml"
- def
- "pptx/raw_ooxml.native"
- "pptx/raw_ooxml.pptx"
- , pptxTests "metadata, custom properties"
- def
- "pptx/document-properties.native"
- "pptx/document-properties.pptx"
- , pptxTests "metadata, short description"
- def
- "pptx/document-properties-short-desc.native"
- "pptx/document-properties-short-desc.pptx"
- , pptxTests "inline code and code blocks"
- def
- "pptx/code.native"
- "pptx/code.pptx"
- , pptxTests "inline code and code blocks, custom formatting"
- def { writerVariables = Context $ M.fromList
- [(pack "monofont", toVal $ pack "Consolas")] }
- "pptx/code.native"
- "pptx/code-custom.pptx"
- ]
+tests = let
+ regularTests = groupPptxTests
+ [ pptxTests "Inline formatting"
+ def
+ "pptx/inline-formatting/input.native"
+ "pptx/inline-formatting/output.pptx"
+ , pptxTests "Slide breaks (default slide-level)"
+ def
+ "pptx/slide-breaks/input.native"
+ "pptx/slide-breaks/output.pptx"
+ , pptxTests "slide breaks (slide-level set to 1)"
+ def{ writerSlideLevel = Just 1 }
+ "pptx/slide-breaks/input.native"
+ "pptx/slide-breaks-slide-level-1/output.pptx"
+ , pptxTests "lists"
+ def
+ "pptx/lists/input.native"
+ "pptx/lists/output.pptx"
+ , pptxTests "start ordered list at specified num"
+ def
+ "pptx/start-numbering-at/input.native"
+ "pptx/start-numbering-at/output.pptx"
+ , pptxTests "List continuation paragraph indentation"
+ def
+ "pptx/list-level/input.native"
+ "pptx/list-level/output.pptx"
+ , pptxTests "tables"
+ def
+ "pptx/tables/input.native"
+ "pptx/tables/output.pptx"
+ , pptxTests "table of contents"
+ def{ writerTableOfContents = True }
+ "pptx/slide-breaks/input.native"
+ "pptx/slide-breaks-toc/output.pptx"
+ , pptxTests "end notes"
+ def
+ "pptx/endnotes/input.native"
+ "pptx/endnotes/output.pptx"
+ , pptxTests "end notes, with table of contents"
+ def { writerTableOfContents = True }
+ "pptx/endnotes/input.native"
+ "pptx/endnotes-toc/output.pptx"
+ , pptxTests "images"
+ def
+ "pptx/images/input.native"
+ "pptx/images/output.pptx"
+ , pptxTests "two-column layout"
+ def
+ "pptx/two-column/all-text/input.native"
+ "pptx/two-column/all-text/output.pptx"
+ , pptxTests "two-column (not comparison)"
+ def
+ "pptx/two-column/text-and-image/input.native"
+ "pptx/two-column/text-and-image/output.pptx"
+ , pptxTests "speaker notes"
+ def
+ "pptx/speaker-notes/input.native"
+ "pptx/speaker-notes/output.pptx"
+ , pptxTests "speaker notes after a separating block"
+ def
+ "pptx/speaker-notes-afterseps/input.native"
+ "pptx/speaker-notes-afterseps/output.pptx"
+ , pptxTests "speaker notes after a separating header"
+ def
+ "pptx/speaker-notes-afterheader/input.native"
+ "pptx/speaker-notes-afterheader/output.pptx"
+ , pptxTests "speaker notes after metadata"
+ def
+ "pptx/speaker-notes-after-metadata/input.native"
+ "pptx/speaker-notes-after-metadata/output.pptx"
+ , pptxTests "remove empty slides"
+ def
+ "pptx/remove-empty-slides/input.native"
+ "pptx/remove-empty-slides/output.pptx"
+ , pptxTests "raw ooxml"
+ def
+ "pptx/raw-ooxml/input.native"
+ "pptx/raw-ooxml/output.pptx"
+ , pptxTests "metadata, custom properties"
+ def
+ "pptx/document-properties/input.native"
+ "pptx/document-properties/output.pptx"
+ , pptxTests "metadata, short description"
+ def
+ "pptx/document-properties-short-desc/input.native"
+ "pptx/document-properties-short-desc/output.pptx"
+ , pptxTests "inline code and code blocks"
+ def
+ "pptx/code/input.native"
+ "pptx/code/output.pptx"
+ , pptxTests "inline code and code blocks, custom formatting"
+ def { writerVariables = Context $ M.fromList
+ [(pack "monofont", toVal $ pack "Consolas")] }
+ "pptx/code/input.native"
+ "pptx/code-custom/output.pptx"
+ , testGroup' "Using slide level 0, if the first thing on a slide is"
+ [ pptxTests ("a h1 it's used as the slide title")
+ def { writerSlideLevel = Just 0 }
+ "pptx/slide-level-0/h1-with-image/input.native"
+ "pptx/slide-level-0/h1-with-image/output.pptx"
+ , pptxTests ("a h2 it's used as the "
+ <> "slide title")
+ def { writerSlideLevel = Just 0 }
+ "pptx/slide-level-0/h2-with-image/input.native"
+ "pptx/slide-level-0/h2-with-image/output.pptx"
+ , testGroup' "a heading it's used as the slide title"
+ [ pptxTests "(works with a table)"
+ def { writerSlideLevel = Just 0 }
+ "pptx/slide-level-0/h1-with-table/input.native"
+ "pptx/slide-level-0/h1-with-table/output.pptx"
+ , pptxTests ("(content with caption layout)")
+ def { writerSlideLevel = Just 0 }
+ "pptx/slide-level-0/h1-h2-with-table/input.native"
+ "pptx/slide-level-0/h1-h2-with-table/output.pptx"
+ ]
+ ]
+ , testGroup' "comparison layout"
+ [ testGroup' "comparison layout is used..."
+ [ pptxTests "when two columns contain text + non-text"
+ def
+ "pptx/comparison/both-columns/input.native"
+ "pptx/comparison/both-columns/output.pptx"
+ , pptxTests "even when only one col contains text + non-text"
+ def
+ "pptx/comparison/one-column/input.native"
+ "pptx/comparison/one-column/output.pptx"
+ ]
+ , testGroup' "extra ... in one column gets overlaid"
+ [ pptxTests "text"
+ def
+ "pptx/comparison/extra-text/input.native"
+ "pptx/comparison/extra-text/output.pptx"
+ , pptxTests "image"
+ def
+ "pptx/comparison/extra-image/input.native"
+ "pptx/comparison/extra-image/output.pptx"
+ ]
+ , pptxTests "is not used if the non-text comes first"
+ def
+ "pptx/comparison/non-text-first/input.native"
+ "pptx/comparison/non-text-first/output.pptx"
+ ]
+ , testGroup' "Content with Caption layout is ..."
+ [ pptxTests "used for heading, text, image on the same slide"
+ def
+ "pptx/content-with-caption/heading-text-image/input.native"
+ "pptx/content-with-caption/heading-text-image/output.pptx"
+ , pptxTests "used for text and an image on the same slide"
+ def
+ "pptx/content-with-caption/text-image/input.native"
+ "pptx/content-with-caption/text-image/output.pptx"
+ , pptxTests "not used if the image comes first"
+ def
+ "pptx/content-with-caption/image-text/input.native"
+ "pptx/content-with-caption/image-text/output.pptx"
+ ]
+ , testGroup' "The Blank layout is used if a slide contains only..."
+ [ pptxTests "speaker notes"
+ def
+ "pptx/blanks/just-speaker-notes/input.native"
+ "pptx/blanks/just-speaker-notes/output.pptx"
+ , pptxTests "an empty heading with a body of only NBSPs"
+ def
+ "pptx/blanks/nbsp-in-body/input.native"
+ "pptx/blanks/nbsp-in-body/output.pptx"
+ , pptxTests "a heading containing only non-breaking spaces"
+ def
+ "pptx/blanks/nbsp-in-heading/input.native"
+ "pptx/blanks/nbsp-in-heading/output.pptx"
+ ]
+ , pptxTests ("Incremental lists are supported")
+ def { writerIncremental = True }
+ "pptx/incremental-lists/with-flag/input.native"
+ "pptx/incremental-lists/with-flag/output.pptx"
+ , pptxTests ("One-off incremental lists are supported")
+ def
+ "pptx/incremental-lists/without-flag/input.native"
+ "pptx/incremental-lists/without-flag/output.pptx"
+ , pptxTests "Background images"
+ def
+ "pptx/background-image/input.native"
+ "pptx/background-image/output.pptx"
+ ]
+ referenceSpecificTests =
+ [ ooxmlTest
+ writePowerpoint
+ "Basic footer"
+ def { writerReferenceDoc = Just "pptx/footer/basic/reference.pptx"}
+ "pptx/footer/input.native"
+ "pptx/footer/basic/output.pptx"
+ , ooxmlTest
+ writePowerpoint
+ "Footer with fixed date, replaced by meta block date"
+ def { writerReferenceDoc = Just "pptx/footer/fixed-date/reference.pptx"}
+ "pptx/footer/input.native"
+ "pptx/footer/fixed-date/output.pptx"
+ , ooxmlTest
+ writePowerpoint
+ "Footer not shown on title slide"
+ def { writerReferenceDoc = Just "pptx/footer/no-title-slide/reference.pptx"}
+ "pptx/footer/input.native"
+ "pptx/footer/no-title-slide/output.pptx"
+ , ooxmlTest
+ writePowerpoint
+ "Footer with slide number starting from 3"
+ def { writerReferenceDoc = Just "pptx/footer/higher-slide-number/reference.pptx"}
+ "pptx/footer/input.native"
+ "pptx/footer/higher-slide-number/output.pptx"
+ , ooxmlTest
+ writePowerpoint
+ "Layouts can be moved around in reference doc"
+ def {writerReferenceDoc = Just "pptx/reference-moved-layouts.pptx"}
+ "pptx/layouts/input.native"
+ "pptx/layouts/moved.pptx"
+ , ooxmlTest
+ writePowerpoint
+ "Layouts can be missing from the reference doc"
+ def {writerReferenceDoc = Just "pptx/reference-deleted-layouts.pptx"}
+ "pptx/layouts/input.native"
+ "pptx/layouts/deleted.pptx"
+ ]
+ in regularTests <> referenceSpecificTests
generated by cgit v1.2.3 (git 2.39.1) at 2024-06-28 11:17:53 +0000