summaryrefslogtreecommitdiff
path: root/src/test-pandoc.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/test-pandoc.hs')
-rw-r--r--src/test-pandoc.hs220
1 files changed, 220 insertions, 0 deletions
diff --git a/src/test-pandoc.hs b/src/test-pandoc.hs
new file mode 100644
index 000000000..2c7bc0749
--- /dev/null
+++ b/src/test-pandoc.hs
@@ -0,0 +1,220 @@
+{-# OPTIONS_GHC -Wall #-}
+-- RunTests.hs - run test suite for pandoc
+-- This script is designed to be run from the tests directory.
+-- It assumes the pandoc executable is in dist/build/pandoc.
+--
+-- runhaskell -i.. RunTests.hs [lhs]
+--
+-- If the lhs argument is provided, tests for lhs support will be
+-- run. These presuppose that pandoc has been compiled with the
+-- -fhighlighting flag, so these tests are not run by default.
+--
+-- This program assumes that the Diff package has been installed:
+-- cabal install Diff
+
+module Main where
+import System.IO ( openTempFile, stderr, stdout, hFlush )
+import System.Process ( runProcess, waitForProcess )
+import System.FilePath ( (</>), (<.>) )
+import System.Directory
+import System.Environment
+import System.Exit
+import Text.Printf
+import Data.Algorithm.Diff
+import Data.String.Utils ( replace )
+import Prelude hiding ( readFile )
+import qualified Data.ByteString.Lazy as B
+import Data.ByteString.Lazy.UTF8 (toString, fromString)
+
+readFileUTF8 :: FilePath -> IO String
+readFileUTF8 f = B.readFile f >>= return . toString
+
+pandocPath :: FilePath
+pandocPath = ".." </> "dist" </> "build" </> "pandoc" </> "pandoc"
+
+data TestResult = TestPassed
+ | TestError ExitCode
+ | TestFailed [(DI, String)]
+ deriving (Eq)
+
+instance Show TestResult where
+ show TestPassed = "PASSED"
+ show (TestError ec) = "ERROR " ++ show ec
+ show (TestFailed d) = "FAILED\n" ++ showDiff d
+
+showDiff :: [(DI, String)] -> String
+showDiff [] = ""
+showDiff ((F, ln) : ds) = "|TEST| " ++ ln ++ "\n" ++ showDiff ds
+showDiff ((S, ln) : ds) = "|NORM| " ++ ln ++ "\n" ++ showDiff ds
+showDiff ((B, _ ) : ds) = showDiff ds
+
+writerFormats :: [String]
+writerFormats = [ "native"
+ , "html"
+ , "docbook"
+ , "opendocument"
+ , "latex"
+ , "context"
+ , "texinfo"
+ , "man"
+ , "plain"
+ , "markdown"
+ , "rst"
+ , "mediawiki"
+ , "textile"
+ , "rtf"
+ , "org"
+ ]
+
+lhsWriterFormats :: [String]
+lhsWriterFormats = [ "markdown"
+ , "markdown+lhs"
+ , "rst"
+ , "rst+lhs"
+ , "latex"
+ , "latex+lhs"
+ , "html"
+ , "html+lhs"
+ ]
+
+lhsReaderFormats :: [String]
+lhsReaderFormats = [ "markdown+lhs"
+ , "rst+lhs"
+ , "latex+lhs"
+ ]
+
+main :: IO ()
+main = do
+ args <- getArgs
+ let runLhsTests = "lhs" `elem` args
+ r1s <- mapM runWriterTest writerFormats
+ r2 <- runS5WriterTest "basic" ["-s"] "s5"
+ r3 <- runS5WriterTest "fancy" ["-s","-m","-i"] "s5"
+ r4 <- runS5WriterTest "fragment" [] "html"
+ r5 <- runS5WriterTest "inserts" ["-s", "-H", "insert",
+ "-B", "insert", "-A", "insert", "-c", "main.css"] "html"
+ r6 <- runTest "markdown reader" ["-r", "markdown", "-w", "native", "-s", "-S"]
+ "testsuite.txt" "testsuite.native"
+ r7 <- runTest "markdown reader (tables)" ["-r", "markdown", "-w", "native"]
+ "tables.txt" "tables.native"
+ r7a <- runTest "markdown reader (more)" ["-r", "markdown", "-w", "native", "-S"]
+ "markdown-reader-more.txt" "markdown-reader-more.native"
+ r8 <- runTest "rst reader" ["-r", "rst", "-w", "native", "-s", "-S"]
+ "rst-reader.rst" "rst-reader.native"
+ r8a <- runTest "rst reader (tables)" ["-r", "rst", "-w", "native"]
+ "tables.rst" "tables-rstsubset.native"
+ r9 <- runTest "html reader" ["-r", "html", "-w", "native", "-s"]
+ "html-reader.html" "html-reader.native"
+ r10 <- runTest "latex reader" ["-r", "latex", "-w", "native", "-s", "-R"]
+ "latex-reader.latex" "latex-reader.native"
+ rTextile1 <- runTest "textile reader" ["-r", "textile", "-w", "native", "-s"]
+ "textile-reader.textile" "textile-reader.native"
+ r11 <- runTest "native reader" ["-r", "native", "-w", "native", "-s"]
+ "testsuite.native" "testsuite.native"
+ r14s <- mapM (\style -> runTest ("markdown reader (citations) (" ++ style ++ ")") ["-r", "markdown", "-w", "markdown", "--bibliography", "biblio.bib", "--csl", style ++ ".csl", "--no-wrap"] "markdown-citations.txt" ("markdown-citations." ++ style ++ ".txt")) ["chicago-author-date","ieee","mhra"]
+ let citopts = ["--bibliography", "biblio.bib", "--csl", "chicago-author-date.csl", "--no-citeproc"]
+ r15 <- runTest "markdown writer (citations)" (["-r", "markdown", "-w", "markdown"] ++ citopts)
+ "markdown-citations.txt" "markdown-citations.txt"
+ r16s <- runLatexCitationTests citopts "biblatex"
+ r17s <- runLatexCitationTests citopts "natbib"
+ r12s <- if runLhsTests
+ then mapM runLhsWriterTest lhsWriterFormats
+ else putStrLn "Skipping lhs writer tests because they presuppose highlighting support" >> return []
+ r13s <- if runLhsTests
+ then mapM runLhsReaderTest lhsReaderFormats
+ else putStrLn "Skipping lhs reader tests because they presuppose highlighting support" >> return []
+ let results = r1s ++
+
+ [ r2, r3, r4, r5 -- S5
+ , r6, r7, r7a -- markdown reader
+ , r8, r8a -- rst
+ , r9 -- html
+ , r10 -- latex
+ , rTextile1 -- textile
+ , r11 -- native
+ , r15 -- markdown citations
+ ] ++ r12s ++ r13s ++ r14s ++ r16s ++ r17s
+ if all id results
+ then do
+ putStrLn "\nAll tests passed."
+ exitWith ExitSuccess
+ else do
+ let failures = length $ filter not results
+ putStrLn $ "\n" ++ show failures ++ " tests failed."
+ exitWith (ExitFailure failures)
+
+-- makes sure file is fully closed after reading
+readFile' :: FilePath -> IO String
+readFile' f = do s <- readFileUTF8 f
+ return $! (length s `seq` s)
+
+runLhsWriterTest :: String -> IO Bool
+runLhsWriterTest format =
+ runTest ("(lhs) " ++ format ++ " writer") ["-r", "native", "-s", "-w", format] "lhs-test.native" ("lhs-test" <.> format)
+
+runLhsReaderTest :: String -> IO Bool
+runLhsReaderTest format =
+ runTest ("(lhs) " ++ format ++ " reader") ["-r", format, "-w", "html+lhs"] ("lhs-test" <.> format) "lhs-test.fragment.html+lhs"
+
+
+runLatexCitationTests :: [String] -> String -> IO [Bool]
+runLatexCitationTests o n
+ = sequence [ rt ("latex reader (" ++ n ++ " citations)") (["-r", "latex", "-w", "markdown", "-s"] ++ o')
+ f "markdown-citations.txt"
+ , rt ("latex writer (" ++ n ++ " citations)") (["-r", "markdown", "-w", "latex", "-s"] ++ o')
+ "markdown-citations.txt" f
+ ]
+ where
+ o' = o ++ ["--" ++ n]
+ f = n ++ "-citations.latex"
+ normalize = replace "\160" " " . replace "\8211" "-"
+ rt = runTestWithNormalize normalize
+
+runWriterTest :: String -> IO Bool
+runWriterTest format = do
+ r1 <- runTest (format ++ " writer") ["-r", "native", "-s", "-w", format] "testsuite.native" ("writer" <.> format)
+ r2 <- runTest (format ++ " writer (tables)") ["-r", "native", "-w", format] "tables.native" ("tables" <.> format)
+ return (r1 && r2)
+
+runS5WriterTest :: String -> [String] -> String -> IO Bool
+runS5WriterTest modifier opts format = runTest (format ++ " writer (" ++ modifier ++ ")")
+ (["-r", "native", "-w", format] ++ opts) "s5.native" ("s5." ++ modifier <.> "html")
+
+
+-- | Run a test without normalize function, return True if test passed.
+runTest :: String -- ^ Title of test
+ -> [String] -- ^ Options to pass to pandoc
+ -> String -- ^ Input filepath
+ -> FilePath -- ^ Norm (for test results) filepath
+ -> IO Bool
+runTest = runTestWithNormalize id
+
+-- | Run a test with normalize function, return True if test passed.
+runTestWithNormalize :: (String -> String) -- ^ Normalize function for output
+ -> String -- ^ Title of test
+ -> [String] -- ^ Options to pass to pandoc
+ -> String -- ^ Input filepath
+ -> FilePath -- ^ Norm (for test results) filepath
+ -> IO Bool
+runTestWithNormalize normalize testname opts inp norm = do
+ putStr $ printf "%-28s ---> " testname
+ (outputPath, hOut) <- openTempFile "" "pandoc-test"
+ let inpPath = inp
+ let normPath = norm
+ hFlush stdout
+ -- Note: COLUMNS must be set for markdown table reader
+ ph <- runProcess pandocPath (opts ++ [inpPath] ++ ["--data-dir", ".."]) Nothing
+ (Just [("LANG","en_US.UTF-8"),("COLUMNS", "80"),("HOME", "./")]) Nothing (Just hOut) (Just stderr)
+ ec <- waitForProcess ph
+ result <- if ec == ExitSuccess
+ then do
+ -- filter \r so the tests will work on Windows machines
+ outputContents <- readFile' outputPath >>= return . filter (/='\r') . normalize
+ normContents <- readFile' normPath >>= return . filter (/='\r')
+ if outputContents == normContents
+ then return TestPassed
+ else return $ TestFailed $ getDiff (lines outputContents) (lines normContents)
+ else return $ TestError ec
+ removeFile outputPath
+ B.putStrLn (fromString $ show result)
+ return (result == TestPassed)
generated by cgit v1.2.3 (git 2.25.1) at 2024-04-18 20:43:09 +0000