git.iko.soy/typeable/pandoc
on de79021 help sign in
typeable/pandoc/src/Tests/Old.hs
197 lines 8.0 kB history raw
1module Tests.Old (tests) where
3import Test.Framework (testGroup, Test )
4import Test.Framework.Providers.HUnit
5import Test.HUnit ( assertBool )
7import System.IO ( openTempFile, stderr )
8import System.Process ( runProcess, waitForProcess )
9import System.FilePath ( (</>), (<.>) )
10import System.Directory
11import System.Exit
12import Data.Algorithm.Diff
13import Text.Pandoc.Shared ( normalize, defaultWriterOptions )
14import Text.Pandoc.Writers.Native ( writeNative )
15import Text.Pandoc.Readers.Native ( readNative )
16import Prelude hiding ( readFile )
17import qualified Data.ByteString.Lazy as B
18import Data.ByteString.Lazy.UTF8 (toString)
19import Text.Printf
21readFileUTF8 :: FilePath -> IO String
22readFileUTF8 f = B.readFile f >>= return . toString
24pandocPath :: FilePath
25pandocPath = ".." </> "dist" </> "build" </> "pandoc" </> "pandoc"
27data TestResult = TestPassed
28 | TestError ExitCode
29 | TestFailed String FilePath [(DI, String)]
30 deriving (Eq)
32instance Show TestResult where
33 show TestPassed = "PASSED"
34 show (TestError ec) = "ERROR " ++ show ec
35 show (TestFailed cmd file d) = '\n' : dash ++
36 "\n--- " ++ file ++
37 "\n+++ " ++ cmd ++ "\n" ++ showDiff (1,1) d ++
38 dash
39 where dash = replicate 72 '-'
41showDiff :: (Int,Int) -> [(DI, String)] -> String
42showDiff _ [] = ""
43showDiff (l,r) ((F, ln) : ds) =
44 printf "+%4d " l ++ ln ++ "\n" ++ showDiff (l+1,r) ds
45showDiff (l,r) ((S, ln) : ds) =
46 printf "-%4d " r ++ ln ++ "\n" ++ showDiff (l,r+1) ds
47showDiff (l,r) ((B, _ ) : ds) =
48 showDiff (l+1,r+1) ds
50tests :: [Test]
51tests = [ testGroup "markdown"
52 [ testGroup "writer"
53 $ writerTests "markdown" ++ lhsWriterTests "markdown"
54 , testGroup "reader"
55 [ test "basic" ["-r", "markdown", "-w", "native", "-s", "-S"]
56 "testsuite.txt" "testsuite.native"
57 , test "tables" ["-r", "markdown", "-w", "native", "--columns=80"]
58 "tables.txt" "tables.native"
59 , test "more" ["-r", "markdown", "-w", "native", "-S"]
60 "markdown-reader-more.txt" "markdown-reader-more.native"
61 , lhsReaderTest "markdown+lhs"
62 ]
63 , testGroup "citations" markdownCitationTests
64 ]
65 , testGroup "rst"
66 [ testGroup "writer" (writerTests "rst" ++ lhsWriterTests "rst")
67 , testGroup "reader"
68 [ test "basic" ["-r", "rst", "-w", "native",
69 "-s", "-S", "--columns=80"] "rst-reader.rst" "rst-reader.native"
70 , test "tables" ["-r", "rst", "-w", "native", "--columns=80"]
71 "tables.rst" "tables-rstsubset.native"
72 , lhsReaderTest "rst+lhs"
73 ]
74 ]
75 , testGroup "latex"
76 [ testGroup "writer" (writerTests "latex" ++ lhsWriterTests "latex")
77 , testGroup "reader"
78 [ test "basic" ["-r", "latex", "-w", "native", "-s", "-R"]
79 "latex-reader.latex" "latex-reader.native"
80 , lhsReaderTest "latex+lhs"
81 ]
82 ]
83 , testGroup "html"
84 [ testGroup "writer" (writerTests "html" ++ lhsWriterTests "html")
85 , test "reader" ["-r", "html", "-w", "native", "-s"]
86 "html-reader.html" "html-reader.native"
87 ]
88 , testGroup "s5"
89 [ s5WriterTest "basic" ["-s"] "s5"
90 , s5WriterTest "fancy" ["-s","-m","-i"] "s5"
91 , s5WriterTest "fragment" [] "html"
92 , s5WriterTest "inserts" ["-s", "-H", "insert",
93 "-B", "insert", "-A", "insert", "-c", "main.css"] "html"
94 ]
95 , testGroup "textile"
96 [ testGroup "writer" $ writerTests "textile"
97 , test "reader" ["-r", "textile", "-w", "native", "-s"]
98 "textile-reader.textile" "textile-reader.native"
99 ]
100 , testGroup "native"
101 [ testGroup "writer" $ writerTests "native"
102 , test "reader" ["-r", "native", "-w", "native", "-s"]
103 "testsuite.native" "testsuite.native"
104 ]
105 , testGroup "other writers" $ map (\f -> testGroup f $ writerTests f)
106 [ "docbook", "opendocument" , "context" , "texinfo"
107 , "man" , "plain" , "mediawiki", "rtf", "org", "asciidoc"
108 ]
109 ]
111-- makes sure file is fully closed after reading
112readFile' :: FilePath -> IO String
113readFile' f = do s <- readFileUTF8 f
114 return $! (length s `seq` s)
116lhsWriterTests :: String -> [Test]
117lhsWriterTests format
118 = [ t "lhs to normal" format
119 , t "lhs to lhs" (format ++ "+lhs")
120 ]
121 where
122 t n f = test n ["--columns=78", "-r", "native", "-s", "-w", f]
123 "lhs-test.native" ("lhs-test" <.> f)
125lhsReaderTest :: String -> Test
126lhsReaderTest format =
127 testWithNormalize normalizer "lhs" ["-r", format, "-w", "native"]
128 ("lhs-test" <.> format) "lhs-test.native"
129 where normalizer = writeNative defaultWriterOptions . normalize . readNative
131writerTests :: String -> [Test]
132writerTests format
133 = [ test "basic" (opts ++ ["-s"]) "testsuite.native" ("writer" <.> format)
134 , test "tables" opts "tables.native" ("tables" <.> format)
135 ]
136 where
137 opts = ["-r", "native", "-w", format, "--columns=78"]
139s5WriterTest :: String -> [String] -> String -> Test
140s5WriterTest modifier opts format
141 = test (format ++ " writer (" ++ modifier ++ ")")
142 (["-r", "native", "-w", format] ++ opts)
143 "s5.native" ("s5." ++ modifier <.> "html")
145markdownCitationTests :: [Test]
146markdownCitationTests
147 = map styleToTest ["chicago-author-date","ieee","mhra"]
148 ++ [test "natbib" wopts "markdown-citations.txt"
149 "markdown-citations.txt"]
150 where
151 ropts = ["-r", "markdown", "-w", "markdown", "--bibliography",
152 "biblio.bib", "--no-wrap"]
153 wopts = ropts ++ ["--natbib"]
154 styleToTest style = test style (ropts ++ ["--csl", style ++ ".csl"])
155 "markdown-citations.txt"
156 ("markdown-citations." ++ style ++ ".txt")
158-- | Run a test without normalize function, return True if test passed.
159test :: String -- ^ Title of test
160 -> [String] -- ^ Options to pass to pandoc
161 -> String -- ^ Input filepath
162 -> FilePath -- ^ Norm (for test results) filepath
163 -> Test
164test = testWithNormalize id
166-- | Run a test with normalize function, return True if test passed.
167testWithNormalize :: (String -> String) -- ^ Normalize function for output
168 -> String -- ^ Title of test
169 -> [String] -- ^ Options to pass to pandoc
170 -> String -- ^ Input filepath
171 -> FilePath -- ^ Norm (for test results) filepath
172 -> Test
173testWithNormalize normalizer testname opts inp norm = testCase testname $ do
174 (outputPath, hOut) <- openTempFile "" "pandoc-test"
175 let inpPath = inp
176 let normPath = norm
177 let options = ["--data-dir", ".."] ++ [inpPath] ++ opts
178 let cmd = pandocPath ++ " " ++ unwords options
179 ph <- runProcess pandocPath options Nothing
180 (Just [("LANG","en_US.UTF-8"),("HOME", "./")]) Nothing (Just hOut)
181 (Just stderr)
182 ec <- waitForProcess ph
183 result <- if ec == ExitSuccess
184 then do
185 -- filter \r so the tests will work on Windows machines
186 outputContents <- readFile' outputPath >>=
187 return . filter (/='\r') . normalizer
188 normContents <- readFile' normPath >>=
189 return . filter (/='\r') . normalizer
190 if outputContents == normContents
191 then return TestPassed
192 else return
193 $ TestFailed cmd normPath
194 $ getDiff (lines outputContents) (lines normContents)
195 else return $ TestError ec
196 removeFile outputPath
197 assertBool (show result) (result == TestPassed)