From f6eac1ad7e5583e107c29aeb011483ef0500952c Mon Sep 17 00:00:00 2001
From: Jesse Rosenthal <jrosenthal@jhu.edu>
Date: Mon, 19 Feb 2018 20:04:39 -0500
Subject: Powerpoint writer tests: Test everything with template as well

Modify the PowerPoint tests to run all the tests with
template (--reference-doc) as well. Because there are so many
interlocking pieces, bugs can pop up in weird places when using
templates, since it changes how the writer builds its output
file.

For example, I recently discovered a bug in which speaker notes worked
fine and templating worked fine elsewhere, but templating with speaker
notes produced a file that would crash MS PowerPoint. That particular
bug was fixed, but this will forces us to check for that with each new
change.
---
 test/Tests/Writers/Powerpoint.hs | 120 +++++++++++++++++++++++----------------
 1 file changed, 72 insertions(+), 48 deletions(-)

(limited to 'test/Tests/Writers')

diff --git a/test/Tests/Writers/Powerpoint.hs b/test/Tests/Writers/Powerpoint.hs
index 621b4fe2f..fc5f9accc 100644
--- a/test/Tests/Writers/Powerpoint.hs
+++ b/test/Tests/Writers/Powerpoint.hs
@@ -3,54 +3,78 @@ module Tests.Writers.Powerpoint (tests) where
 import Tests.Writers.OOXML (ooxmlTest)
 import Text.Pandoc
 import Test.Tasty
+import System.FilePath
+
+-- templating is important enough, and can break enough things, that
+-- we want to run all our tests with both default formatting and a
+-- template.
+
+modifyPptxName :: FilePath -> FilePath
+modifyPptxName fp =
+  addExtension (dropExtension fp ++ "_templated") "pptx"
+
+pptxTests :: String -> WriterOptions -> FilePath -> FilePath -> (TestTree, TestTree)
+pptxTests name opts native pptx =
+  let referenceDoc = "pptx/reference_depth.pptx"
+  in
+    ( ooxmlTest
+      writePowerpoint
+      name
+      opts{writerReferenceDoc=Nothing}
+      native
+      pptx
+    , ooxmlTest
+      writePowerpoint
+      name
+      opts{writerReferenceDoc=Just referenceDoc}
+      native
+      (modifyPptxName pptx)
+    )
+
+groupPptxTests :: [(TestTree, TestTree)] -> [TestTree]
+groupPptxTests pairs =
+  let (noRefs, refs) = unzip pairs
+  in
+    [ testGroup "Default slide formatting" noRefs
+    , testGroup "With `--reference-doc` pptx file" refs
+    ]
 
-pptxTest :: String -> WriterOptions -> FilePath -> FilePath -> TestTree
-pptxTest = ooxmlTest writePowerpoint
 
 tests :: [TestTree]
-tests = [ pptxTest
-          "Inline formatting"
-          def
-          "pptx/inline_formatting.native"
-          "pptx/inline_formatting.pptx"
-        , pptxTest
-          "Slide breaks (default slide-level)"
-          def
-          "pptx/slide_breaks.native"
-          "pptx/slide_breaks.pptx"
-        , pptxTest
-          "slide breaks (slide-level set to 1)"
-          def{ writerSlideLevel = Just 1 }
-          "pptx/slide_breaks.native"
-          "pptx/slide_breaks_slide_level_1.pptx"
-        , pptxTest
-          "table of contents"
-          def{ writerTableOfContents = True }
-          "pptx/slide_breaks.native"
-          "pptx/slide_breaks_toc.pptx"
-        , pptxTest
-          "end notes"
-          def
-          "pptx/endnotes.native"
-          "pptx/endnotes.pptx"
-        , pptxTest
-          "end notes, with table of contents"
-          def { writerTableOfContents = True }
-          "pptx/endnotes.native"
-          "pptx/endnotes_toc.pptx"
-        , pptxTest
-          "images"
-          def
-          "pptx/images.native"
-          "pptx/images.pptx"
-        , pptxTest
-          "two-column layout"
-          def
-          "pptx/two_column.native"
-          "pptx/two_column.pptx"
-        , pptxTest
-          "speaker notes"
-          def
-          "pptx/speaker_notes.native"
-          "pptx/speaker_notes.pptx"
-        ]
+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 "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"
+                       ]
-- 
cgit v1.2.3