git.iko.soy/typeable/pandoc
on 34412cf help sign in
typeable/pandoc/test/Tests/Old.hs
263 lines 12 kB history raw
1module Tests.Old (tests) where
3import Data.Algorithm.Diff
4import Prelude hiding (readFile)
5import System.Exit
6import System.FilePath (joinPath, splitDirectories, (<.>), (</>))
7import System.IO.Temp (withTempFile)
8import System.Process (runProcess, waitForProcess)
9import Test.Tasty (TestTree, testGroup)
10import Test.Tasty.Golden.Advanced (goldenTest)
11import Tests.Helpers hiding (test)
12import qualified Text.Pandoc.UTF8 as UTF8
14tests :: [TestTree]
15tests = [ testGroup "markdown"
16 [ testGroup "writer"
17 $ writerTests "markdown" ++ lhsWriterTests "markdown"
18 , testGroup "reader"
19 [ test "basic" ["-r", "markdown", "-w", "native", "-s"]
20 "testsuite.txt" "testsuite.native"
21 , test "tables" ["-r", "markdown", "-w", "native", "--columns=80"]
22 "tables.txt" "tables.native"
23 , test "pipe tables" ["-r", "markdown", "-w", "native", "--columns=80"]
24 "pipe-tables.txt" "pipe-tables.native"
25 , test "more" ["-r", "markdown", "-w", "native", "-s"]
26 "markdown-reader-more.txt" "markdown-reader-more.native"
27 , lhsReaderTest "markdown+lhs"
28 ]
29 , testGroup "citations"
30 [ test "citations" ["-r", "markdown", "-w", "native"]
31 "markdown-citations.txt" "markdown-citations.native"
32 ]
33 ]
34 , testGroup "rst"
35 [ testGroup "writer" (writerTests "rst" ++ lhsWriterTests "rst")
36 , testGroup "reader"
37 [ test "basic" ["-r", "rst+smart", "-w", "native",
38 "-s", "--columns=80"] "rst-reader.rst" "rst-reader.native"
39 , test "tables" ["-r", "rst", "-w", "native", "--columns=80"]
40 "tables.rst" "tables-rstsubset.native"
41 , lhsReaderTest "rst+lhs"
42 ]
43 ]
44 , testGroup "latex"
45 [ testGroup "writer" (writerTests "latex" ++ lhsWriterTests "latex")
46 , testGroup "reader"
47 [ test "basic" ["-r", "latex+raw_tex", "-w", "native", "-s"]
48 "latex-reader.latex" "latex-reader.native"
49 , lhsReaderTest "latex+lhs"
50 ]
51 ]
52 , testGroup "html"
53 [ testGroup "writer" (writerTests "html4" ++ writerTests "html5" ++
54 lhsWriterTests "html")
55 , test "reader" ["-r", "html", "-w", "native", "-s"]
56 "html-reader.html" "html-reader.native"
57 ]
58 , testGroup "s5"
59 [ s5WriterTest "basic" ["-s"] "s5"
60 , s5WriterTest "fancy" ["-s","-m","-i"] "s5"
61 , s5WriterTest "fragment" [] "html4"
62 , s5WriterTest "inserts" ["-s", "-H", "insert",
63 "-B", "insert", "-A", "insert", "-c", "main.css"] "html4"
64 ]
65 , testGroup "textile"
66 [ testGroup "writer" $ writerTests "textile"
67 , test "reader" ["-r", "textile", "-w", "native", "-s"]
68 "textile-reader.textile" "textile-reader.native"
69 ]
70 , testGroup "docbook"
71 [ testGroup "writer" $ writerTests "docbook4"
72 , test "reader" ["-r", "docbook", "-w", "native", "-s"]
73 "docbook-reader.docbook" "docbook-reader.native"
74 , test "reader" ["-r", "docbook", "-w", "native", "-s"]
75 "docbook-xref.docbook" "docbook-xref.native"
76 ]
77 , testGroup "docbook5"
78 [ testGroup "writer" $ writerTests "docbook5"
79 ]
80 , testGroup "native"
81 [ testGroup "writer" $ writerTests "native"
82 , test "reader" ["-r", "native", "-w", "native", "-s"]
83 "testsuite.native" "testsuite.native"
84 ]
85 , testGroup "fb2"
86 [ fb2WriterTest "basic" [] "fb2/basic.markdown" "fb2/basic.fb2"
87 , fb2WriterTest "titles" [] "fb2/titles.markdown" "fb2/titles.fb2"
88 , fb2WriterTest "images" [] "fb2/images.markdown" "fb2/images.fb2"
89 , fb2WriterTest "images-embedded" [] "fb2/images-embedded.html" "fb2/images-embedded.fb2"
90 , fb2WriterTest "math" [] "fb2/math.markdown" "fb2/math.fb2"
91 , fb2WriterTest "tables" [] "tables.native" "tables.fb2"
92 , fb2WriterTest "testsuite" [] "testsuite.native" "writer.fb2"
93 ]
94 , testGroup "mediawiki"
95 [ testGroup "writer" $ writerTests "mediawiki"
96 , test "reader" ["-r", "mediawiki", "-w", "native", "-s"]
97 "mediawiki-reader.wiki" "mediawiki-reader.native"
98 ]
99 , testGroup "dokuwiki"
100 [ testGroup "writer" $ writerTests "dokuwiki"
101 , test "inline_formatting" ["-r", "native", "-w", "dokuwiki", "-s"]
102 "dokuwiki_inline_formatting.native" "dokuwiki_inline_formatting.dokuwiki"
103 , test "multiblock table" ["-r", "native", "-w", "dokuwiki", "-s"]
104 "dokuwiki_multiblock_table.native" "dokuwiki_multiblock_table.dokuwiki"
105 , test "external images" ["-r", "native", "-w", "dokuwiki", "-s"]
106 "dokuwiki_external_images.native" "dokuwiki_external_images.dokuwiki"
107 ]
108 , testGroup "opml"
109 [ test "basic" ["-r", "native", "-w", "opml", "--columns=78", "-s"]
110 "testsuite.native" "writer.opml"
111 , test "reader" ["-r", "opml", "-w", "native", "-s"]
112 "opml-reader.opml" "opml-reader.native"
113 ]
114 , testGroup "haddock"
115 [ testGroup "writer" $ writerTests "haddock"
116 , test "reader" ["-r", "haddock", "-w", "native", "-s"]
117 "haddock-reader.haddock" "haddock-reader.native"
118 ]
119 , testGroup "txt2tags"
120 [ test "reader" ["-r", "t2t", "-w", "native", "-s"]
121 "txt2tags.t2t" "txt2tags.native" ]
122 , testGroup "epub" [
123 test "features" ["-r", "epub", "-w", "native"]
124 "epub/features.epub" "epub/features.native"
125 , test "wasteland" ["-r", "epub", "-w", "native"]
126 "epub/wasteland.epub" "epub/wasteland.native"
127 , test "formatting" ["-r", "epub", "-w", "native"]
128 "epub/formatting.epub" "epub/formatting.native"
129 ]
130 , testGroup "twiki"
131 [ test "reader" ["-r", "twiki", "-w", "native", "-s"]
132 "twiki-reader.twiki" "twiki-reader.native" ]
133 , testGroup "other writers" $ map (\f -> testGroup f $ writerTests f)
134 [ "opendocument" , "context" , "texinfo", "icml", "tei"
135 , "man" , "plain" , "rtf", "org", "asciidoc", "zimwiki"
136 ]
137 , testGroup "writers-lang-and-dir"
138 [ test "latex" ["-f", "native", "-t", "latex", "-s"]
139 "writers-lang-and-dir.native" "writers-lang-and-dir.latex"
140 , test "context" ["-f", "native", "-t", "context", "-s"]
141 "writers-lang-and-dir.native" "writers-lang-and-dir.context"
142 ]
143 , testGroup "muse"
144 [ testGroup "writer" $ writerTests "muse"
145 ]
146 ]
148-- makes sure file is fully closed after reading
149readFile' :: FilePath -> IO String
150readFile' f = do s <- UTF8.readFile f
151 return $! (length s `seq` s)
153lhsWriterTests :: String -> [TestTree]
154lhsWriterTests format
155 = [ t "lhs to normal" format
156 , t "lhs to lhs" (format ++ "+lhs")
157 ]
158 where
159 t n f = test n ["--wrap=preserve", "-r", "native", "-s", "-w", f]
160 "lhs-test.native" ("lhs-test" <.> f)
162lhsReaderTest :: String -> TestTree
163lhsReaderTest format =
164 test "lhs" ["-r", format, "-w", "native"]
165 ("lhs-test" <.> format) norm
166 where norm = if format == "markdown+lhs"
167 then "lhs-test-markdown.native"
168 else "lhs-test.native"
170writerTests :: String -> [TestTree]
171writerTests format
172 = [ test "basic" (opts ++ ["-s"]) "testsuite.native" ("writer" <.> format)
173 , test "tables" opts "tables.native" ("tables" <.> format)
174 ]
175 where
176 opts = ["-r", "native", "-w", format, "--columns=78",
177 "--variable", "pandoc-version="]
179s5WriterTest :: String -> [String] -> String -> TestTree
180s5WriterTest modifier opts format
181 = test (format ++ " writer (" ++ modifier ++ ")")
182 (["-r", "native", "-w", format] ++ opts)
183 "s5.native" ("s5-" ++ modifier <.> "html")
185fb2WriterTest :: String -> [String] -> String -> String -> TestTree
186fb2WriterTest title opts inputfile normfile =
187 testWithNormalize (ignoreBinary . formatXML)
188 title (["-t", "fb2"]++opts) inputfile normfile
189 where
190 formatXML xml = splitTags $ zip xml (drop 1 xml)
191 splitTags [] = []
192 splitTags [end] = fst end : snd end : []
193 splitTags (('>','<'):rest) = ">\n" ++ splitTags rest
194 splitTags ((c,_):rest) = c : splitTags rest
195 ignoreBinary = unlines . filter (not . startsWith "<binary ") . lines
196 startsWith tag str = all (uncurry (==)) $ zip tag str
198-- | Run a test without normalize function, return True if test passed.
199test :: String -- ^ Title of test
200 -> [String] -- ^ Options to pass to pandoc
201 -> String -- ^ Input filepath
202 -> FilePath -- ^ Norm (for test results) filepath
203 -> TestTree
204test = testWithNormalize id
206-- | Run a test with normalize function, return True if test passed.
207testWithNormalize :: (String -> String) -- ^ Normalize function for output
208 -> String -- ^ Title of test
209 -> [String] -- ^ Options to pass to pandoc
210 -> String -- ^ Input filepath
211 -> FilePath -- ^ Norm (for test results) filepath
212 -> TestTree
213testWithNormalize normalizer testname opts inp norm =
214 goldenTest testname getExpected getActual
215 (compareValues norm options) updateGolden
216 where getExpected = normalizer <$> readFile' norm
217 getActual =
218 withTempFile "." "pandoc-test" $ \outputPath hOut -> do
219 withTempFile "." "pandoc-test" $ \errorPath hErr -> do
220 pandocPath <- findPandoc
221 let mbDynlibDir = findDynlibDir (reverse $
222 splitDirectories pandocPath)
223 let dynlibEnv = case mbDynlibDir of
224 Nothing -> []
225 Just d -> [("DYLD_LIBRARY_PATH", d),
226 ("LD_LIBRARY_PATH", d)]
227 let env = dynlibEnv ++
228 [("TMP","."),("LANG","en_US.UTF-8"),("HOME", "./")]
229 ph <- runProcess pandocPath options Nothing
230 (Just env) Nothing (Just hOut) (Just hErr)
231 ec <- waitForProcess ph
232 if ec == ExitSuccess
233 then
234 -- filter \r so the tests will work on Windows machines
235 (filter (/='\r') . normalizer) <$> readFile' outputPath
236 else do
237 errcontents <- UTF8.readFile errorPath
238 fail $ "Pandoc failed with " ++ show ec ++
239 if null errcontents
240 then ""
241 else '\n':errcontents
242 updateGolden = UTF8.writeFile norm
243 options = ["--quiet", "--data-dir", ".." </> "data"] ++ [inp] ++ opts
245compareValues :: FilePath -> [String] -> String -> String -> IO (Maybe String)
246compareValues norm options expected actual = do
247 pandocPath <- findPandoc
248 let cmd = pandocPath ++ " " ++ unwords options
249 let dash = replicate 72 '-'
250 let diff = getDiff (lines actual) (lines expected)
251 if expected == actual
252 then return Nothing
253 else return $ Just $
254 '\n' : dash ++
255 "\n--- " ++ norm ++
256 "\n+++ " ++ cmd ++ "\n" ++
257 showDiff (1,1) diff ++ dash
259findDynlibDir :: [FilePath] -> Maybe FilePath
260findDynlibDir [] = Nothing
261findDynlibDir ("build":xs) = Just $ joinPath (reverse xs) </> "build"
262findDynlibDir (_:xs) = findDynlibDir xs