summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorNathan Gass <gass@search.ch>2011-01-11 21:49:49 +0100
committerNathan Gass <gass@search.ch>2011-01-11 21:49:49 +0100
commite8fa72c6a7c40f21ad31998acd4da769e8b5f41c (patch)
tree7d8229ee65600b618ae999a09c294a194ac80d6e /src
parentf3ee73607fd33a4ea6292ca02ba195ede075278b (diff)
Moved test-pandoc.hs to tests directory.
Diffstat (limited to 'src')
-rw-r--r--src/test-pandoc.hs197
1 files changed, 0 insertions, 197 deletions
diff --git a/src/test-pandoc.hs b/src/test-pandoc.hs
deleted file mode 100644
index 78b2b8e4f..000000000
--- a/src/test-pandoc.hs
+++ /dev/null
@@ -1,197 +0,0 @@
-{-# 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 Test.Framework (defaultMain, testGroup, Test )
-import Test.Framework.Providers.HUnit
-import Test.HUnit ( assertBool )
-
-import System.IO ( openTempFile, stderr )
-import System.Process ( runProcess, waitForProcess )
-import System.FilePath ( (</>), (<.>) )
-import System.Directory
-import System.Exit
-import Data.Algorithm.Diff
-import Text.Pandoc.Shared ( substitute )
-import Prelude hiding ( readFile )
-import qualified Data.ByteString.Lazy as B
-import Data.ByteString.Lazy.UTF8 (toString)
-
-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
-
-tests :: [Test]
-tests = [ testGroup "markdown" [ testGroup "writer" (writerTests "markdown" ++ lhsWriterTests "markdown")
- , testGroup "reader" [ test "basic" ["-r", "markdown", "-w", "native", "-s", "-S"]
- "testsuite.txt" "testsuite.native"
- , test "tables" ["-r", "markdown", "-w", "native"]
- "tables.txt" "tables.native"
- , test "more" ["-r", "markdown", "-w", "native", "-S"]
- "markdown-reader-more.txt" "markdown-reader-more.native"
- , lhsReaderTest "markdown+lhs"
- ]
- , testGroup "citations" markdownCitationTests
- ]
- , testGroup "rst" [ testGroup "writer" (writerTests "rst" ++ lhsWriterTests "rst")
- , testGroup "reader" [ test "basic" ["-r", "rst", "-w", "native", "-s", "-S"]
- "rst-reader.rst" "rst-reader.native"
- , test "tables" ["-r", "rst", "-w", "native"]
- "tables.rst" "tables-rstsubset.native"
- , lhsReaderTest "rst+lhs"
- ]
- ]
- , testGroup "latex" [ testGroup "writer" (writerTests "latex" ++ lhsWriterTests "latex")
- , testGroup "reader" [ test "basic" ["-r", "latex", "-w", "native", "-s", "-R"]
- "latex-reader.latex" "latex-reader.native"
- , lhsReaderTest "latex+lhs"
- ]
- , latexCitationTests "biblatex"
- , latexCitationTests "natbib"
- ]
- , testGroup "html" [ testGroup "writer" (writerTests "html" ++ lhsWriterTests "html")
- , test "reader" ["-r", "html", "-w", "native", "-s"]
- "html-reader.html" "html-reader.native"
- ]
- , testGroup "s5" [ s5WriterTest "basic" ["-s"] "s5"
- , s5WriterTest "fancy" ["-s","-m","-i"] "s5"
- , s5WriterTest "fragment" [] "html"
- , s5WriterTest "inserts" ["-s", "-H", "insert",
- "-B", "insert", "-A", "insert", "-c", "main.css"] "html"
- ]
- , testGroup "textile" [ testGroup "writer" $ writerTests "textile"
- , test "reader" ["-r", "textile", "-w", "native", "-s"]
- "textile-reader.textile" "textile-reader.native"
- ]
- , testGroup "native" [ testGroup "writer" $ writerTests "native"
- , test "reader" ["-r", "native", "-w", "native", "-s"]
- "testsuite.native" "testsuite.native"
- ]
- , testGroup "other writers" $ map (\f -> testGroup f $ writerTests f)
- [ "docbook", "opendocument" , "context" , "texinfo"
- , "man" , "plain" , "mediawiki", "rtf", "org"
- ]
- ]
-
-main :: IO ()
-main = defaultMain tests
-
--- makes sure file is fully closed after reading
-readFile' :: FilePath -> IO String
-readFile' f = do s <- readFileUTF8 f
- return $! (length s `seq` s)
-
-lhsWriterTests :: String -> [Test]
-lhsWriterTests format
- = [ t "lhs to normal" format
- , t "lhs to lhs" (format ++ "+lhs")
- ]
- where
- t n f = test n ["--columns=78", "-r", "native", "-s", "-w", f]
- "lhs-test.native" ("lhs-test" <.> f)
-
-lhsReaderTest :: String -> Test
-lhsReaderTest format =
- test "lhs" ["-r", format, "-w", "html+lhs"] ("lhs-test" <.> format) "lhs-test.fragment.html+lhs"
-
-
-latexCitationTests :: String -> Test
-latexCitationTests n
- = testGroup (n ++ " citations")
- [ t ("latex reader (" ++ n ++ " citations)") (["-r", "latex", "-w", "markdown", "-s", "--no-wrap"] ++ o)
- f "markdown-citations.txt"
- , t ("latex writer (" ++ n ++ " citations)") (["-r", "markdown", "-w", "latex", "-s", "--no-wrap"] ++ o)
- "markdown-citations.txt" f
- ]
- where
- o = ["--bibliography", "biblio.bib", "--csl", "chicago-author-date.csl", "--no-citeproc", "--" ++ n]
- f = n ++ "-citations.latex"
- normalize = substitute "\160" " " . substitute "\8211" "-"
- t = testWithNormalize normalize
-
-writerTests :: String -> [Test]
-writerTests format
- = [ test "basic" (opts ++ ["-s"]) "testsuite.native" ("writer" <.> format)
- , test "tables" opts "tables.native" ("tables" <.> format)
- ]
- where
- opts = ["-r", "native", "-w", format, "--columns=78"]
-
-s5WriterTest :: String -> [String] -> String -> Test
-s5WriterTest modifier opts format
- = test (format ++ " writer (" ++ modifier ++ ")") (["-r", "native", "-w", format] ++ opts)
- "s5.native" ("s5." ++ modifier <.> "html")
-
-markdownCitationTests :: [Test]
-markdownCitationTests
- = map styleToTest ["chicago-author-date","ieee","mhra"]
- ++ [test "no-citeproc" wopts "markdown-citations.txt" "markdown-citations.txt"]
- where
- ropts = ["-r", "markdown", "-w", "markdown", "--bibliography", "biblio.bib", "--no-wrap"]
- wopts = ropts ++ ["--no-citeproc"]
- styleToTest style = test style (ropts ++ ["--csl", style ++ ".csl"])
- "markdown-citations.txt" ("markdown-citations." ++ style ++ ".txt")
-
--- | Run a test without normalize function, return True if test passed.
-test :: String -- ^ Title of test
- -> [String] -- ^ Options to pass to pandoc
- -> String -- ^ Input filepath
- -> FilePath -- ^ Norm (for test results) filepath
- -> Test
-test = testWithNormalize id
-
--- | Run a test with normalize function, return True if test passed.
-testWithNormalize :: (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
- -> Test
-testWithNormalize normalize testname opts inp norm = testCase testname $ do
- (outputPath, hOut) <- openTempFile "" "pandoc-test"
- let inpPath = inp
- let normPath = norm
- ph <- runProcess pandocPath (["--columns=80"] ++ [inpPath] ++ ["--data-dir", ".."] ++ opts) Nothing
- (Just [("LANG","en_US.UTF-8"),("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
- assertBool (show result) (result == TestPassed)