From c0700987ba30de0cd7aa697da144eb19a58147ab Mon Sep 17 00:00:00 2001 From: Nathan Gass Date: Tue, 4 Jan 2011 01:00:01 +0100 Subject: Changed test-pandoc to use test-framework and HUnit. --- src/test-pandoc.hs | 215 +++++++++++++++++++++++++---------------------------- 1 file changed, 102 insertions(+), 113 deletions(-) (limited to 'src') diff --git a/src/test-pandoc.hs b/src/test-pandoc.hs index 9b6d96510..43b8a2afa 100644 --- a/src/test-pandoc.hs +++ b/src/test-pandoc.hs @@ -13,18 +13,22 @@ -- cabal install Diff module Main where -import System.IO ( openTempFile, stderr, stdout, hFlush ) + +import Test.Framework (defaultMain, testGroup, Test ) +import Test.Framework.Providers.HUnit + +import Test.HUnit hiding ( Test ) + +import System.IO ( openTempFile, stderr ) 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 Text.Pandoc.Shared ( substitute ) import Prelude hiding ( readFile ) import qualified Data.ByteString.Lazy as B -import Data.ByteString.Lazy.UTF8 (toString, fromString) +import Data.ByteString.Lazy.UTF8 (toString) readFileUTF8 :: FilePath -> IO String readFileUTF8 f = B.readFile f >>= return . toString @@ -48,24 +52,6 @@ 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" @@ -83,100 +69,106 @@ lhsReaderFormats = [ "markdown+lhs" , "latex+lhs" ] +markdownCitationTest :: Test +markdownCitationTest + = testGroup "citations" $ map styleToTest ["chicago-author-date","ieee","mhra"] + ++ [runTest "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 = runTest style (ropts ++ ["--csl", style ++ ".csl"]) + "markdown-citations.txt" ("markdown-citations." ++ style ++ ".txt") + + +tests :: [Test] +tests = [ testGroup "markdown" [ runWriterTest "" "markdown" + , runTest "reader" ["-r", "markdown", "-w", "native", "-s", "-S"] + "testsuite.txt" "testsuite.native" + , runTest "reader (tables)" ["-r", "markdown", "-w", "native"] + "tables.txt" "tables.native" + , runTest "reader (more)" ["-r", "markdown", "-w", "native", "-S"] + "markdown-reader-more.txt" "markdown-reader-more.native" + , markdownCitationTest + ] + , testGroup "rst" [ runWriterTest "" "rst" + , runTest "reader" ["-r", "rst", "-w", "native", "-s", "-S"] + "rst-reader.rst" "rst-reader.native" + , runTest "reader (tables)" ["-r", "rst", "-w", "native"] + "tables.rst" "tables-rstsubset.native" + ] + , testGroup "latex" [ runWriterTest "" "latex" + , runTest "reader" ["-r", "latex", "-w", "native", "-s", "-R"] + "latex-reader.latex" "latex-reader.native" + , runLatexCitationTests "biblatex" + , runLatexCitationTests "natbib" + ] + , testGroup "html" [ runWriterTest "" "html" + , runTest "reader" ["-r", "html", "-w", "native", "-s"] + "html-reader.html" "html-reader.native" + ] + , testGroup "s5" [ runS5WriterTest "basic" ["-s"] "s5" + , runS5WriterTest "fancy" ["-s","-m","-i"] "s5" + , runS5WriterTest "fragment" [] "html" + , runS5WriterTest "inserts" ["-s", "-H", "insert", + "-B", "insert", "-A", "insert", "-c", "main.css"] "html" + ] + , testGroup "textile" [ runWriterTest "" "textile" + , runTest "reader" ["-r", "textile", "-w", "native", "-s"] + "textile-reader.textile" "textile-reader.native" + ] + , testGroup "native" [ runWriterTest "" "native" + , runTest "reader" ["-r", "native", "-w", "native", "-s"] + "testsuite.native" "testsuite.native" + ] + , testGroup "other writers" $ map (\f -> runWriterTest f f) [ "docbook", "opendocument" , "context" , "texinfo" + , "man" , "plain" , "mediawiki", "rtf", "org" + ] + , testGroup "lhs" [ testGroup "writer" $ map runLhsWriterTest lhsWriterFormats + , testGroup "reader" $ map runLhsReaderTest lhsReaderFormats + ] + ] + 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", "--no-wrap"] ++ 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) +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) -runLhsWriterTest :: String -> IO Bool +runLhsWriterTest :: String -> Test runLhsWriterTest format = - runTest ("(lhs) " ++ format ++ " writer") ["--columns=78", "-r", "native", "-s", "-w", format] "lhs-test.native" ("lhs-test" <.> format) + runTest format ["--columns=78", "-r", "native", "-s", "-w", format] "lhs-test.native" ("lhs-test" <.> format) -runLhsReaderTest :: String -> IO Bool +runLhsReaderTest :: String -> Test 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", "--no-wrap"] ++ o') - f "markdown-citations.txt" - , rt ("latex writer (" ++ n ++ " citations)") (["-r", "markdown", "-w", "latex", "-s", "--no-wrap"] ++ o') - "markdown-citations.txt" f - ] - where - o' = o ++ ["--" ++ n] - f = n ++ "-citations.latex" - normalize = substitute "\160" " " . substitute "\8211" "-" - rt = runTestWithNormalize normalize - -runWriterTest :: String -> IO Bool -runWriterTest format = do - r1 <- runTest (format ++ " writer") ["-r", "native", "-s", "-w", format, "--columns=78"] "testsuite.native" ("writer" <.> format) - r2 <- runTest (format ++ " writer (tables)") ["-r", "native", "-w", format, "--columns=78"] "tables.native" ("tables" <.> format) - return (r1 && r2) - -runS5WriterTest :: String -> [String] -> String -> IO Bool + runTest format ["-r", format, "-w", "html+lhs"] ("lhs-test" <.> format) "lhs-test.fragment.html+lhs" + + +runLatexCitationTests :: String -> Test +runLatexCitationTests n + = testGroup (n ++ " citations") + [ rt ("latex reader (" ++ n ++ " citations)") (["-r", "latex", "-w", "markdown", "-s", "--no-wrap"] ++ o) + f "markdown-citations.txt" + , rt ("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" "-" + rt = runTestWithNormalize normalize + +runWriterTest :: String -> String -> Test +runWriterTest prefix format + = testGroup name [ runTest "basic" (opts ++ ["-s"]) "testsuite.native" ("writer" <.> format) + , runTest "tables" opts "tables.native" ("tables" <.> format) + ] + where + name = if (null prefix) then "writer" else prefix ++ " writer" + opts = ["-r", "native", "-w", format, "--columns=78"] + +runS5WriterTest :: String -> [String] -> String -> Test runS5WriterTest modifier opts format = runTest (format ++ " writer (" ++ modifier ++ ")") (["-r", "native", "-w", format] ++ opts) "s5.native" ("s5." ++ modifier <.> "html") @@ -186,7 +178,7 @@ runTest :: String -- ^ Title of test -> [String] -- ^ Options to pass to pandoc -> String -- ^ Input filepath -> FilePath -- ^ Norm (for test results) filepath - -> IO Bool + -> Test runTest = runTestWithNormalize id -- | Run a test with normalize function, return True if test passed. @@ -195,13 +187,11 @@ runTestWithNormalize :: (String -> String) -- ^ Normalize function for output -> [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 + -> Test +runTestWithNormalize normalize testname opts inp norm = testCase testname $ do (outputPath, hOut) <- openTempFile "" "pandoc-test" let inpPath = inp let normPath = norm - hFlush stdout 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 @@ -215,5 +205,4 @@ runTestWithNormalize normalize testname opts inp norm = do else return $ TestFailed $ getDiff (lines outputContents) (lines normContents) else return $ TestError ec removeFile outputPath - B.putStrLn (fromString $ show result) - return (result == TestPassed) + assertBool (show result) (result == TestPassed) -- cgit v1.2.3 From e06899ef1fb4a0b6a034cceb4b9ec11725720efa Mon Sep 17 00:00:00 2001 From: Nathan Gass Date: Tue, 11 Jan 2011 20:41:34 +0100 Subject: Add reader groups for markdown and rst reader tests. --- src/test-pandoc.hs | 22 ++++++++++++---------- 1 file changed, 12 insertions(+), 10 deletions(-) (limited to 'src') diff --git a/src/test-pandoc.hs b/src/test-pandoc.hs index 43b8a2afa..0c0218ae8 100644 --- a/src/test-pandoc.hs +++ b/src/test-pandoc.hs @@ -82,19 +82,21 @@ markdownCitationTest tests :: [Test] tests = [ testGroup "markdown" [ runWriterTest "" "markdown" - , runTest "reader" ["-r", "markdown", "-w", "native", "-s", "-S"] - "testsuite.txt" "testsuite.native" - , runTest "reader (tables)" ["-r", "markdown", "-w", "native"] - "tables.txt" "tables.native" - , runTest "reader (more)" ["-r", "markdown", "-w", "native", "-S"] - "markdown-reader-more.txt" "markdown-reader-more.native" + , testGroup "reader" [ runTest "basic" ["-r", "markdown", "-w", "native", "-s", "-S"] + "testsuite.txt" "testsuite.native" + , runTest "tables" ["-r", "markdown", "-w", "native"] + "tables.txt" "tables.native" + , runTest "more" ["-r", "markdown", "-w", "native", "-S"] + "markdown-reader-more.txt" "markdown-reader-more.native" + ] , markdownCitationTest ] , testGroup "rst" [ runWriterTest "" "rst" - , runTest "reader" ["-r", "rst", "-w", "native", "-s", "-S"] - "rst-reader.rst" "rst-reader.native" - , runTest "reader (tables)" ["-r", "rst", "-w", "native"] - "tables.rst" "tables-rstsubset.native" + , testGroup "reader" [ runTest "basic" ["-r", "rst", "-w", "native", "-s", "-S"] + "rst-reader.rst" "rst-reader.native" + , runTest "tables" ["-r", "rst", "-w", "native"] + "tables.rst" "tables-rstsubset.native" + ] ] , testGroup "latex" [ runWriterTest "" "latex" , runTest "reader" ["-r", "latex", "-w", "native", "-s", "-R"] -- cgit v1.2.3 From a2153acfffecd969a513bf2fc3d940f99ec3dfee Mon Sep 17 00:00:00 2001 From: Nathan Gass Date: Tue, 11 Jan 2011 21:10:36 +0100 Subject: Include lhs tests in existing testGroup structure. --- src/test-pandoc.hs | 71 +++++++++++++++++++++++------------------------------- 1 file changed, 30 insertions(+), 41 deletions(-) (limited to 'src') diff --git a/src/test-pandoc.hs b/src/test-pandoc.hs index 0c0218ae8..fde0715c9 100644 --- a/src/test-pandoc.hs +++ b/src/test-pandoc.hs @@ -52,23 +52,6 @@ showDiff ((F, ln) : ds) = "|TEST| " ++ ln ++ "\n" ++ showDiff ds showDiff ((S, ln) : ds) = "|NORM| " ++ ln ++ "\n" ++ showDiff ds showDiff ((B, _ ) : ds) = showDiff ds -lhsWriterFormats :: [String] -lhsWriterFormats = [ "markdown" - , "markdown+lhs" - , "rst" - , "rst+lhs" - , "latex" - , "latex+lhs" - , "html" - , "html+lhs" - ] - -lhsReaderFormats :: [String] -lhsReaderFormats = [ "markdown+lhs" - , "rst+lhs" - , "latex+lhs" - ] - markdownCitationTest :: Test markdownCitationTest = testGroup "citations" $ map styleToTest ["chicago-author-date","ieee","mhra"] @@ -81,30 +64,34 @@ markdownCitationTest tests :: [Test] -tests = [ testGroup "markdown" [ runWriterTest "" "markdown" +tests = [ testGroup "markdown" [ testGroup "writer" (runWriterTests "markdown" ++ runLhsWriterTests "markdown") , testGroup "reader" [ runTest "basic" ["-r", "markdown", "-w", "native", "-s", "-S"] "testsuite.txt" "testsuite.native" , runTest "tables" ["-r", "markdown", "-w", "native"] "tables.txt" "tables.native" , runTest "more" ["-r", "markdown", "-w", "native", "-S"] "markdown-reader-more.txt" "markdown-reader-more.native" + , runLhsReaderTest "markdown+lhs" ] , markdownCitationTest ] - , testGroup "rst" [ runWriterTest "" "rst" + , testGroup "rst" [ testGroup "writer" (runWriterTests "rst" ++ runLhsWriterTests "rst") , testGroup "reader" [ runTest "basic" ["-r", "rst", "-w", "native", "-s", "-S"] "rst-reader.rst" "rst-reader.native" , runTest "tables" ["-r", "rst", "-w", "native"] "tables.rst" "tables-rstsubset.native" + , runLhsReaderTest "rst+lhs" ] ] - , testGroup "latex" [ runWriterTest "" "latex" - , runTest "reader" ["-r", "latex", "-w", "native", "-s", "-R"] - "latex-reader.latex" "latex-reader.native" + , testGroup "latex" [ testGroup "writer" (runWriterTests "latex" ++ runLhsWriterTests "latex") + , testGroup "reader" [ runTest "basic" ["-r", "latex", "-w", "native", "-s", "-R"] + "latex-reader.latex" "latex-reader.native" + , runLhsReaderTest "latex+lhs" + ] , runLatexCitationTests "biblatex" , runLatexCitationTests "natbib" ] - , testGroup "html" [ runWriterTest "" "html" + , testGroup "html" [ testGroup "writer" (runWriterTests "html" ++ runLhsWriterTests "html") , runTest "reader" ["-r", "html", "-w", "native", "-s"] "html-reader.html" "html-reader.native" ] @@ -114,20 +101,18 @@ tests = [ testGroup "markdown" [ runWriterTest "" "markdown" , runS5WriterTest "inserts" ["-s", "-H", "insert", "-B", "insert", "-A", "insert", "-c", "main.css"] "html" ] - , testGroup "textile" [ runWriterTest "" "textile" + , testGroup "textile" [ testGroup "writer" $ runWriterTests "textile" , runTest "reader" ["-r", "textile", "-w", "native", "-s"] "textile-reader.textile" "textile-reader.native" ] - , testGroup "native" [ runWriterTest "" "native" + , testGroup "native" [ testGroup "writer" $ runWriterTests "native" , runTest "reader" ["-r", "native", "-w", "native", "-s"] "testsuite.native" "testsuite.native" ] - , testGroup "other writers" $ map (\f -> runWriterTest f f) [ "docbook", "opendocument" , "context" , "texinfo" - , "man" , "plain" , "mediawiki", "rtf", "org" - ] - , testGroup "lhs" [ testGroup "writer" $ map runLhsWriterTest lhsWriterFormats - , testGroup "reader" $ map runLhsReaderTest lhsReaderFormats - ] + , testGroup "other writers" $ map (\f -> testGroup f $ runWriterTests f) + [ "docbook", "opendocument" , "context" , "texinfo" + , "man" , "plain" , "mediawiki", "rtf", "org" + ] ] main :: IO () @@ -138,13 +123,18 @@ readFile' :: FilePath -> IO String readFile' f = do s <- readFileUTF8 f return $! (length s `seq` s) -runLhsWriterTest :: String -> Test -runLhsWriterTest format = - runTest format ["--columns=78", "-r", "native", "-s", "-w", format] "lhs-test.native" ("lhs-test" <.> format) +runLhsWriterTests :: String -> [Test] +runLhsWriterTests format + = [ t "lhs to normal" format + , t "lhs to lhs" (format ++ "+lhs") + ] + where + t n f = runTest n ["--columns=78", "-r", "native", "-s", "-w", f] + "lhs-test.native" ("lhs-test" <.> f) runLhsReaderTest :: String -> Test runLhsReaderTest format = - runTest format ["-r", format, "-w", "html+lhs"] ("lhs-test" <.> format) "lhs-test.fragment.html+lhs" + runTest "lhs" ["-r", format, "-w", "html+lhs"] ("lhs-test" <.> format) "lhs-test.fragment.html+lhs" runLatexCitationTests :: String -> Test @@ -161,13 +151,12 @@ runLatexCitationTests n normalize = substitute "\160" " " . substitute "\8211" "-" rt = runTestWithNormalize normalize -runWriterTest :: String -> String -> Test -runWriterTest prefix format - = testGroup name [ runTest "basic" (opts ++ ["-s"]) "testsuite.native" ("writer" <.> format) - , runTest "tables" opts "tables.native" ("tables" <.> format) - ] +runWriterTests :: String -> [Test] +runWriterTests format + = [ runTest "basic" (opts ++ ["-s"]) "testsuite.native" ("writer" <.> format) + , runTest "tables" opts "tables.native" ("tables" <.> format) + ] where - name = if (null prefix) then "writer" else prefix ++ " writer" opts = ["-r", "native", "-w", format, "--columns=78"] runS5WriterTest :: String -> [String] -> String -> Test -- cgit v1.2.3 From f3ee73607fd33a4ea6292ca02ba195ede075278b Mon Sep 17 00:00:00 2001 From: Nathan Gass Date: Tue, 11 Jan 2011 21:30:19 +0100 Subject: Removed run prefix from all test functions. --- src/test-pandoc.hs | 138 ++++++++++++++++++++++++++--------------------------- 1 file changed, 68 insertions(+), 70 deletions(-) (limited to 'src') diff --git a/src/test-pandoc.hs b/src/test-pandoc.hs index fde0715c9..78b2b8e4f 100644 --- a/src/test-pandoc.hs +++ b/src/test-pandoc.hs @@ -16,8 +16,7 @@ module Main where import Test.Framework (defaultMain, testGroup, Test ) import Test.Framework.Providers.HUnit - -import Test.HUnit hiding ( Test ) +import Test.HUnit ( assertBool ) import System.IO ( openTempFile, stderr ) import System.Process ( runProcess, waitForProcess ) @@ -52,64 +51,53 @@ showDiff ((F, ln) : ds) = "|TEST| " ++ ln ++ "\n" ++ showDiff ds showDiff ((S, ln) : ds) = "|NORM| " ++ ln ++ "\n" ++ showDiff ds showDiff ((B, _ ) : ds) = showDiff ds -markdownCitationTest :: Test -markdownCitationTest - = testGroup "citations" $ map styleToTest ["chicago-author-date","ieee","mhra"] - ++ [runTest "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 = runTest style (ropts ++ ["--csl", style ++ ".csl"]) - "markdown-citations.txt" ("markdown-citations." ++ style ++ ".txt") - - tests :: [Test] -tests = [ testGroup "markdown" [ testGroup "writer" (runWriterTests "markdown" ++ runLhsWriterTests "markdown") - , testGroup "reader" [ runTest "basic" ["-r", "markdown", "-w", "native", "-s", "-S"] +tests = [ testGroup "markdown" [ testGroup "writer" (writerTests "markdown" ++ lhsWriterTests "markdown") + , testGroup "reader" [ test "basic" ["-r", "markdown", "-w", "native", "-s", "-S"] "testsuite.txt" "testsuite.native" - , runTest "tables" ["-r", "markdown", "-w", "native"] + , test "tables" ["-r", "markdown", "-w", "native"] "tables.txt" "tables.native" - , runTest "more" ["-r", "markdown", "-w", "native", "-S"] + , test "more" ["-r", "markdown", "-w", "native", "-S"] "markdown-reader-more.txt" "markdown-reader-more.native" - , runLhsReaderTest "markdown+lhs" + , lhsReaderTest "markdown+lhs" ] - , markdownCitationTest + , testGroup "citations" markdownCitationTests ] - , testGroup "rst" [ testGroup "writer" (runWriterTests "rst" ++ runLhsWriterTests "rst") - , testGroup "reader" [ runTest "basic" ["-r", "rst", "-w", "native", "-s", "-S"] + , testGroup "rst" [ testGroup "writer" (writerTests "rst" ++ lhsWriterTests "rst") + , testGroup "reader" [ test "basic" ["-r", "rst", "-w", "native", "-s", "-S"] "rst-reader.rst" "rst-reader.native" - , runTest "tables" ["-r", "rst", "-w", "native"] + , test "tables" ["-r", "rst", "-w", "native"] "tables.rst" "tables-rstsubset.native" - , runLhsReaderTest "rst+lhs" + , lhsReaderTest "rst+lhs" ] ] - , testGroup "latex" [ testGroup "writer" (runWriterTests "latex" ++ runLhsWriterTests "latex") - , testGroup "reader" [ runTest "basic" ["-r", "latex", "-w", "native", "-s", "-R"] + , testGroup "latex" [ testGroup "writer" (writerTests "latex" ++ lhsWriterTests "latex") + , testGroup "reader" [ test "basic" ["-r", "latex", "-w", "native", "-s", "-R"] "latex-reader.latex" "latex-reader.native" - , runLhsReaderTest "latex+lhs" + , lhsReaderTest "latex+lhs" ] - , runLatexCitationTests "biblatex" - , runLatexCitationTests "natbib" + , latexCitationTests "biblatex" + , latexCitationTests "natbib" ] - , testGroup "html" [ testGroup "writer" (runWriterTests "html" ++ runLhsWriterTests "html") - , runTest "reader" ["-r", "html", "-w", "native", "-s"] + , testGroup "html" [ testGroup "writer" (writerTests "html" ++ lhsWriterTests "html") + , test "reader" ["-r", "html", "-w", "native", "-s"] "html-reader.html" "html-reader.native" ] - , testGroup "s5" [ runS5WriterTest "basic" ["-s"] "s5" - , runS5WriterTest "fancy" ["-s","-m","-i"] "s5" - , runS5WriterTest "fragment" [] "html" - , runS5WriterTest "inserts" ["-s", "-H", "insert", + , 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" $ runWriterTests "textile" - , runTest "reader" ["-r", "textile", "-w", "native", "-s"] + , testGroup "textile" [ testGroup "writer" $ writerTests "textile" + , test "reader" ["-r", "textile", "-w", "native", "-s"] "textile-reader.textile" "textile-reader.native" ] - , testGroup "native" [ testGroup "writer" $ runWriterTests "native" - , runTest "reader" ["-r", "native", "-w", "native", "-s"] + , testGroup "native" [ testGroup "writer" $ writerTests "native" + , test "reader" ["-r", "native", "-w", "native", "-s"] "testsuite.native" "testsuite.native" ] - , testGroup "other writers" $ map (\f -> testGroup f $ runWriterTests f) + , testGroup "other writers" $ map (\f -> testGroup f $ writerTests f) [ "docbook", "opendocument" , "context" , "texinfo" , "man" , "plain" , "mediawiki", "rtf", "org" ] @@ -123,63 +111,73 @@ readFile' :: FilePath -> IO String readFile' f = do s <- readFileUTF8 f return $! (length s `seq` s) -runLhsWriterTests :: String -> [Test] -runLhsWriterTests format +lhsWriterTests :: String -> [Test] +lhsWriterTests format = [ t "lhs to normal" format , t "lhs to lhs" (format ++ "+lhs") ] where - t n f = runTest n ["--columns=78", "-r", "native", "-s", "-w", f] + t n f = test n ["--columns=78", "-r", "native", "-s", "-w", f] "lhs-test.native" ("lhs-test" <.> f) -runLhsReaderTest :: String -> Test -runLhsReaderTest format = - runTest "lhs" ["-r", format, "-w", "html+lhs"] ("lhs-test" <.> format) "lhs-test.fragment.html+lhs" +lhsReaderTest :: String -> Test +lhsReaderTest format = + test "lhs" ["-r", format, "-w", "html+lhs"] ("lhs-test" <.> format) "lhs-test.fragment.html+lhs" -runLatexCitationTests :: String -> Test -runLatexCitationTests n +latexCitationTests :: String -> Test +latexCitationTests n = testGroup (n ++ " citations") - [ rt ("latex reader (" ++ n ++ " citations)") (["-r", "latex", "-w", "markdown", "-s", "--no-wrap"] ++ o) + [ t ("latex reader (" ++ n ++ " citations)") (["-r", "latex", "-w", "markdown", "-s", "--no-wrap"] ++ o) f "markdown-citations.txt" - , rt ("latex writer (" ++ n ++ " citations)") (["-r", "markdown", "-w", "latex", "-s", "--no-wrap"] ++ o) + , 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" "-" - rt = runTestWithNormalize normalize + t = testWithNormalize normalize -runWriterTests :: String -> [Test] -runWriterTests format - = [ runTest "basic" (opts ++ ["-s"]) "testsuite.native" ("writer" <.> format) - , runTest "tables" opts "tables.native" ("tables" <.> format) +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"] -runS5WriterTest :: String -> [String] -> String -> Test -runS5WriterTest modifier opts format = runTest (format ++ " writer (" ++ modifier ++ ")") - (["-r", "native", "-w", format] ++ opts) "s5.native" ("s5." ++ modifier <.> "html") +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. -runTest :: String -- ^ Title of test - -> [String] -- ^ Options to pass to pandoc - -> String -- ^ Input filepath - -> FilePath -- ^ Norm (for test results) filepath - -> Test -runTest = runTestWithNormalize id +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. -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 - -> Test -runTestWithNormalize normalize testname opts inp norm = testCase testname $ do +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 -- cgit v1.2.3 From e8fa72c6a7c40f21ad31998acd4da769e8b5f41c Mon Sep 17 00:00:00 2001 From: Nathan Gass Date: Tue, 11 Jan 2011 21:49:49 +0100 Subject: Moved test-pandoc.hs to tests directory. --- pandoc.cabal | 2 +- src/test-pandoc.hs | 197 --------------------------------------------------- tests/test-pandoc.hs | 197 +++++++++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 198 insertions(+), 198 deletions(-) delete mode 100644 src/test-pandoc.hs create mode 100644 tests/test-pandoc.hs (limited to 'src') diff --git a/pandoc.cabal b/pandoc.cabal index bb9a3e323..1a3dd8506 100644 --- a/pandoc.cabal +++ b/pandoc.cabal @@ -289,7 +289,7 @@ Executable markdown2pdf Buildable: False Executable test-pandoc - Hs-Source-Dirs: src + Hs-Source-Dirs: tests, src Main-Is: test-pandoc.hs if !flag(tests) Buildable: False 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) diff --git a/tests/test-pandoc.hs b/tests/test-pandoc.hs new file mode 100644 index 000000000..78b2b8e4f --- /dev/null +++ b/tests/test-pandoc.hs @@ -0,0 +1,197 @@ +{-# 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) -- cgit v1.2.3