git.iko.soy/typeable/pandoc
on 46121aa help sign in
typeable/pandoc/tests/RunTests.hs
185 lines 7.6 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2-- RunTests.hs - run test suite for pandoc
3-- This script is designed to be run from the tests directory.
4-- It assumes the pandoc executable is in dist/build/pandoc.
5--
6-- runhaskell -i.. RunTests.hs [lhs]
7--
8-- If the lhs argument is provided, tests for lhs support will be
9-- run. These presuppose that pandoc has been compiled with the
10-- -fhighlighting flag, so these tests are not run by default.
11--
12-- This program assumes that the Diff package has been installed:
13-- cabal install Diff
15module Main where
16import System.IO ( openTempFile, stderr, stdout, hFlush )
17import System.Process ( runProcess, waitForProcess )
18import System.FilePath ( (</>), (<.>) )
19import System.Directory
20import System.Environment
21import System.Exit
22import Text.Printf
23import Data.Algorithm.Diff
24import Prelude hiding ( readFile )
25import qualified Data.ByteString.Lazy as B
26import Data.ByteString.Lazy.UTF8 (toString, fromString)
28readFileUTF8 :: FilePath -> IO String
29readFileUTF8 f = B.readFile f >>= return . toString
31pandocPath :: FilePath
32pandocPath = ".." </> "dist" </> "build" </> "pandoc" </> "pandoc"
34data TestResult = TestPassed
35 | TestError ExitCode
36 | TestFailed [(DI, String)]
37 deriving (Eq)
39instance Show TestResult where
40 show TestPassed = "PASSED"
41 show (TestError ec) = "ERROR " ++ show ec
42 show (TestFailed d) = "FAILED\n" ++ showDiff d
44showDiff :: [(DI, String)] -> String
45showDiff [] = ""
46showDiff ((F, ln) : ds) = "|TEST| " ++ ln ++ "\n" ++ showDiff ds
47showDiff ((S, ln) : ds) = "|NORM| " ++ ln ++ "\n" ++ showDiff ds
48showDiff ((B, _ ) : ds) = showDiff ds
50writerFormats :: [String]
51writerFormats = [ "native"
52 , "html"
53 , "docbook"
54 , "opendocument"
55 , "latex"
56 , "context"
57 , "texinfo"
58 , "man"
59 , "plain"
60 , "markdown"
61 , "rst"
62 , "mediawiki"
63 , "rtf"
64 ]
66lhsWriterFormats :: [String]
67lhsWriterFormats = [ "markdown"
68 , "markdown+lhs"
69 , "rst"
70 , "rst+lhs"
71 , "latex"
72 , "latex+lhs"
73 , "html"
74 , "html+lhs"
75 ]
77lhsReaderFormats :: [String]
78lhsReaderFormats = [ "markdown+lhs"
79 , "rst+lhs"
80 , "latex+lhs"
81 ]
83main :: IO ()
84main = do
85 args <- getArgs
86 let runLhsTests = "lhs" `elem` args
87 r1s <- mapM runWriterTest writerFormats
88 r2 <- runS5WriterTest "basic" ["-s"] "s5"
89 r3 <- runS5WriterTest "fancy" ["-s","-m","-i"] "s5"
90 r4 <- runS5WriterTest "fragment" [] "html"
91 r5 <- runS5WriterTest "inserts" ["-s", "-H", "insert",
92 "-B", "insert", "-A", "insert", "-c", "main.css"] "html"
93 r6 <- runTest "markdown reader" ["-r", "markdown", "-w", "native", "-s", "-S"]
94 "testsuite.txt" "testsuite.native"
95 r7 <- runTest "markdown reader (tables)" ["-r", "markdown", "-w", "native"]
96 "tables.txt" "tables.native"
97 r7a <- runTest "markdown reader (more)" ["-r", "markdown", "-w", "native"]
98 "markdown-reader-more.txt" "markdown-reader-more.native"
99 r8 <- runTest "rst reader" ["-r", "rst", "-w", "native", "-s", "-S"]
100 "rst-reader.rst" "rst-reader.native"
101 r8a <- runTest "rst reader (tables)" ["-r", "rst", "-w", "native"]
102 "tables.rst" "tables-rstsubset.native"
103 r9 <- runTest "html reader" ["-r", "html", "-w", "native", "-s"]
104 "html-reader.html" "html-reader.native"
105 r10 <- runTest "latex reader" ["-r", "latex", "-w", "native", "-s", "-R"]
106 "latex-reader.latex" "latex-reader.native"
107 r11 <- runTest "native reader" ["-r", "native", "-w", "native", "-s"]
108 "testsuite.native" "testsuite.native"
109 r14 <- runTest "markdown reader (citations)" ["-r", "markdown", "-w", "plain", "--bibliography", "biblio.bib", "--csl", "chicago-author-date.csl"] "markdown-citations.txt" "markdown-citations.plain"
110 r12s <- if runLhsTests
111 then mapM runLhsWriterTest lhsWriterFormats
112 else putStrLn "Skipping lhs writer tests because they presuppose highlighting support" >> return []
113 r13s <- if runLhsTests
114 then mapM runLhsReaderTest lhsReaderFormats
115 else putStrLn "Skipping lhs reader tests because they presuppose highlighting support" >> return []
116 let results = r1s ++
118 [ r2, r3, r4, r5 -- S5
119 , r6, r7, r7a -- markdown reader
120 , r8, r8a -- rst
121 , r9 -- html
122 , r10 -- latex
123 , r11 -- native
124 , r14 -- citations
125 ] ++ r12s ++ r13s
126 if all id results
127 then do
128 putStrLn "\nAll tests passed."
129 exitWith ExitSuccess
130 else do
131 let failures = length $ filter not results
132 putStrLn $ "\n" ++ show failures ++ " tests failed."
133 exitWith (ExitFailure failures)
135-- makes sure file is fully closed after reading
136readFile' :: FilePath -> IO String
137readFile' f = do s <- readFileUTF8 f
138 return $! (length s `seq` s)
140runLhsWriterTest :: String -> IO Bool
141runLhsWriterTest format =
142 runTest ("(lhs) " ++ format ++ " writer") ["-r", "native", "-s", "-w", format] "lhs-test.native" ("lhs-test" <.> format)
144runLhsReaderTest :: String -> IO Bool
145runLhsReaderTest format =
146 runTest ("(lhs) " ++ format ++ " reader") ["-r", format, "-w", "html+lhs"] ("lhs-test" <.> format) "lhs-test.fragment.html+lhs"
148runWriterTest :: String -> IO Bool
149runWriterTest format = do
150 r1 <- runTest (format ++ " writer") ["-r", "native", "-s", "-w", format] "testsuite.native" ("writer" <.> format)
151 r2 <- runTest (format ++ " writer (tables)") ["-r", "native", "-w", format] "tables.native" ("tables" <.> format)
152 return (r1 && r2)
154runS5WriterTest :: String -> [String] -> String -> IO Bool
155runS5WriterTest modifier opts format = runTest (format ++ " writer (" ++ modifier ++ ")")
156 (["-r", "native", "-w", format] ++ opts) "s5.native" ("s5." ++ modifier <.> "html")
158-- | Run a test, return True if test passed.
159runTest :: String -- ^ Title of test
160 -> [String] -- ^ Options to pass to pandoc
161 -> String -- ^ Input filepath
162 -> FilePath -- ^ Norm (for test results) filepath
163 -> IO Bool
164runTest testname opts inp norm = do
165 putStr $ printf "%-28s ---> " testname
166 (outputPath, hOut) <- openTempFile "" "pandoc-test"
167 let inpPath = inp
168 let normPath = norm
169 hFlush stdout
170 -- Note: COLUMNS must be set for markdown table reader
171 ph <- runProcess pandocPath (opts ++ [inpPath] ++ ["--data-dir", ".."]) Nothing
172 (Just [("LANG","en_US.UTF-8"),("COLUMNS", "80")]) Nothing (Just hOut) (Just stderr)
173 ec <- waitForProcess ph
174 result <- if ec == ExitSuccess
175 then do
176 -- filter \r so the tests will work on Windows machines
177 outputContents <- readFile' outputPath >>= return . filter (/='\r')
178 normContents <- readFile' normPath >>= return . filter (/='\r')
179 if outputContents == normContents
180 then return TestPassed
181 else return $ TestFailed $ getDiff (lines outputContents) (lines normContents)
182 else return $ TestError ec
183 removeFile outputPath
184 B.putStrLn (fromString $ show result)
185 return (result == TestPassed)