git.iko.soy/typeable/pandoc
on master help sign in
Powerpoint Writer tests: Add quickcheck tests for content types.
76442a7Jesse Rosenthal
pandoc.cabal+2−1
compare with master
unifiedsplit
@@ -622,7 +622,8 @@ test-suite test-pandoc
622 QuickCheck >= 2.4 && < 2.11,
622 QuickCheck >= 2.4 && < 2.11,
623 containers >= 0.4.2.1 && < 0.6,
623 containers >= 0.4.2.1 && < 0.6,
624 executable-path >= 0.0 && < 0.1,
624 executable-path >= 0.0 && < 0.1,
625− zip-archive >= 0.2.3.4 && < 0.4
625+ zip-archive >= 0.2.3.4 && < 0.4,
626+ xml >= 1.3.12 && < 1.4
626 if flag(old-locale)
627 if flag(old-locale)
627 build-depends: old-locale >= 1 && < 1.1,
628 build-depends: old-locale >= 1 && < 1.1,
628 time >= 1.2 && < 1.5
629 time >= 1.2 && < 1.5
test/Tests/Writers/Powerpoint.hs+77−14
@@ -5,27 +5,35 @@ module Tests.Writers.Powerpoint (tests) where
5import Control.Exception (throwIO)
5import Control.Exception (throwIO)
6import Text.Pandoc
6import Text.Pandoc
7import Text.Pandoc.Builder
7import Text.Pandoc.Builder
8+import Text.Pandoc.Arbitrary ()
9+import Text.Pandoc.Walk
8import Test.Tasty
10import Test.Tasty
9import Test.Tasty.HUnit
11import Test.Tasty.HUnit
12+import Test.Tasty.QuickCheck
10import Codec.Archive.Zip
13import Codec.Archive.Zip
14+import Text.XML.Light
11−import Data.List (isPrefixOf, isSuffixOf)
15+import Data.List (isPrefixOf, isSuffixOf, sort)
16+import Data.Maybe (mapMaybe)
17+
18+getPptxArchive :: WriterOptions -> Pandoc -> IO Archive
19+getPptxArchive opts pd = do
20+ mbs <- runIO $
21+ do setUserDataDir $ Just "../data"
22+ writePowerpoint opts pd
23+ case mbs of
24+ Left e -> throwIO e
25+ Right bs -> return $ toArchive bs
12
26
13----- Number of Slides -----------
27----- Number of Slides -----------
14
28
15numberOfSlides :: WriterOptions -> Pandoc -> IO Int
29numberOfSlides :: WriterOptions -> Pandoc -> IO Int
16numberOfSlides opts pd = do
30numberOfSlides opts pd = do
17− mbs <- runIO $
31+ archive <- getPptxArchive opts pd
18− do setUserDataDir $ Just "../data"
19− writePowerpoint opts pd
20− case mbs of
21− Left e -> throwIO e
22− Right bs -> do
23− let archive = toArchive bs
24− return $
32+ return $
25− length $
33+ length $
26− filter (isSuffixOf ".xml") $
34+ filter (isSuffixOf ".xml") $
27− filter (isPrefixOf "ppt/slides/slide") $
35+ filter (isPrefixOf "ppt/slides/slide") $
28− filesInArchive archive
36+ filesInArchive archive
29
37
30testNumberOfSlides :: TestName -> Int -> WriterOptions -> Pandoc -> TestTree
38testNumberOfSlides :: TestName -> Int -> WriterOptions -> Pandoc -> TestTree
31testNumberOfSlides name n opts pd =
39testNumberOfSlides name n opts pd =
@@ -101,6 +109,61 @@ numSlideTests = testGroup "Number of slides in output"
101 para $ text "Foo" <> note (para "note text"))
109 para $ text "Foo" <> note (para "note text"))
102 ]
110 ]
103
111
112+----- Content Types -----------
113+
114+
115+contentTypesFileExists :: WriterOptions -> Pandoc -> TestTree
116+contentTypesFileExists opts pd =
117+ testCase "Existence of [Content_Types].xml file" $
118+ do archive <- getPptxArchive opts pd
119+ assertBool "Missing [Content_Types].xml file" $
120+ "[Content_Types].xml" `elem` (filesInArchive archive)
121+
122+
123+
124+-- We want an "Override" entry for each xml file under ppt/.
125+prop_ContentOverrides :: Pandoc -> IO Bool
126+prop_ContentOverrides pd = do
127+ -- remove Math to avoid warnings
128+ let go :: Inline -> Inline
129+ go (Math _ _) = Str "Math"
130+ go i = i
131+ pd' = walk go pd
132+ archive <- getPptxArchive def pd'
133+ let xmlFiles = filter ("[Content_Types].xml" /=) $
134+ filter (isSuffixOf ".xml") $
135+ filesInArchive archive
136+ contentTypes <- case findEntryByPath "[Content_Types].xml" archive of
137+ Just ent -> return $ fromEntry ent
138+ Nothing -> throwIO $
139+ PandocSomeError "Missing [Content_Types].xml file"
140+ typesElem <- case parseXMLDoc contentTypes of
141+ Just element -> return $ element
142+ Nothing -> throwIO $
143+ PandocSomeError "[Content_Types].xml cannot be parsed"
144+ let ns = findAttr (QName "xmlns" Nothing Nothing) typesElem
145+ overrides = findChildren (QName "Override" ns Nothing) typesElem
146+ partNames = mapMaybe (findAttr (QName "PartName" Nothing Nothing)) overrides
147+ -- files in content_types are absolute
148+ absXmlFiles = map (\fp -> case fp of
149+ ('/':_) -> fp
150+ _ -> '/': fp
151+ )
152+ xmlFiles
153+ return $ sort absXmlFiles == sort partNames
154+
155+contentOverridesTests :: TestTree
156+contentOverridesTests = localOption (QuickCheckTests 20) $
157+ testProperty "Content Overrides for each XML file" $
158+ \x -> ioProperty $ prop_ContentOverrides (x :: Pandoc)
159+
160+contentTypeTests :: TestTree
161+contentTypeTests = testGroup "[Content_Types].xml file"
162+ [ contentTypesFileExists def (doc $ para "foo")
163+ , contentOverridesTests
164+ ]
104
165
105tests :: [TestTree]
166tests :: [TestTree]
106−tests = [numSlideTests]
167+tests = [ numSlideTests
168+ , contentTypeTests
169+ ]