git.iko.soy/typeable/pandoc
on 4eff607 help sign in
typeable/pandoc/tests/Tests/Old.hs
281 lines 12 kB history raw
1module Tests.Old (tests) where
3import Test.Framework (testGroup, Test )
4import Test.Framework.Providers.HUnit
5import Test.HUnit ( assertBool )
6import System.Environment.Executable (getExecutablePath)
7import System.IO ( openTempFile, stderr )
8import System.Process ( runProcess, waitForProcess )
9import System.FilePath ( (</>), (<.>), takeDirectory, splitDirectories, joinPath )
10import System.Directory
11import System.Exit
12import Data.Algorithm.Diff
13import Text.Pandoc.Shared ( normalize )
14import Text.Pandoc.Options
15import Text.Pandoc.Writers.Native ( writeNative )
16import Text.Pandoc.Readers.Native ( readNative )
17import Prelude hiding ( readFile )
18import qualified Data.ByteString.Lazy as B
19import Text.Pandoc.UTF8 (toStringLazy)
20import Text.Printf
21import Text.Pandoc.Error
23readFileUTF8 :: FilePath -> IO String
24readFileUTF8 f = B.readFile f >>= return . toStringLazy
26data TestResult = TestPassed
27 | TestError ExitCode
28 | TestFailed String FilePath [Diff String]
29 deriving (Eq)
31instance Show TestResult where
32 show TestPassed = "PASSED"
33 show (TestError ec) = "ERROR " ++ show ec
34 show (TestFailed cmd file d) = '\n' : dash ++
35 "\n--- " ++ file ++
36 "\n+++ " ++ cmd ++ "\n" ++ showDiff (1,1) d ++
37 dash
38 where dash = replicate 72 '-'
40showDiff :: (Int,Int) -> [Diff String] -> String
41showDiff _ [] = ""
42showDiff (l,r) (First ln : ds) =
43 printf "+%4d " l ++ ln ++ "\n" ++ showDiff (l+1,r) ds
44showDiff (l,r) (Second ln : ds) =
45 printf "-%4d " r ++ ln ++ "\n" ++ showDiff (l,r+1) ds
46showDiff (l,r) (Both _ _ : ds) =
47 showDiff (l+1,r+1) ds
49tests :: [Test]
50tests = [ testGroup "markdown"
51 [ testGroup "writer"
52 $ writerTests "markdown" ++ lhsWriterTests "markdown"
53 , testGroup "reader"
54 [ test "basic" ["-r", "markdown", "-w", "native", "-s", "-S"]
55 "testsuite.txt" "testsuite.native"
56 , test "tables" ["-r", "markdown", "-w", "native", "--columns=80"]
57 "tables.txt" "tables.native"
58 , test "pipe tables" ["-r", "markdown", "-w", "native", "--columns=80"]
59 "pipe-tables.txt" "pipe-tables.native"
60 , test "more" ["-r", "markdown", "-w", "native", "-s", "-S"]
61 "markdown-reader-more.txt" "markdown-reader-more.native"
62 , lhsReaderTest "markdown+lhs"
63 ]
64 , testGroup "citations"
65 [ test "citations" ["-r", "markdown", "-w", "native"]
66 "markdown-citations.txt" "markdown-citations.native"
67 ]
68 ]
69 , testGroup "rst"
70 [ testGroup "writer" (writerTests "rst" ++ lhsWriterTests "rst")
71 , testGroup "reader"
72 [ test "basic" ["-r", "rst", "-w", "native",
73 "-s", "-S", "--columns=80"] "rst-reader.rst" "rst-reader.native"
74 , test "tables" ["-r", "rst", "-w", "native", "--columns=80"]
75 "tables.rst" "tables-rstsubset.native"
76 , lhsReaderTest "rst+lhs"
77 ]
78 ]
79 , testGroup "latex"
80 [ testGroup "writer" (writerTests "latex" ++ lhsWriterTests "latex")
81 , testGroup "reader"
82 [ test "basic" ["-r", "latex", "-w", "native", "-s", "-R"]
83 "latex-reader.latex" "latex-reader.native"
84 , lhsReaderTest "latex+lhs"
85 ]
86 ]
87 , testGroup "html"
88 [ testGroup "writer" (writerTests "html" ++ lhsWriterTests "html")
89 , test "reader" ["-r", "html", "-w", "native", "-s"]
90 "html-reader.html" "html-reader.native"
91 ]
92 , testGroup "s5"
93 [ s5WriterTest "basic" ["-s"] "s5"
94 , s5WriterTest "fancy" ["-s","-m","-i"] "s5"
95 , s5WriterTest "fragment" [] "html"
96 , s5WriterTest "inserts" ["-s", "-H", "insert",
97 "-B", "insert", "-A", "insert", "-c", "main.css"] "html"
98 ]
99 , testGroup "textile"
100 [ testGroup "writer" $ writerTests "textile"
101 , test "reader" ["-r", "textile", "-w", "native", "-s"]
102 "textile-reader.textile" "textile-reader.native"
103 ]
104 , testGroup "docbook"
105 [ testGroup "writer" $ writerTests "docbook"
106 , test "reader" ["-r", "docbook", "-w", "native", "-s"]
107 "docbook-reader.docbook" "docbook-reader.native"
108 , test "reader" ["-r", "docbook", "-w", "native", "-s"]
109 "docbook-xref.docbook" "docbook-xref.native"
110 ]
111 , testGroup "docbook5"
112 [ testGroup "writer" $ writerTests "docbook5"
113 ]
114 , testGroup "native"
115 [ testGroup "writer" $ writerTests "native"
116 , test "reader" ["-r", "native", "-w", "native", "-s"]
117 "testsuite.native" "testsuite.native"
118 ]
119 , testGroup "fb2"
120 [ fb2WriterTest "basic" [] "fb2/basic.markdown" "fb2/basic.fb2"
121 , fb2WriterTest "titles" [] "fb2/titles.markdown" "fb2/titles.fb2"
122 , fb2WriterTest "images" [] "fb2/images.markdown" "fb2/images.fb2"
123 , fb2WriterTest "images-embedded" [] "fb2/images-embedded.html" "fb2/images-embedded.fb2"
124 , fb2WriterTest "math" [] "fb2/math.markdown" "fb2/math.fb2"
125 , fb2WriterTest "tables" [] "tables.native" "tables.fb2"
126 , fb2WriterTest "testsuite" [] "testsuite.native" "writer.fb2"
127 ]
128 , testGroup "mediawiki"
129 [ testGroup "writer" $ writerTests "mediawiki"
130 , test "reader" ["-r", "mediawiki", "-w", "native", "-s"]
131 "mediawiki-reader.wiki" "mediawiki-reader.native"
132 ]
133 , testGroup "dokuwiki"
134 [ testGroup "writer" $ writerTests "dokuwiki"
135 , test "inline_formatting" ["-r", "native", "-w", "dokuwiki", "-s"]
136 "dokuwiki_inline_formatting.native" "dokuwiki_inline_formatting.dokuwiki"
137 , test "multiblock table" ["-r", "native", "-w", "dokuwiki", "-s"]
138 "dokuwiki_multiblock_table.native" "dokuwiki_multiblock_table.dokuwiki"
139 , test "external images" ["-r", "native", "-w", "dokuwiki", "-s"]
140 "dokuwiki_external_images.native" "dokuwiki_external_images.dokuwiki"
141 ]
142 , testGroup "opml"
143 [ test "basic" ["-r", "native", "-w", "opml", "--columns=78", "-s"]
144 "testsuite.native" "writer.opml"
145 , test "reader" ["-r", "opml", "-w", "native", "-s"]
146 "opml-reader.opml" "opml-reader.native"
147 ]
148 , testGroup "haddock"
149 [ testGroup "writer" $ writerTests "haddock"
150 , test "reader" ["-r", "haddock", "-w", "native", "-s"]
151 "haddock-reader.haddock" "haddock-reader.native"
152 ]
153 , testGroup "txt2tags"
154 [ test "reader" ["-r", "t2t", "-w", "native", "-s"]
155 "txt2tags.t2t" "txt2tags.native" ]
156 , testGroup "epub" [
157 test "features" ["-r", "epub", "-w", "native"]
158 "epub/features.epub" "epub/features.native"
159 , test "wasteland" ["-r", "epub", "-w", "native"]
160 "epub/wasteland.epub" "epub/wasteland.native"
161 , test "formatting" ["-r", "epub", "-w", "native"]
162 "epub/formatting.epub" "epub/formatting.native"
163 ]
164 , testGroup "twiki"
165 [ test "reader" ["-r", "twiki", "-w", "native", "-s"]
166 "twiki-reader.twiki" "twiki-reader.native" ]
167 , testGroup "other writers" $ map (\f -> testGroup f $ writerTests f)
168 [ "opendocument" , "context" , "texinfo", "icml", "tei"
169 , "man" , "plain" , "rtf", "org", "asciidoc", "zimwiki"
170 ]
171 , testGroup "writers-lang-and-dir"
172 [ test "latex" ["-f", "native", "-t", "latex", "-s"]
173 "writers-lang-and-dir.native" "writers-lang-and-dir.latex"
174 , test "context" ["-f", "native", "-t", "context", "-s"]
175 "writers-lang-and-dir.native" "writers-lang-and-dir.context"
176 ]
177 ]
179-- makes sure file is fully closed after reading
180readFile' :: FilePath -> IO String
181readFile' f = do s <- readFileUTF8 f
182 return $! (length s `seq` s)
184lhsWriterTests :: String -> [Test]
185lhsWriterTests format
186 = [ t "lhs to normal" format
187 , t "lhs to lhs" (format ++ "+lhs")
188 ]
189 where
190 t n f = test n ["--wrap=preserve", "-r", "native", "-s", "-w", f]
191 "lhs-test.native" ("lhs-test" <.> f)
193lhsReaderTest :: String -> Test
194lhsReaderTest format =
195 testWithNormalize normalizer "lhs" ["-r", format, "-w", "native"]
196 ("lhs-test" <.> format) norm
197 where normalizer = writeNative def . normalize . handleError . readNative
198 norm = if format == "markdown+lhs"
199 then "lhs-test-markdown.native"
200 else "lhs-test.native"
202writerTests :: String -> [Test]
203writerTests format
204 = [ test "basic" (opts ++ ["-s"]) "testsuite.native" ("writer" <.> format)
205 , test "tables" opts "tables.native" ("tables" <.> format)
206 ]
207 where
208 opts = ["-r", "native", "-w", format, "--columns=78",
209 "--variable", "pandoc-version="]
211s5WriterTest :: String -> [String] -> String -> Test
212s5WriterTest modifier opts format
213 = test (format ++ " writer (" ++ modifier ++ ")")
214 (["-r", "native", "-w", format] ++ opts)
215 "s5.native" ("s5-" ++ modifier <.> "html")
217fb2WriterTest :: String -> [String] -> String -> String -> Test
218fb2WriterTest title opts inputfile normfile =
219 testWithNormalize (ignoreBinary . formatXML)
220 title (["-t", "fb2"]++opts) inputfile normfile
221 where
222 formatXML xml = splitTags $ zip xml (drop 1 xml)
223 splitTags [] = []
224 splitTags [end] = fst end : snd end : []
225 splitTags (('>','<'):rest) = ">\n" ++ splitTags rest
226 splitTags ((c,_):rest) = c : splitTags rest
227 ignoreBinary = unlines . filter (not . startsWith "<binary ") . lines
228 startsWith tag str = all (uncurry (==)) $ zip tag str
230-- | Run a test without normalize function, return True if test passed.
231test :: String -- ^ Title of test
232 -> [String] -- ^ Options to pass to pandoc
233 -> String -- ^ Input filepath
234 -> FilePath -- ^ Norm (for test results) filepath
235 -> Test
236test = testWithNormalize id
238-- | Run a test with normalize function, return True if test passed.
239testWithNormalize :: (String -> String) -- ^ Normalize function for output
240 -> String -- ^ Title of test
241 -> [String] -- ^ Options to pass to pandoc
242 -> String -- ^ Input filepath
243 -> FilePath -- ^ Norm (for test results) filepath
244 -> Test
245testWithNormalize normalizer testname opts inp norm = testCase testname $ do
246 -- find pandoc executable relative to test-pandoc
247 -- First, try in same directory (e.g. if both in ~/.cabal/bin)
248 -- Second, try ../pandoc (e.g. if in dist/XXX/build/test-pandoc)
249 pandocPath <- do
250 testExePath <- getExecutablePath
251 let testExeDir = takeDirectory testExePath
252 found <- doesFileExist (testExeDir </> "pandoc")
253 return $ if found
254 then testExeDir </> "pandoc"
255 else case splitDirectories testExeDir of
256 [] -> error "test-pandoc: empty testExeDir"
257 xs -> joinPath (init xs) </> "pandoc" </> "pandoc"
258 (outputPath, hOut) <- openTempFile "" "pandoc-test"
259 let inpPath = inp
260 let normPath = norm
261 let options = ["--data-dir", ".." </> "data"] ++ [inpPath] ++ opts
262 let cmd = pandocPath ++ " " ++ unwords options
263 ph <- runProcess pandocPath options Nothing
264 (Just [("TMP","."),("LANG","en_US.UTF-8"),("HOME", "./")]) Nothing (Just hOut)
265 (Just stderr)
266 ec <- waitForProcess ph
267 result <- if ec == ExitSuccess
268 then do
269 -- filter \r so the tests will work on Windows machines
270 outputContents <- readFile' outputPath >>=
271 return . filter (/='\r') . normalizer
272 normContents <- readFile' normPath >>=
273 return . filter (/='\r') . normalizer
274 if outputContents == normContents
275 then return TestPassed
276 else return
277 $ TestFailed cmd normPath
278 $ getDiff (lines outputContents) (lines normContents)
279 else return $ TestError ec
280 removeFile outputPath
281 assertBool (show result) (result == TestPassed)