git.iko.soy/typeable/pandoc
on 36d4e64 help sign in
typeable/pandoc/tests/RunTests.hs
181 lines 7.4 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 r12s <- if runLhsTests
110 then mapM runLhsWriterTest lhsWriterFormats
111 else putStrLn "Skipping lhs writer tests because they presuppose highlighting support" >> return []
112 r13s <- if runLhsTests
113 then mapM runLhsReaderTest lhsReaderFormats
114 else putStrLn "Skipping lhs reader tests because they presuppose highlighting support" >> return []
115 let results = r1s ++
116 [ r2, r3, r4, r5 -- S5
117 , r6, r7, r7a -- markdown reader
118 , r8, r8a -- rst
119 , r9 -- html
120 , r10 -- latex
121 , r11 -- native
122 ] ++ r12s ++ r13s
123 if all id results
124 then do
125 putStrLn "\nAll tests passed."
126 exitWith ExitSuccess
127 else do
128 let failures = length $ filter not results
129 putStrLn $ "\n" ++ show failures ++ " tests failed."
130 exitWith (ExitFailure failures)
132-- makes sure file is fully closed after reading
133readFile' :: FilePath -> IO String
134readFile' f = do s <- readFileUTF8 f
135 return $! (length s `seq` s)
137runLhsWriterTest :: String -> IO Bool
138runLhsWriterTest format =
139 runTest ("(lhs) " ++ format ++ " writer") ["-r", "native", "-s", "-w", format] "lhs-test.native" ("lhs-test" <.> format)
141runLhsReaderTest :: String -> IO Bool
142runLhsReaderTest format =
143 runTest ("(lhs) " ++ format ++ " reader") ["-r", format, "-w", "html+lhs"] ("lhs-test" <.> format) "lhs-test.fragment.html+lhs"
145runWriterTest :: String -> IO Bool
146runWriterTest format = do
147 r1 <- runTest (format ++ " writer") ["-r", "native", "-s", "-w", format] "testsuite.native" ("writer" <.> format)
148 r2 <- runTest (format ++ " writer (tables)") ["-r", "native", "-w", format] "tables.native" ("tables" <.> format)
149 return (r1 && r2)
151runS5WriterTest :: String -> [String] -> String -> IO Bool
152runS5WriterTest modifier opts format = runTest (format ++ " writer (" ++ modifier ++ ")")
153 (["-r", "native", "-w", format] ++ opts) "s5.native" ("s5." ++ modifier <.> "html")
155-- | Run a test, return True if test passed.
156runTest :: String -- ^ Title of test
157 -> [String] -- ^ Options to pass to pandoc
158 -> String -- ^ Input filepath
159 -> FilePath -- ^ Norm (for test results) filepath
160 -> IO Bool
161runTest testname opts inp norm = do
162 putStr $ printf "%-28s ---> " testname
163 (outputPath, hOut) <- openTempFile "" "pandoc-test"
164 let inpPath = inp
165 let normPath = norm
166 hFlush stdout
167 -- Note: COLUMNS must be set for markdown table reader
168 ph <- runProcess pandocPath (opts ++ [inpPath] ++ ["--data-dir", ".."]) Nothing (Just [("COLUMNS", "80")]) Nothing (Just hOut) (Just stderr)
169 ec <- waitForProcess ph
170 result <- if ec == ExitSuccess
171 then do
172 -- filter \r so the tests will work on Windows machines
173 outputContents <- readFile' outputPath >>= return . filter (/='\r')
174 normContents <- readFile' normPath >>= return . filter (/='\r')
175 if outputContents == normContents
176 then return TestPassed
177 else return $ TestFailed $ getDiff (lines outputContents) (lines normContents)
178 else return $ TestError ec
179 removeFile outputPath
180 B.putStrLn (fromString $ show result)
181 return (result == TestPassed)