git.iko.soy/typeable/pandoc
on ca2bbaf help sign in
typeable/pandoc/tests/RunTests.hs
169 lines 6.9 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.Exit
17import System.IO.UTF8
18import System.IO ( openTempFile, stderr, stdout, hFlush )
19import Prelude hiding ( putStrLn, putStr, readFile )
20import System.Process ( runProcess, waitForProcess )
21import System.FilePath ( (</>), (<.>) )
22import System.Directory
23import System.Environment
24import System.Exit
25import Text.Printf
26import Data.Algorithm.Diff
28pandocPath :: FilePath
29pandocPath = ".." </> "dist" </> "build" </> "pandoc" </> "pandoc"
31data TestResult = TestPassed
32 | TestError ExitCode
33 | TestFailed [(DI, String)]
34 deriving (Eq)
36instance Show TestResult where
37 show TestPassed = "PASSED"
38 show (TestError ec) = "ERROR " ++ show ec
39 show (TestFailed d) = "FAILED\n" ++ showDiff d
41showDiff :: [(DI, String)] -> String
42showDiff [] = ""
43showDiff ((F, ln) : ds) = "|TEST| " ++ ln ++ "\n" ++ showDiff ds
44showDiff ((S, ln) : ds) = "|NORM| " ++ ln ++ "\n" ++ showDiff ds
45showDiff ((B, _ ) : ds) = showDiff ds
47writerFormats :: [String]
48writerFormats = [ "native"
49 , "html"
50 , "docbook"
51 , "opendocument"
52 , "latex"
53 , "context"
54 , "texinfo"
55 , "man"
56 , "markdown"
57 , "rst"
58 , "mediawiki"
59 , "rtf"
60 ]
62lhsWriterFormats :: [String]
63lhsWriterFormats = [ "markdown"
64 , "markdown+lhs"
65 , "rst"
66 , "rst+lhs"
67 , "latex"
68 , "latex+lhs"
69 , "html"
70 , "html+lhs"
71 ]
73lhsReaderFormats :: [String]
74lhsReaderFormats = [ "markdown+lhs"
75 , "rst+lhs"
76 , "latex+lhs"
77 ]
79main :: IO ()
80main = do
81 args <- getArgs
82 let runLhsTests = "lhs" `elem` args
83 r1s <- mapM runWriterTest writerFormats
84 r2 <- runS5WriterTest "basic" ["-s"] "s5"
85 r3 <- runS5WriterTest "fancy" ["-s","-m","-i"] "s5"
86 r4 <- runS5WriterTest "fragment" [] "html"
87 r5 <- runS5WriterTest "inserts" ["-s", "-H", "insert",
88 "-B", "insert", "-A", "insert", "-c", "main.css"] "html"
89 r6 <- runTest "markdown reader" ["-r", "markdown", "-w", "native", "-s", "-S"]
90 "testsuite.txt" "testsuite.native"
91 r7 <- runTest "markdown reader (tables)" ["-r", "markdown", "-w", "native"]
92 "tables.txt" "tables.native"
93 r7a <- runTest "markdown reader (more)" ["-r", "markdown", "-w", "native"]
94 "markdown-reader-more.txt" "markdown-reader-more.native"
95 r8 <- runTest "rst reader" ["-r", "rst", "-w", "native", "-s", "-S"]
96 "rst-reader.rst" "rst-reader.native"
97 r9 <- runTest "html reader" ["-r", "html", "-w", "native", "-s"]
98 "html-reader.html" "html-reader.native"
99 r10 <- runTest "latex reader" ["-r", "latex", "-w", "native", "-s", "-R"]
100 "latex-reader.latex" "latex-reader.native"
101 r11 <- runTest "native reader" ["-r", "native", "-w", "native", "-s"]
102 "testsuite.native" "testsuite.native"
103 r12s <- if runLhsTests
104 then mapM runLhsWriterTest lhsWriterFormats
105 else putStrLn "Skipping lhs writer tests because they presuppose highlighting support" >> return []
106 r13s <- if runLhsTests
107 then mapM runLhsReaderTest lhsReaderFormats
108 else putStrLn "Skipping lhs reader tests because they presuppose highlighting support" >> return []
109 let results = r1s ++ [r2, r3, r4, r5, r6, r7, r7a, r8, r9, r10, r11] ++ r12s ++ r13s
110 if all id results
111 then do
112 putStrLn "\nAll tests passed."
113 exitWith ExitSuccess
114 else do
115 let failures = length $ filter not results
116 putStrLn $ "\n" ++ show failures ++ " tests failed."
117 exitWith (ExitFailure failures)
119-- makes sure file is fully closed after reading
120readFile' :: FilePath -> IO String
121readFile' f = do s <- readFile f
122 return $! (length s `seq` s)
124runLhsWriterTest :: String -> IO Bool
125runLhsWriterTest format =
126 runTest ("(lhs) " ++ format ++ " writer") ["-r", "native", "-s", "-w", format] "lhs-test.native" ("lhs-test" <.> format)
128runLhsReaderTest :: String -> IO Bool
129runLhsReaderTest format =
130 runTest ("(lhs) " ++ format ++ " reader") ["-r", format, "-w", "html+lhs"] ("lhs-test" <.> format) "lhs-test.fragment.html+lhs"
132runWriterTest :: String -> IO Bool
133runWriterTest format = do
134 r1 <- runTest (format ++ " writer") ["-r", "native", "-s", "-w", format] "testsuite.native" ("writer" <.> format)
135 r2 <- runTest (format ++ " writer (tables)") ["-r", "native", "-w", format] "tables.native" ("tables" <.> format)
136 return (r1 && r2)
138runS5WriterTest :: String -> [String] -> String -> IO Bool
139runS5WriterTest modifier opts format = runTest (format ++ " writer (" ++ modifier ++ ")")
140 (["-r", "native", "-w", format] ++ opts) "s5.native" ("s5." ++ modifier <.> "html")
142-- | Run a test, return True if test passed.
143runTest :: String -- ^ Title of test
144 -> [String] -- ^ Options to pass to pandoc
145 -> String -- ^ Input filepath
146 -> FilePath -- ^ Norm (for test results) filepath
147 -> IO Bool
148runTest testname opts inp norm = do
149 putStr $ printf "%-28s ---> " testname
150 (outputPath, hOut) <- openTempFile "" "pandoc-test"
151 let inpPath = inp
152 let normPath = norm
153 hFlush stdout
154 env <- getEnvironment -- we need at least HOME so pandoc can find data files
155 -- Note: COLUMNS must be set for markdown table reader
156 ph <- runProcess pandocPath (opts ++ [inpPath]) Nothing (Just (("COLUMNS", "80"):env)) Nothing (Just hOut) (Just stderr)
157 ec <- waitForProcess ph
158 result <- if ec == ExitSuccess
159 then do
160 -- filter \r so the tests will work on Windows machines
161 outputContents <- readFile' outputPath >>= return . filter (/='\r')
162 normContents <- readFile' normPath >>= return . filter (/='\r')
163 if outputContents == normContents
164 then return TestPassed
165 else return $ TestFailed $ getDiff (lines outputContents) (lines normContents)
166 else return $ TestError ec
167 removeFile outputPath
168 putStrLn (show result)
169 return (result == TestPassed)