git.iko.soy/typeable/pandoc
on master help sign in
Powerpoint tests: Convert to golden tests
0e48c21Jesse Rosenthal
test/Tests/Writers/Powerpoint.hs+147−136
compare with master
unifiedsplit
@@ -4,55 +4,18 @@
4
4
5module Tests.Writers.Powerpoint (tests) where
5module Tests.Writers.Powerpoint (tests) where
6
6
7−-- import Control.Exception (throwIO)
8import Text.Pandoc
7import Text.Pandoc
9import Test.Tasty
8import Test.Tasty
10−import Test.Tasty.HUnit
9+import Test.Tasty.Golden.Advanced
11import Codec.Archive.Zip
10import Codec.Archive.Zip
12import Text.XML.Light
11import Text.XML.Light
12+import qualified Data.ByteString as BS
13import qualified Data.ByteString.Lazy as BL
13import qualified Data.ByteString.Lazy as BL
14import qualified Data.Text.IO as T
14import qualified Data.Text.IO as T
15−import Data.List (isPrefixOf, isSuffixOf, sort, (\\), intercalate)
15+import Data.List (isPrefixOf, isSuffixOf, sort, (\\), intercalate, union)
16−import Data.Maybe (fromJust, isNothing)
16+import Data.Maybe (catMaybes, mapMaybe)
17import Tests.Helpers
17import Tests.Helpers
18import Data.Algorithm.Diff
18import Data.Algorithm.Diff
19−import Control.Monad (when)
20−
21−
22−getPptxBytes :: WriterOptions
23− -> FilePath
24− -> FilePath
25− -> IO (BL.ByteString, BL.ByteString)
26−getPptxBytes opts nativeFp pptxFp = do
27− ntvTxt <- T.readFile nativeFp
28− ntv <- runIOorExplode $ readNative def ntvTxt
29− myPptxBs <- runIOorExplode $ writePowerpoint opts ntv
30− goodPptxBs <- BL.readFile pptxFp
31− return (myPptxBs, goodPptxBs)
32−
33−
34−assertSameFileList :: Archive -> Archive -> FilePath -> Assertion
35−assertSameFileList myArch goodArch pptxFp = do
36− let filesMy = filesInArchive myArch
37− filesGood = filesInArchive goodArch
38− diffMyGood = filesMy \\ filesGood
39− diffGoodMy = filesGood \\ filesMy
40− if | null diffMyGood && null diffGoodMy -> return ()
41− | null diffMyGood ->
42− assertFailure $
43− "Files in " ++ pptxFp ++ " but not in generated archive:\n" ++
44− intercalate ", " diffGoodMy
45− | null diffGoodMy ->
46− assertFailure $
47− "Files in generated archive but not in " ++ pptxFp ++ ":\n" ++
48− intercalate ", " diffMyGood
49− | otherwise ->
50− assertFailure $
51− "Files in " ++ pptxFp ++ " but not in generated archive:\n" ++
52− intercalate ", " diffGoodMy ++
53− "\n" ++
54− "Files in generated archive but not in " ++ pptxFp ++ ":\n" ++
55− intercalate ", " diffMyGood
56
19
57compareXMLBool :: Content -> Content -> Bool
20compareXMLBool :: Content -> Content -> Bool
58-- We make a special exception for times at the moment, and just pass
21-- We make a special exception for times at the moment, and just pass
@@ -86,111 +49,159 @@ displayDiff :: Content -> Content -> String
86displayDiff elemA elemB =
49displayDiff elemA elemB =
87 showDiff (1,1) $ getDiff (lines $ ppContent elemA) (lines $ ppContent elemB)
50 showDiff (1,1) $ getDiff (lines $ ppContent elemA) (lines $ ppContent elemB)
88
51
52+goldenArchive :: FilePath -> IO Archive
53+goldenArchive fp = (toArchive . BL.fromStrict) <$> BS.readFile fp
54+
55+testArchive :: WriterOptions -> FilePath -> IO Archive
56+testArchive opts fp = do
57+ txt <- T.readFile fp
58+ bs <- runIOorExplode $ readNative def txt >>= writePowerpoint opts
59+ return $ toArchive bs
60+
61+updateGoldenFile :: WriterOptions -> FilePath -> FilePath -> IO ()
62+updateGoldenFile opts nativeFP goldenFP = do
63+ txt <- T.readFile nativeFP
64+ bs <- runIOorExplode $ readNative def txt >>= writePowerpoint opts
65+ BL.writeFile goldenFP bs
66+
67+compareFileList :: FilePath -> Archive -> Archive -> Maybe String
68+compareFileList goldenFP goldenArch testArch =
69+ let testFiles = filesInArchive testArch
70+ goldenFiles = filesInArchive goldenArch
71+ diffTestGolden = testFiles \\ goldenFiles
72+ diffGoldenTest = goldenFiles \\ testFiles
73+
74+ results =
75+ [ if null diffGoldenTest
76+ then Nothing
77+ else Just $
78+ "Files in " ++ goldenFP ++ " but not in generated archive:\n" ++
79+ intercalate ", " diffGoldenTest
80+ , if null diffTestGolden
81+ then Nothing
82+ else Just $
83+ "Files in generated archive but not in " ++ goldenFP ++ ":\n" ++
84+ intercalate ", " diffTestGolden
85+ ]
86+ in
87+ if null $ catMaybes results
88+ then Nothing
89+ else Just $ intercalate "\n" $ catMaybes results
90+
89−compareXMLFile :: FilePath -> Archive -> Archive -> Assertion
91+compareXMLFile' :: FilePath -> Archive -> Archive -> Either String ()
90−compareXMLFile fp myArch goodArch = do
92+compareXMLFile' fp goldenArch testArch = do
91− let mbMyEntry = findEntryByPath fp myArch
93+ testEntry <- case findEntryByPath fp testArch of
92− when (isNothing mbMyEntry)
94+ Just entry -> Right entry
93− (assertFailure $
95+ Nothing -> Left $
94− "Can't extract " ++ fp ++ " from generated archive")
96+ "Can't extract " ++ fp ++ " from generated archive"
95− let mbMyXMLDoc = parseXMLDoc $ fromEntry $ fromJust mbMyEntry
97+ testXMLDoc <- case parseXMLDoc $ fromEntry testEntry of
96− when (isNothing mbMyXMLDoc)
98+ Just doc -> Right doc
97− (assertFailure $
99+ Nothing -> Left $
98− "Can't parse xml in " ++ fp ++ " from generated archive")
100+ "Can't parse xml in " ++ fp ++ " from generated archive"
99− let myContent = Elem $ fromJust mbMyXMLDoc
101+
100−
102+ goldenEntry <- case findEntryByPath fp goldenArch of
101− let mbGoodEntry = findEntryByPath fp goodArch
103+ Just entry -> Right entry
102− when (isNothing mbGoodEntry)
104+ Nothing -> Left $
103− (assertFailure $
104− "Can't extract " ++ fp ++ " from archive in stored pptx file")
105+ "Can't extract " ++ fp ++ " from archive in stored pptx file"
105− let mbGoodXMLDoc = parseXMLDoc $ fromEntry $ fromJust mbGoodEntry
106+ goldenXMLDoc <- case parseXMLDoc $ fromEntry goldenEntry of
106− when (isNothing mbGoodXMLDoc)
107+ Just doc -> Right doc
107− (assertFailure $
108+ Nothing -> Left $
108− "Can't parse xml in " ++ fp ++ " from archive in stored pptx file")
109+ "Can't parse xml in " ++ fp ++ " from archive in stored pptx file"
109− let goodContent = Elem $ fromJust mbGoodXMLDoc
110+
110−
111+ let testContent = Elem $ testXMLDoc
111− assertBool
112+ goldenContent = Elem $ goldenXMLDoc
112− ("Non-matching xml in " ++ fp ++ ":\n" ++ displayDiff myContent goodContent)
113+
113− (compareXMLBool myContent goodContent)
114+ if (compareXMLBool goldenContent testContent)
114−
115+ then Right ()
115−compareBinaryFile :: FilePath -> Archive -> Archive -> Assertion
116+ else Left $
116−compareBinaryFile fp myArch goodArch = do
117+ "Non-matching xml in " ++ fp ++ ":\n" ++ displayDiff testContent goldenContent
117− let mbMyEntry = findEntryByPath fp myArch
118+
118− when (isNothing mbMyEntry)
119+compareXMLFile :: FilePath -> Archive -> Archive -> Maybe String
119− (assertFailure $
120+compareXMLFile fp goldenArch testArch =
120− "Can't extract " ++ fp ++ " from generated archive")
121+ case compareXMLFile' fp goldenArch testArch of
121− let myBytes = fromEntry $ fromJust mbMyEntry
122+ Right _ -> Nothing
122−
123+ Left s -> Just s
123− let mbGoodEntry = findEntryByPath fp goodArch
124+
124− when (isNothing mbGoodEntry)
125+compareAllXMLFiles :: Archive -> Archive -> Maybe String
125− (assertFailure $
126+compareAllXMLFiles goldenArch testArch =
126− "Can't extract " ++ fp ++ " from archive in stored pptx file")
127+ let allFiles = filesInArchive goldenArch `union` filesInArchive testArch
127− let goodBytes = fromEntry $ fromJust mbGoodEntry
128+ allXMLFiles = sort $
128−
129+ filter
129− assertBool (fp ++ " doesn't match") (myBytes == goodBytes)
130−
131−testSameFileList :: WriterOptions -> FilePath -> FilePath -> TestTree
132−testSameFileList opts myFp goodFp =
133− testCase ("Identical file list in archives") $ do
134− (myBS, goodBS) <- getPptxBytes opts myFp goodFp
135− let myArch = toArchive myBS
136− goodArch = toArchive goodBS
137− (assertSameFileList myArch goodArch goodFp)
138−
139−testSameXML :: WriterOptions -> FilePath -> FilePath -> TestTree
140−testSameXML opts myFp goodFp = testCaseSteps "Comparing extracted xml files" $
141− \step -> do
142− (myBS, goodBS) <- getPptxBytes opts myFp goodFp
143− let myArch = toArchive myBS
144− goodArch = toArchive goodBS
145−
146− let xmlFileList = sort $
147− filter (\fp -> ".xml" `isSuffixOf` fp || ".rels" `isSuffixOf` fp)
130+ (\fp -> ".xml" `isSuffixOf` fp || ".rels" `isSuffixOf` fp)
148− (filesInArchive myArch)
131+ allFiles
149− mapM_
132+ results =
150− (\fp -> step ("- " ++ fp) >> compareXMLFile fp myArch goodArch)
133+ mapMaybe (\fp -> compareXMLFile fp goldenArch testArch) allXMLFiles
151− xmlFileList
134+ in
152−
135+ if null results
153−testSameMedia :: WriterOptions -> FilePath -> FilePath -> TestTree
136+ then Nothing
154−testSameMedia opts myFp goodFp = testCaseSteps "Comparing media files" $
137+ else Just $ unlines results
155− \step -> do
138+
156− (myBS, goodBS) <- getPptxBytes opts myFp goodFp
139+compareMediaFile' :: FilePath -> Archive -> Archive -> Either String ()
157− let myArch = toArchive myBS
140+compareMediaFile' fp goldenArch testArch = do
158− goodArch = toArchive goodBS
141+ testEntry <- case findEntryByPath fp testArch of
159−
142+ Just entry -> Right entry
160− let mediaFileList = sort $
143+ Nothing -> Left $
144+ "Can't extract " ++ fp ++ " from generated archive"
145+ goldenEntry <- case findEntryByPath fp goldenArch of
146+ Just entry -> Right entry
147+ Nothing -> Left $
148+ "Can't extract " ++ fp ++ " from archive in stored pptx file"
149+
150+ if (fromEntry testEntry == fromEntry goldenEntry)
151+ then Right ()
152+ else Left $
153+ "Non-matching binary file: " ++ fp
154+
155+compareMediaFile :: FilePath -> Archive -> Archive -> Maybe String
156+compareMediaFile fp goldenArch testArch =
157+ case compareMediaFile' fp goldenArch testArch of
158+ Right _ -> Nothing
159+ Left s -> Just s
160+
161+compareAllMediaFiles :: Archive -> Archive -> Maybe String
162+compareAllMediaFiles goldenArch testArch =
163+ let allFiles = filesInArchive goldenArch `union` filesInArchive testArch
164+ allMediaFiles = sort $
165+ filter
161− filter (\fp -> "ppt/media/" `isPrefixOf` fp)
166+ (\fp -> "/ppt/media/" `isPrefixOf` fp)
162− (filesInArchive myArch)
167+ allFiles
163−
168+ results =
164− mapM_
169+ mapMaybe (\fp -> compareMediaFile fp goldenArch testArch) allMediaFiles
165− (\fp -> step ("- " ++ fp) >> compareBinaryFile fp myArch goodArch)
170+ in
166− mediaFileList
171+ if null results
167−
172+ then Nothing
173+ else Just $ unlines results
174+
168−testCompareWithOpts :: String -> WriterOptions ->FilePath -> FilePath -> TestTree
175+pptxTest :: String -> WriterOptions -> FilePath -> FilePath -> TestTree
169−testCompareWithOpts testName opts nativeFp pptxFp =
176+pptxTest testName opts nativeFP goldenFP =
170− testGroup testName [ testSameFileList opts nativeFp pptxFp
177+ goldenTest
171− , testSameXML opts nativeFp pptxFp
178+ testName
172− , testSameMedia opts nativeFp pptxFp
179+ (goldenArchive goldenFP)
180+ (testArchive opts nativeFP)
181+ (\goldenArch testArch ->
182+ let res = catMaybes [ compareFileList goldenFP goldenArch testArch
183+ , compareAllXMLFiles goldenArch testArch
184+ , compareAllMediaFiles goldenArch testArch
173− ]
185+ ]
174−
186+ in return $ if null res then Nothing else Just $ unlines res)
175−
187+ (\_ -> updateGoldenFile opts nativeFP goldenFP)
176−testCompare :: String -> FilePath -> FilePath -> TestTree
177−testCompare testName nativeFp pptxFp =
178− testCompareWithOpts testName def nativeFp pptxFp
179
188
180--------------------------------------------------------------
189--------------------------------------------------------------
181
190
182tests :: [TestTree]
191tests :: [TestTree]
183−tests = [ testCompare
192+tests = [ pptxTest
184 "Inline formatting"
193 "Inline formatting"
194+ def
185 "pptx/inline_formatting.native"
195 "pptx/inline_formatting.native"
186 "pptx/inline_formatting.pptx"
196 "pptx/inline_formatting.pptx"
187− , testCompare
197+ , pptxTest
188− "slide breaks (default slide-level)"
198+ "Slide breaks (default slide-level)"
199+ def
189 "pptx/slide_breaks.native"
200 "pptx/slide_breaks.native"
190 "pptx/slide_breaks.pptx"
201 "pptx/slide_breaks.pptx"
191− , testCompareWithOpts
202+ , pptxTest
192 "slide breaks (slide-level set to 1)"
203 "slide breaks (slide-level set to 1)"
193− def{writerSlideLevel=Just 1}
204+ def{ writerSlideLevel = Just 1 }
194 "pptx/slide_breaks.native"
205 "pptx/slide_breaks.native"
195 "pptx/slide_breaks_slide_level_1.pptx"
206 "pptx/slide_breaks_slide_level_1.pptx"
196 ]
207 ]