git.iko.soy/typeable/pandoc
on master help sign in
Tests: Abstract powerpoint tests out to OOXML tests.
61f80e7Jesse Rosenthal
pandoc.cabal+3−1
compare with master
unifiedsplit
@@ -618,7 +618,8 @@ test-suite test-pandoc
618 containers >= 0.4.2.1 && < 0.6,
618 containers >= 0.4.2.1 && < 0.6,
619 executable-path >= 0.0 && < 0.1,
619 executable-path >= 0.0 && < 0.1,
620 zip-archive >= 0.2.3.4 && < 0.4,
620 zip-archive >= 0.2.3.4 && < 0.4,
621− xml >= 1.3.12 && < 1.4
621+ xml >= 1.3.12 && < 1.4,
622+ Glob >= 0.7 && < 0.10
622 if flag(old-locale)
623 if flag(old-locale)
623 build-depends: old-locale >= 1 && < 1.1,
624 build-depends: old-locale >= 1 && < 1.1,
624 time >= 1.2 && < 1.5
625 time >= 1.2 && < 1.5
@@ -669,6 +670,7 @@ test-suite test-pandoc
669 Tests.Writers.Muse
670 Tests.Writers.Muse
670 Tests.Writers.FB2
671 Tests.Writers.FB2
671 Tests.Writers.Powerpoint
672 Tests.Writers.Powerpoint
673+ Tests.Writers.OOXML
672 ghc-options: -rtsopts -Wall -fno-warn-unused-do-bind -threaded
674 ghc-options: -rtsopts -Wall -fno-warn-unused-do-bind -threaded
673 default-language: Haskell98
675 default-language: Haskell98
674
676
test/Tests/Writers/OOXML.hsnew file+186
@@ -0,0 +1,186 @@
1+{-# LANGUAGE PatternGuards #-}
2+{-# LANGUAGE OverloadedStrings #-}
3+
4+module Tests.Writers.OOXML (ooxmlTest) where
5+
6+import Text.Pandoc
7+import Test.Tasty
8+import Test.Tasty.Golden.Advanced
9+import Codec.Archive.Zip
10+import Text.XML.Light
11+import qualified Data.ByteString as BS
12+import qualified Data.ByteString.Lazy as BL
13+import qualified Data.Text.IO as T
14+import Data.List (isSuffixOf, sort, (\\), intercalate, union)
15+import Data.Maybe (catMaybes, mapMaybe)
16+import Tests.Helpers
17+import Data.Algorithm.Diff
18+import System.FilePath.Glob (compile, match)
19+
20+compareXMLBool :: Content -> Content -> Bool
21+-- We make a special exception for times at the moment, and just pass
22+-- them because we can't control the utctime when running IO. Besides,
23+-- so long as we have two times, we're okay.
24+compareXMLBool (Elem myElem) (Elem goodElem)
25+ | (QName "created" _ (Just "dcterms")) <- elName myElem
26+ , (QName "created" _ (Just "dcterms")) <- elName goodElem =
27+ True
28+compareXMLBool (Elem myElem) (Elem goodElem)
29+ | (QName "modified" _ (Just "dcterms")) <- elName myElem
30+ , (QName "modified" _ (Just "dcterms")) <- elName goodElem =
31+ True
32+compareXMLBool (Elem myElem) (Elem goodElem) =
33+ elName myElem == elName goodElem &&
34+ elAttribs myElem == elAttribs goodElem &&
35+ and (zipWith compareXMLBool (elContent myElem) (elContent goodElem))
36+
37+compareXMLBool (Text myCData) (Text goodCData) =
38+ cdVerbatim myCData == cdVerbatim goodCData &&
39+ cdData myCData == cdData goodCData &&
40+ cdLine myCData == cdLine goodCData
41+
42+compareXMLBool (CRef myStr) (CRef goodStr) =
43+ myStr == goodStr
44+compareXMLBool _ _ = False
45+
46+displayDiff :: Content -> Content -> String
47+displayDiff elemA elemB =
48+ showDiff (1,1) $ getDiff (lines $ ppContent elemA) (lines $ ppContent elemB)
49+
50+goldenArchive :: FilePath -> IO Archive
51+goldenArchive fp = (toArchive . BL.fromStrict) <$> BS.readFile fp
52+
53+testArchive :: (WriterOptions -> Pandoc -> PandocIO BL.ByteString)
54+ -> WriterOptions
55+ -> FilePath
56+ -> IO Archive
57+testArchive writerFn opts fp = do
58+ txt <- T.readFile fp
59+ bs <- runIOorExplode $ readNative def txt >>= writerFn opts
60+ return $ toArchive bs
61+
62+compareFileList :: FilePath -> Archive -> Archive -> Maybe String
63+compareFileList goldenFP goldenArch testArch =
64+ let testFiles = filesInArchive testArch
65+ goldenFiles = filesInArchive goldenArch
66+ diffTestGolden = testFiles \\ goldenFiles
67+ diffGoldenTest = goldenFiles \\ testFiles
68+
69+ results =
70+ [ if null diffGoldenTest
71+ then Nothing
72+ else Just $
73+ "Files in " ++ goldenFP ++ " but not in generated archive:\n" ++
74+ intercalate ", " diffGoldenTest
75+ , if null diffTestGolden
76+ then Nothing
77+ else Just $
78+ "Files in generated archive but not in " ++ goldenFP ++ ":\n" ++
79+ intercalate ", " diffTestGolden
80+ ]
81+ in
82+ if null $ catMaybes results
83+ then Nothing
84+ else Just $ intercalate "\n" $ catMaybes results
85+
86+compareXMLFile' :: FilePath -> Archive -> Archive -> Either String ()
87+compareXMLFile' fp goldenArch testArch = do
88+ testEntry <- case findEntryByPath fp testArch of
89+ Just entry -> Right entry
90+ Nothing -> Left $
91+ "Can't extract " ++ fp ++ " from generated archive"
92+ testXMLDoc <- case parseXMLDoc $ fromEntry testEntry of
93+ Just doc -> Right doc
94+ Nothing -> Left $
95+ "Can't parse xml in " ++ fp ++ " from generated archive"
96+
97+ goldenEntry <- case findEntryByPath fp goldenArch of
98+ Just entry -> Right entry
99+ Nothing -> Left $
100+ "Can't extract " ++ fp ++ " from archive in stored file"
101+ goldenXMLDoc <- case parseXMLDoc $ fromEntry goldenEntry of
102+ Just doc -> Right doc
103+ Nothing -> Left $
104+ "Can't parse xml in " ++ fp ++ " from archive in stored file"
105+
106+ let testContent = Elem testXMLDoc
107+ goldenContent = Elem goldenXMLDoc
108+
109+ if compareXMLBool goldenContent testContent
110+ then Right ()
111+ else Left $
112+ "Non-matching xml in " ++ fp ++ ":\n" ++ displayDiff testContent goldenContent
113+
114+compareXMLFile :: FilePath -> Archive -> Archive -> Maybe String
115+compareXMLFile fp goldenArch testArch =
116+ case compareXMLFile' fp goldenArch testArch of
117+ Right _ -> Nothing
118+ Left s -> Just s
119+
120+compareAllXMLFiles :: Archive -> Archive -> Maybe String
121+compareAllXMLFiles goldenArch testArch =
122+ let allFiles = filesInArchive goldenArch `union` filesInArchive testArch
123+ allXMLFiles = sort $
124+ filter
125+ (\fp -> ".xml" `isSuffixOf` fp || ".rels" `isSuffixOf` fp)
126+ allFiles
127+ results =
128+ mapMaybe (\fp -> compareXMLFile fp goldenArch testArch) allXMLFiles
129+ in
130+ if null results
131+ then Nothing
132+ else Just $ unlines results
133+
134+compareMediaFile' :: FilePath -> Archive -> Archive -> Either String ()
135+compareMediaFile' fp goldenArch testArch = do
136+ testEntry <- case findEntryByPath fp testArch of
137+ Just entry -> Right entry
138+ Nothing -> Left $
139+ "Can't extract " ++ fp ++ " from generated archive"
140+ goldenEntry <- case findEntryByPath fp goldenArch of
141+ Just entry -> Right entry
142+ Nothing -> Left $
143+ "Can't extract " ++ fp ++ " from archive in stored file"
144+
145+ if fromEntry testEntry == fromEntry goldenEntry
146+ then Right ()
147+ else Left $
148+ "Non-matching binary file: " ++ fp
149+
150+compareMediaFile :: FilePath -> Archive -> Archive -> Maybe String
151+compareMediaFile fp goldenArch testArch =
152+ case compareMediaFile' fp goldenArch testArch of
153+ Right _ -> Nothing
154+ Left s -> Just s
155+
156+compareAllMediaFiles :: Archive -> Archive -> Maybe String
157+compareAllMediaFiles goldenArch testArch =
158+ let allFiles = filesInArchive goldenArch `union` filesInArchive testArch
159+ mediaPattern = compile "*/media/*"
160+ allMediaFiles = sort $
161+ filter (match mediaPattern) allFiles
162+ results =
163+ mapMaybe (\fp -> compareMediaFile fp goldenArch testArch) allMediaFiles
164+ in
165+ if null results
166+ then Nothing
167+ else Just $ unlines results
168+
169+ooxmlTest :: (WriterOptions -> Pandoc -> PandocIO BL.ByteString)
170+ -> String
171+ -> WriterOptions
172+ -> FilePath
173+ -> FilePath
174+ -> TestTree
175+ooxmlTest writerFn testName opts nativeFP goldenFP =
176+ goldenTest
177+ testName
178+ (goldenArchive goldenFP)
179+ (testArchive writerFn opts nativeFP)
180+ (\goldenArch testArch ->
181+ let res = catMaybes [ compareFileList goldenFP goldenArch testArch
182+ , compareAllXMLFiles goldenArch testArch
183+ , compareAllMediaFiles goldenArch testArch
184+ ]
185+ in return $ if null res then Nothing else Just $ unlines res)
186+ (\a -> BL.writeFile goldenFP $ fromArchive a)
test/Tests/Writers/Powerpoint.hs+2−175
@@ -1,184 +1,11 @@
1−{-# LANGUAGE PatternGuards #-}
2−{-# LANGUAGE OverloadedStrings #-}
3−{-# LANGUAGE MultiWayIf #-}
4−
5module Tests.Writers.Powerpoint (tests) where
1module Tests.Writers.Powerpoint (tests) where
6
2
3+import Tests.Writers.OOXML (ooxmlTest)
7import Text.Pandoc
4import Text.Pandoc
8import Test.Tasty
5import Test.Tasty
9−import Test.Tasty.Golden.Advanced
10−import Codec.Archive.Zip
11−import Text.XML.Light
12−import qualified Data.ByteString as BS
13−import qualified Data.ByteString.Lazy as BL
14−import qualified Data.Text.IO as T
15−import Data.List (isPrefixOf, isSuffixOf, sort, (\\), intercalate, union)
16−import Data.Maybe (catMaybes, mapMaybe)
17−import Tests.Helpers
18−import Data.Algorithm.Diff
19−
20−compareXMLBool :: Content -> Content -> Bool
21−-- We make a special exception for times at the moment, and just pass
22−-- them because we can't control the utctime when running IO. Besides,
23−-- so long as we have two times, we're okay.
24−compareXMLBool (Elem myElem) (Elem goodElem)
25− | (QName "created" _ (Just "dcterms")) <- elName myElem
26− , (QName "created" _ (Just "dcterms")) <- elName goodElem =
27− True
28−compareXMLBool (Elem myElem) (Elem goodElem)
29− | (QName "modified" _ (Just "dcterms")) <- elName myElem
30− , (QName "modified" _ (Just "dcterms")) <- elName goodElem =
31− True
32−compareXMLBool (Elem myElem) (Elem goodElem) =
33− elName myElem == elName goodElem &&
34− elAttribs myElem == elAttribs goodElem &&
35− and (zipWith compareXMLBool (elContent myElem) (elContent goodElem))
36−
37−compareXMLBool (Text myCData) (Text goodCData) =
38− cdVerbatim myCData == cdVerbatim goodCData &&
39− cdData myCData == cdData goodCData &&
40− cdLine myCData == cdLine goodCData
41−
42−compareXMLBool (CRef myStr) (CRef goodStr) =
43− myStr == goodStr
44−compareXMLBool _ _ = False
45−
46−displayDiff :: Content -> Content -> String
47−displayDiff elemA elemB =
48− showDiff (1,1) $ getDiff (lines $ ppContent elemA) (lines $ ppContent elemB)
49−
50−goldenArchive :: FilePath -> IO Archive
51−goldenArchive fp = (toArchive . BL.fromStrict) <$> BS.readFile fp
52−
53−testArchive :: WriterOptions -> FilePath -> IO Archive
54−testArchive opts fp = do
55− txt <- T.readFile fp
56− bs <- runIOorExplode $ readNative def txt >>= writePowerpoint opts
57− return $ toArchive bs
58−
59−compareFileList :: FilePath -> Archive -> Archive -> Maybe String
60−compareFileList goldenFP goldenArch testArch =
61− let testFiles = filesInArchive testArch
62− goldenFiles = filesInArchive goldenArch
63− diffTestGolden = testFiles \\ goldenFiles
64− diffGoldenTest = goldenFiles \\ testFiles
65−
66− results =
67− [ if null diffGoldenTest
68− then Nothing
69− else Just $
70− "Files in " ++ goldenFP ++ " but not in generated archive:\n" ++
71− intercalate ", " diffGoldenTest
72− , if null diffTestGolden
73− then Nothing
74− else Just $
75− "Files in generated archive but not in " ++ goldenFP ++ ":\n" ++
76− intercalate ", " diffTestGolden
77− ]
78− in
79− if null $ catMaybes results
80− then Nothing
81− else Just $ intercalate "\n" $ catMaybes results
82−
83−compareXMLFile' :: FilePath -> Archive -> Archive -> Either String ()
84−compareXMLFile' fp goldenArch testArch = do
85− testEntry <- case findEntryByPath fp testArch of
86− Just entry -> Right entry
87− Nothing -> Left $
88− "Can't extract " ++ fp ++ " from generated archive"
89− testXMLDoc <- case parseXMLDoc $ fromEntry testEntry of
90− Just doc -> Right doc
91− Nothing -> Left $
92− "Can't parse xml in " ++ fp ++ " from generated archive"
93−
94− goldenEntry <- case findEntryByPath fp goldenArch of
95− Just entry -> Right entry
96− Nothing -> Left $
97− "Can't extract " ++ fp ++ " from archive in stored pptx file"
98− goldenXMLDoc <- case parseXMLDoc $ fromEntry goldenEntry of
99− Just doc -> Right doc
100− Nothing -> Left $
101− "Can't parse xml in " ++ fp ++ " from archive in stored pptx file"
102−
103− let testContent = Elem testXMLDoc
104− goldenContent = Elem goldenXMLDoc
105−
106− if compareXMLBool goldenContent testContent
107− then Right ()
108− else Left $
109− "Non-matching xml in " ++ fp ++ ":\n" ++ displayDiff testContent goldenContent
110−
111−compareXMLFile :: FilePath -> Archive -> Archive -> Maybe String
112−compareXMLFile fp goldenArch testArch =
113− case compareXMLFile' fp goldenArch testArch of
114− Right _ -> Nothing
115− Left s -> Just s
116−
117−compareAllXMLFiles :: Archive -> Archive -> Maybe String
118−compareAllXMLFiles goldenArch testArch =
119− let allFiles = filesInArchive goldenArch `union` filesInArchive testArch
120− allXMLFiles = sort $
121− filter
122− (\fp -> ".xml" `isSuffixOf` fp || ".rels" `isSuffixOf` fp)
123− allFiles
124− results =
125− mapMaybe (\fp -> compareXMLFile fp goldenArch testArch) allXMLFiles
126− in
127− if null results
128− then Nothing
129− else Just $ unlines results
130−
131−compareMediaFile' :: FilePath -> Archive -> Archive -> Either String ()
132−compareMediaFile' fp goldenArch testArch = do
133− testEntry <- case findEntryByPath fp testArch of
134− Just entry -> Right entry
135− Nothing -> Left $
136− "Can't extract " ++ fp ++ " from generated archive"
137− goldenEntry <- case findEntryByPath fp goldenArch of
138− Just entry -> Right entry
139− Nothing -> Left $
140− "Can't extract " ++ fp ++ " from archive in stored pptx file"
141−
142− if fromEntry testEntry == fromEntry goldenEntry
143− then Right ()
144− else Left $
145− "Non-matching binary file: " ++ fp
146−
147−compareMediaFile :: FilePath -> Archive -> Archive -> Maybe String
148−compareMediaFile fp goldenArch testArch =
149− case compareMediaFile' fp goldenArch testArch of
150− Right _ -> Nothing
151− Left s -> Just s
152−
153−compareAllMediaFiles :: Archive -> Archive -> Maybe String
154−compareAllMediaFiles goldenArch testArch =
155− let allFiles = filesInArchive goldenArch `union` filesInArchive testArch
156− allMediaFiles = sort $
157− filter
158− (\fp -> "/ppt/media/" `isPrefixOf` fp)
159− allFiles
160− results =
161− mapMaybe (\fp -> compareMediaFile fp goldenArch testArch) allMediaFiles
162− in
163− if null results
164− then Nothing
165− else Just $ unlines results
166
6
167pptxTest :: String -> WriterOptions -> FilePath -> FilePath -> TestTree
7pptxTest :: String -> WriterOptions -> FilePath -> FilePath -> TestTree
168−pptxTest testName opts nativeFP goldenFP =
8+pptxTest = ooxmlTest writePowerpoint
169− goldenTest
170− testName
171− (goldenArchive goldenFP)
172− (testArchive opts nativeFP)
173− (\goldenArch testArch ->
174− let res = catMaybes [ compareFileList goldenFP goldenArch testArch
175− , compareAllXMLFiles goldenArch testArch
176− , compareAllMediaFiles goldenArch testArch
177− ]
178− in return $ if null res then Nothing else Just $ unlines res)
179− (\a -> BL.writeFile goldenFP $ fromArchive a)
180−
181−--------------------------------------------------------------
182
9
183tests :: [TestTree]
10tests :: [TestTree]
184tests = [ pptxTest
11tests = [ pptxTest