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. --- tests/test-pandoc.hs | 197 +++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 197 insertions(+) create mode 100644 tests/test-pandoc.hs (limited to 'tests') 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 From 3bc0a55af0994f34c1d7b2ebdc8b960f0f713ebf Mon Sep 17 00:00:00 2001 From: Nathan Gass Date: Tue, 11 Jan 2011 22:37:41 +0100 Subject: Removed outdated comments. --- tests/test-pandoc.hs | 12 ------------ 1 file changed, 12 deletions(-) (limited to 'tests') diff --git a/tests/test-pandoc.hs b/tests/test-pandoc.hs index 78b2b8e4f..6c77b984c 100644 --- a/tests/test-pandoc.hs +++ b/tests/test-pandoc.hs @@ -1,16 +1,4 @@ {-# 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 -- cgit v1.2.3 From eb1d0148596b91c2887233e034411763196490a5 Mon Sep 17 00:00:00 2001 From: John MacFarlane Date: Tue, 11 Jan 2011 17:36:58 -0800 Subject: Improvements to test suite. + You can now specify glob patterns after 'cabal test'; e.g. 'cabal test latex' will only run the latex tests. + Instead of detecting highlighting support in Setup.hs, we now detect it in test-pandoc, by looking to see if 'languages' is null. + We now verify the lhs readers against the lhs-test.native, normalizing with 'normalize'. This makes more sense than verifying against HTML, which also brings in the HTML writer. + Added lhsn-test.nohl.{html,html+lhs}, so we can do the lhs tests whether or not highlighting has been installed. --- Setup.hs | 11 +++-------- pandoc.cabal | 7 ++++++- tests/lhs-test.native | 4 ++-- tests/lhs-test.nohl.html | 39 +++++++++++++++++++++++++++++++++++++++ tests/lhs-test.nohl.html+lhs | 39 +++++++++++++++++++++++++++++++++++++++ tests/test-pandoc.hs | 24 ++++++++++++++---------- 6 files changed, 103 insertions(+), 21 deletions(-) create mode 100644 tests/lhs-test.nohl.html create mode 100644 tests/lhs-test.nohl.html+lhs (limited to 'tests') diff --git a/Setup.hs b/Setup.hs index 432746070..6dbc119e2 100644 --- a/Setup.hs +++ b/Setup.hs @@ -38,17 +38,12 @@ main = do -- | Run test suite. runTestSuite :: Args -> Bool -> PackageDescription -> LocalBuildInfo -> IO a -runTestSuite _ _ pkg lbi = do +runTestSuite args _ pkg lbi = do let testDir = buildDir lbi "test-pandoc" testDir' <- canonicalizePath testDir + let testArgs = concatMap (\arg -> ["-t",arg]) args if any id [buildable (buildInfo exe) | exe <- executables pkg, exeName exe == "test-pandoc"] - then do - let isHighlightingKate (Dependency (PackageName "highlighting-kate") _) = True - isHighlightingKate _ = False - let highlightingSupport = any isHighlightingKate $ buildDepends pkg - let testArgs = if highlightingSupport then [] else ["-t", "!lhs"] - inDirectory "tests" $ rawSystem (testDir' "test-pandoc") - testArgs >>= exitWith + then inDirectory "tests" $ rawSystem (testDir' "test-pandoc") testArgs >>= exitWith else do putStrLn "Build pandoc with the 'tests' flag to run tests" exitWith $ ExitFailure 3 diff --git a/pandoc.cabal b/pandoc.cabal index 1a3dd8506..71cb0135b 100644 --- a/pandoc.cabal +++ b/pandoc.cabal @@ -136,6 +136,8 @@ Extra-Source-Files: tests/lhs-test.latex+lhs, tests/lhs-test.html, tests/lhs-test.html+lhs, + tests/lhs-test.nohl.html, + tests/lhs-test.nohl.html+lhs, tests/lhs-test.fragment.html+lhs Extra-Tmp-Files: man/man1/pandoc.1, man/man1/markdown2pdf.1 @@ -291,9 +293,12 @@ Executable markdown2pdf Executable test-pandoc Hs-Source-Dirs: tests, src Main-Is: test-pandoc.hs + if flag(highlighting) + cpp-options: -D_HIGHLIGHTING if !flag(tests) Buildable: False else Ghc-Options: -Wall + Extensions: CPP Build-Depends: base >= 4 && < 5, Diff, test-framework, test-framework-hunit, HUnit - Other-Modules: Text.Pandoc.Shared + Other-Modules: Text.Pandoc.Shared, Text.Pandoc.Highlighting, Text.Pandoc.Writers.Native diff --git a/tests/lhs-test.native b/tests/lhs-test.native index 94150f069..e1127c9db 100644 --- a/tests/lhs-test.native +++ b/tests/lhs-test.native @@ -1,10 +1,10 @@ Pandoc (Meta {docTitle = [], docAuthors = [], docDate = []}) [ Header 1 [Str "lhs",Space,Str "test"] -, Para [Code "unsplit",Space,Str "is",Space,Str "an",Space,Str "arrow",Space,Str "that",Space,Str "takes",Space,Str "a",Space,Str "pair",Space,Str "of",Space,Str "values",Space,Str "and",Space,Str "combines",Space,Str "them",Space,Str "to",Space,Str "return",Space,Str "a",Space,Str "single",Space,Str "value:"] +, Para [Code "unsplit",Space,Str "is",Space,Str "an",Space,Str "arrow",Space,Str "that",Space,Str "takes",Space,Str "a",Space,Str "pair",Space,Str "of",Space,Str "values",Space,Str "and",Space,Str "combines",Space,Str "them",Space,Str "to",Space,Str "return",Space,Str "a",Space,Str "single",Space,Str "value",Str ":"] , CodeBlock ("",["sourceCode","literate","haskell"],[]) "unsplit :: (Arrow a) => (b -> c -> d) -> a (b, c) d\nunsplit = arr . uncurry \n -- arr (\\op (x,y) -> x `op` y) " , Para [Code "(***)",Space,Str "combines",Space,Str "two",Space,Str "arrows",Space,Str "into",Space,Str "a",Space,Str "new",Space,Str "arrow",Space,Str "by",Space,Str "running",Space,Str "the",Space,Str "two",Space,Str "arrows",Space,Str "on",Space,Str "a",Space,Str "pair",Space,Str "of",Space,Str "values",Space,Str "(one",Space,Str "arrow",Space,Str "on",Space,Str "the",Space,Str "first",Space,Str "item",Space,Str "of",Space,Str "the",Space,Str "pair",Space,Str "and",Space,Str "one",Space,Str "arrow",Space,Str "on",Space,Str "the",Space,Str "second",Space,Str "item",Space,Str "of",Space,Str "the",Space,Str "pair)",Str "."] , CodeBlock ("",[],[]) "f *** g = first f >>> second g" -, Para [Str "Block",Space,Str "quote:"] +, Para [Str "Block",Space,Str "quote",Str ":"] , BlockQuote [ Para [Str "foo",Space,Str "bar"] ] ] diff --git a/tests/lhs-test.nohl.html b/tests/lhs-test.nohl.html new file mode 100644 index 000000000..feee89d4e --- /dev/null +++ b/tests/lhs-test.nohl.html @@ -0,0 +1,39 @@ + + + + + + + + +

lhs test

unsplit is an arrow that takes a pair of values and combines them to return a single value:

unsplit :: (Arrow a) => (b -> c -> d) -> a (b, c) d
+unsplit = arr . uncurry       
+          -- arr (\op (x,y) -> x `op` y) 
+

(***) combines two arrows into a new arrow by running the two arrows on a pair of values (one arrow on the first item of the pair and one arrow on the second item of the pair).

f *** g = first f >>> second g
+

Block quote:

foo bar

+ + diff --git a/tests/lhs-test.nohl.html+lhs b/tests/lhs-test.nohl.html+lhs new file mode 100644 index 000000000..ec364e796 --- /dev/null +++ b/tests/lhs-test.nohl.html+lhs @@ -0,0 +1,39 @@ + + + + + + + + +

lhs test

unsplit is an arrow that takes a pair of values and combines them to return a single value:

> unsplit :: (Arrow a) => (b -> c -> d) -> a (b, c) d
+> unsplit = arr . uncurry       
+>           -- arr (\op (x,y) -> x `op` y) 
+

(***) combines two arrows into a new arrow by running the two arrows on a pair of values (one arrow on the first item of the pair and one arrow on the second item of the pair).

f *** g = first f >>> second g
+

Block quote:

foo bar

+ + diff --git a/tests/test-pandoc.hs b/tests/test-pandoc.hs index 6c77b984c..c7ec67705 100644 --- a/tests/test-pandoc.hs +++ b/tests/test-pandoc.hs @@ -12,7 +12,9 @@ import System.FilePath ( (), (<.>) ) import System.Directory import System.Exit import Data.Algorithm.Diff -import Text.Pandoc.Shared ( substitute ) +import Text.Pandoc.Shared ( substitute, normalize, defaultWriterOptions ) +import Text.Pandoc.Writers.Native ( writeNative ) +import Text.Pandoc.Highlighting ( languages ) import Prelude hiding ( readFile ) import qualified Data.ByteString.Lazy as B import Data.ByteString.Lazy.UTF8 (toString) @@ -105,13 +107,15 @@ lhsWriterTests 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) + t n f = test n ["--columns=78", "-r", "native", "-s", "-w", f] "lhs-test.native" ("lhs-test" <.> ext f) + ext f = if null languages && format == "html" + then "nohl" <.> f + else f lhsReaderTest :: String -> Test lhsReaderTest format = - test "lhs" ["-r", format, "-w", "html+lhs"] ("lhs-test" <.> format) "lhs-test.fragment.html+lhs" - + testWithNormalize normalizer "lhs" ["-r", format, "-w", "native"] ("lhs-test" <.> format) "lhs-test.native" + where normalizer = writeNative defaultWriterOptions . normalize . read latexCitationTests :: String -> Test latexCitationTests n @@ -124,8 +128,8 @@ latexCitationTests n 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 + normalizer = substitute "\160" " " . substitute "\8211" "-" + t = testWithNormalize normalizer writerTests :: String -> [Test] writerTests format @@ -165,7 +169,7 @@ testWithNormalize :: (String -> String) -- ^ Normalize function for output -> String -- ^ Input filepath -> FilePath -- ^ Norm (for test results) filepath -> Test -testWithNormalize normalize testname opts inp norm = testCase testname $ do +testWithNormalize normalizer testname opts inp norm = testCase testname $ do (outputPath, hOut) <- openTempFile "" "pandoc-test" let inpPath = inp let normPath = norm @@ -175,8 +179,8 @@ testWithNormalize normalize testname opts inp norm = testCase testname $ do 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') + outputContents <- readFile' outputPath >>= return . filter (/='\r') . normalizer + normContents <- readFile' normPath >>= return . filter (/='\r') . normalizer if outputContents == normContents then return TestPassed else return $ TestFailed $ getDiff (lines outputContents) (lines normContents) -- cgit v1.2.3 From 715e33705f9c857c1bfd82f1f333b381d62feed4 Mon Sep 17 00:00:00 2001 From: John MacFarlane Date: Tue, 11 Jan 2011 18:02:50 -0800 Subject: test-pandoc: More diff-like diffs in case of test failure. --- tests/test-pandoc.hs | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) (limited to 'tests') diff --git a/tests/test-pandoc.hs b/tests/test-pandoc.hs index c7ec67705..0c70760dc 100644 --- a/tests/test-pandoc.hs +++ b/tests/test-pandoc.hs @@ -27,18 +27,18 @@ pandocPath = ".." "dist" "build" "pandoc" "pandoc" data TestResult = TestPassed | TestError ExitCode - | TestFailed [(DI, String)] + | TestFailed FilePath [(DI, String)] deriving (Eq) instance Show TestResult where show TestPassed = "PASSED" show (TestError ec) = "ERROR " ++ show ec - show (TestFailed d) = "FAILED\n" ++ showDiff d + show (TestFailed f d) = f ++ "\n--- expected test result\n+++ actual test result\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 ((F, ln) : ds) = "- " ++ ln ++ "\n" ++ showDiff ds +showDiff ((S, ln) : ds) = "+ " ++ ln ++ "\n" ++ showDiff ds showDiff ((B, _ ) : ds) = showDiff ds tests :: [Test] @@ -183,7 +183,7 @@ testWithNormalize normalizer testname opts inp norm = testCase testname $ do normContents <- readFile' normPath >>= return . filter (/='\r') . normalizer if outputContents == normContents then return TestPassed - else return $ TestFailed $ getDiff (lines outputContents) (lines normContents) + else return $ TestFailed normPath $ getDiff (lines outputContents) (lines normContents) else return $ TestError ec removeFile outputPath assertBool (show result) (result == TestPassed) -- cgit v1.2.3 From 51d9d8b674ea21c821113ec2bf92bb5e8a1cf067 Mon Sep 17 00:00:00 2001 From: John MacFarlane Date: Tue, 11 Jan 2011 18:10:46 -0800 Subject: test-pandoc: Fixed + and - in diff output, which were reversed. --- tests/test-pandoc.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'tests') diff --git a/tests/test-pandoc.hs b/tests/test-pandoc.hs index 0c70760dc..9773966b6 100644 --- a/tests/test-pandoc.hs +++ b/tests/test-pandoc.hs @@ -37,8 +37,8 @@ instance Show TestResult where showDiff :: [(DI, String)] -> String showDiff [] = "" -showDiff ((F, ln) : ds) = "- " ++ ln ++ "\n" ++ showDiff ds -showDiff ((S, ln) : ds) = "+ " ++ ln ++ "\n" ++ showDiff ds +showDiff ((F, ln) : ds) = "+ " ++ ln ++ "\n" ++ showDiff ds +showDiff ((S, ln) : ds) = "- " ++ ln ++ "\n" ++ showDiff ds showDiff ((B, _ ) : ds) = showDiff ds tests :: [Test] -- cgit v1.2.3 From 046c9c7d3b1c928b003497e05038e1cdaee85e50 Mon Sep 17 00:00:00 2001 From: John MacFarlane Date: Tue, 11 Jan 2011 18:15:24 -0800 Subject: test-pandoc: Relocated --columns=80 to just where it's needed. We only need it for certain table tests, because of the relative alignments. --- tests/test-pandoc.hs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) (limited to 'tests') diff --git a/tests/test-pandoc.hs b/tests/test-pandoc.hs index 9773966b6..ad581307b 100644 --- a/tests/test-pandoc.hs +++ b/tests/test-pandoc.hs @@ -45,7 +45,7 @@ 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"] + , test "tables" ["-r", "markdown", "-w", "native", "--columns=80"] "tables.txt" "tables.native" , test "more" ["-r", "markdown", "-w", "native", "-S"] "markdown-reader-more.txt" "markdown-reader-more.native" @@ -54,9 +54,9 @@ tests = [ testGroup "markdown" [ testGroup "writer" (writerTests "markdown" ++ l , testGroup "citations" markdownCitationTests ] , testGroup "rst" [ testGroup "writer" (writerTests "rst" ++ lhsWriterTests "rst") - , testGroup "reader" [ test "basic" ["-r", "rst", "-w", "native", "-s", "-S"] + , testGroup "reader" [ test "basic" ["-r", "rst", "-w", "native", "-s", "-S", "--columns=80"] "rst-reader.rst" "rst-reader.native" - , test "tables" ["-r", "rst", "-w", "native"] + , test "tables" ["-r", "rst", "-w", "native", "--columns=80"] "tables.rst" "tables-rstsubset.native" , lhsReaderTest "rst+lhs" ] @@ -173,7 +173,7 @@ testWithNormalize normalizer 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 + ph <- runProcess pandocPath ([inpPath] ++ ["--data-dir", ".."] ++ opts) Nothing (Just [("LANG","en_US.UTF-8"),("HOME", "./")]) Nothing (Just hOut) (Just stderr) ec <- waitForProcess ph result <- if ec == ExitSuccess -- cgit v1.2.3 From 530e3edc0f734dea454c7a542ca4e59a03cbe3fe Mon Sep 17 00:00:00 2001 From: John MacFarlane Date: Tue, 11 Jan 2011 18:29:38 -0800 Subject: test-pandoc: More informative diff output on test failure. Now the test suite tells you the exact command that was run, and the file containing the expected output. --- tests/test-pandoc.hs | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) (limited to 'tests') diff --git a/tests/test-pandoc.hs b/tests/test-pandoc.hs index ad581307b..586b807c2 100644 --- a/tests/test-pandoc.hs +++ b/tests/test-pandoc.hs @@ -27,13 +27,14 @@ pandocPath = ".." "dist" "build" "pandoc" "pandoc" data TestResult = TestPassed | TestError ExitCode - | TestFailed FilePath [(DI, String)] + | TestFailed String FilePath [(DI, String)] deriving (Eq) instance Show TestResult where show TestPassed = "PASSED" show (TestError ec) = "ERROR " ++ show ec - show (TestFailed f d) = f ++ "\n--- expected test result\n+++ actual test result\n" ++ showDiff d + show (TestFailed cmd file d) = cmd ++ "\n--- expected (" ++ file ++ ")" ++ + "\n+++ actual\n" ++ showDiff d showDiff :: [(DI, String)] -> String showDiff [] = "" @@ -173,7 +174,9 @@ testWithNormalize normalizer testname opts inp norm = testCase testname $ do (outputPath, hOut) <- openTempFile "" "pandoc-test" let inpPath = inp let normPath = norm - ph <- runProcess pandocPath ([inpPath] ++ ["--data-dir", ".."] ++ opts) Nothing + let options = ["--data-dir", ".."] ++ [inpPath] ++ opts + let cmd = pandocPath ++ " " ++ unwords options + ph <- runProcess pandocPath options Nothing (Just [("LANG","en_US.UTF-8"),("HOME", "./")]) Nothing (Just hOut) (Just stderr) ec <- waitForProcess ph result <- if ec == ExitSuccess @@ -183,7 +186,7 @@ testWithNormalize normalizer testname opts inp norm = testCase testname $ do normContents <- readFile' normPath >>= return . filter (/='\r') . normalizer if outputContents == normContents then return TestPassed - else return $ TestFailed normPath $ getDiff (lines outputContents) (lines normContents) + else return $ TestFailed cmd normPath $ getDiff (lines outputContents) (lines normContents) else return $ TestError ec removeFile outputPath assertBool (show result) (result == TestPassed) -- cgit v1.2.3 From cf5e8a824fe44ad65f1a3eb6255457667ba0cf70 Mon Sep 17 00:00:00 2001 From: John MacFarlane Date: Tue, 11 Jan 2011 19:10:35 -0800 Subject: test-pandoc: Improved header for diff output. --- tests/test-pandoc.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'tests') diff --git a/tests/test-pandoc.hs b/tests/test-pandoc.hs index 586b807c2..7b585a921 100644 --- a/tests/test-pandoc.hs +++ b/tests/test-pandoc.hs @@ -33,8 +33,8 @@ data TestResult = TestPassed instance Show TestResult where show TestPassed = "PASSED" show (TestError ec) = "ERROR " ++ show ec - show (TestFailed cmd file d) = cmd ++ "\n--- expected (" ++ file ++ ")" ++ - "\n+++ actual\n" ++ showDiff d + show (TestFailed cmd file d) = "\n--- " ++ file ++ + "\n+++ " ++ cmd ++ "\n" ++ showDiff d showDiff :: [(DI, String)] -> String showDiff [] = "" -- cgit v1.2.3 From 4f6099f350a878420b403af5413a806c06694207 Mon Sep 17 00:00:00 2001 From: Nathan Gass Date: Wed, 12 Jan 2011 13:11:08 +0100 Subject: Started implementing splitted test suite. Moved old tests into Old.hs and added new simple test-pandoc.hs for loading and grouping together tests from different files. Later commits will add more testfiles to the suite with more modular tests. --- tests/Old.hs | 188 +++++++++++++++++++++++++++++++++++++++++++++++++++ tests/test-pandoc.hs | 184 +------------------------------------------------ 2 files changed, 191 insertions(+), 181 deletions(-) create mode 100644 tests/Old.hs (limited to 'tests') diff --git a/tests/Old.hs b/tests/Old.hs new file mode 100644 index 000000000..af8cbbe3c --- /dev/null +++ b/tests/Old.hs @@ -0,0 +1,188 @@ + +module Old (tests) where + +import Test.Framework (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, normalize, defaultWriterOptions ) +import Text.Pandoc.Writers.Native ( writeNative ) +import Text.Pandoc.Highlighting ( languages ) +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 String FilePath [(DI, String)] + deriving (Eq) + +instance Show TestResult where + show TestPassed = "PASSED" + show (TestError ec) = "ERROR " ++ show ec + show (TestFailed cmd file d) = "\n--- " ++ file ++ + "\n+++ " ++ cmd ++ "\n" ++ showDiff d + +showDiff :: [(DI, String)] -> String +showDiff [] = "" +showDiff ((F, ln) : ds) = "+ " ++ ln ++ "\n" ++ showDiff ds +showDiff ((S, ln) : ds) = "- " ++ 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", "--columns=80"] + "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", "--columns=80"] + "rst-reader.rst" "rst-reader.native" + , test "tables" ["-r", "rst", "-w", "native", "--columns=80"] + "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" + ] + ] + +-- 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" <.> ext f) + ext f = if null languages && format == "html" + then "nohl" <.> f + else f + +lhsReaderTest :: String -> Test +lhsReaderTest format = + testWithNormalize normalizer "lhs" ["-r", format, "-w", "native"] ("lhs-test" <.> format) "lhs-test.native" + where normalizer = writeNative defaultWriterOptions . normalize . read + +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" + normalizer = substitute "\160" " " . substitute "\8211" "-" + t = testWithNormalize normalizer + +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 normalizer testname opts inp norm = testCase testname $ do + (outputPath, hOut) <- openTempFile "" "pandoc-test" + let inpPath = inp + let normPath = norm + let options = ["--data-dir", ".."] ++ [inpPath] ++ opts + let cmd = pandocPath ++ " " ++ unwords options + ph <- runProcess pandocPath options 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') . normalizer + normContents <- readFile' normPath >>= return . filter (/='\r') . normalizer + if outputContents == normContents + then return TestPassed + else return $ TestFailed cmd normPath $ 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 index 7b585a921..ae367fc53 100644 --- a/tests/test-pandoc.hs +++ b/tests/test-pandoc.hs @@ -2,191 +2,13 @@ module Main where -import Test.Framework (defaultMain, testGroup, Test ) -import Test.Framework.Providers.HUnit -import Test.HUnit ( assertBool ) +import Test.Framework -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, normalize, defaultWriterOptions ) -import Text.Pandoc.Writers.Native ( writeNative ) -import Text.Pandoc.Highlighting ( languages ) -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 String FilePath [(DI, String)] - deriving (Eq) - -instance Show TestResult where - show TestPassed = "PASSED" - show (TestError ec) = "ERROR " ++ show ec - show (TestFailed cmd file d) = "\n--- " ++ file ++ - "\n+++ " ++ cmd ++ "\n" ++ showDiff d - -showDiff :: [(DI, String)] -> String -showDiff [] = "" -showDiff ((F, ln) : ds) = "+ " ++ ln ++ "\n" ++ showDiff ds -showDiff ((S, ln) : ds) = "- " ++ ln ++ "\n" ++ showDiff ds -showDiff ((B, _ ) : ds) = showDiff ds +import qualified Old 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", "--columns=80"] - "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", "--columns=80"] - "rst-reader.rst" "rst-reader.native" - , test "tables" ["-r", "rst", "-w", "native", "--columns=80"] - "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" - ] +tests = [ testGroup "Old" Old.tests ] 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" <.> ext f) - ext f = if null languages && format == "html" - then "nohl" <.> f - else f - -lhsReaderTest :: String -> Test -lhsReaderTest format = - testWithNormalize normalizer "lhs" ["-r", format, "-w", "native"] ("lhs-test" <.> format) "lhs-test.native" - where normalizer = writeNative defaultWriterOptions . normalize . read - -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" - normalizer = substitute "\160" " " . substitute "\8211" "-" - t = testWithNormalize normalizer - -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 normalizer testname opts inp norm = testCase testname $ do - (outputPath, hOut) <- openTempFile "" "pandoc-test" - let inpPath = inp - let normPath = norm - let options = ["--data-dir", ".."] ++ [inpPath] ++ opts - let cmd = pandocPath ++ " " ++ unwords options - ph <- runProcess pandocPath options 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') . normalizer - normContents <- readFile' normPath >>= return . filter (/='\r') . normalizer - if outputContents == normContents - then return TestPassed - else return $ TestFailed cmd normPath $ getDiff (lines outputContents) (lines normContents) - else return $ TestError ec - removeFile outputPath - assertBool (show result) (result == TestPassed) -- cgit v1.2.3 From ec4deb25327cd525d188093918330149d0ead4e7 Mon Sep 17 00:00:00 2001 From: Nathan Gass Date: Wed, 12 Jan 2011 14:16:35 +0100 Subject: Added some basic testing infrastructure and some latex reader tests. --- pandoc.cabal | 5 ++++- tests/Helpers.hs | 37 +++++++++++++++++++++++++++++++++++++ tests/Latex/Reader.hs | 35 +++++++++++++++++++++++++++++++++++ tests/test-pandoc.hs | 3 +++ 4 files changed, 79 insertions(+), 1 deletion(-) create mode 100644 tests/Helpers.hs create mode 100644 tests/Latex/Reader.hs (limited to 'tests') diff --git a/pandoc.cabal b/pandoc.cabal index 71cb0135b..da855a07d 100644 --- a/pandoc.cabal +++ b/pandoc.cabal @@ -298,7 +298,10 @@ Executable test-pandoc if !flag(tests) Buildable: False else - Ghc-Options: -Wall + if impl(ghc >= 6.12) + Ghc-Options: -O2 -Wall -fno-warn-unused-do-bind + else + Ghc-Options: -O2 -Wall Extensions: CPP Build-Depends: base >= 4 && < 5, Diff, test-framework, test-framework-hunit, HUnit Other-Modules: Text.Pandoc.Shared, Text.Pandoc.Highlighting, Text.Pandoc.Writers.Native diff --git a/tests/Helpers.hs b/tests/Helpers.hs new file mode 100644 index 000000000..c61207153 --- /dev/null +++ b/tests/Helpers.hs @@ -0,0 +1,37 @@ +module Helpers where + +import Text.Pandoc + +import Test.Framework +import Test.Framework.Providers.HUnit +import Test.HUnit hiding (Test) + +data Expect = Inline Inline + | Inlines [Inline] + | Block Block + | Blocks [Block] + +assertPandoc :: Expect -> Pandoc -> Assertion +assertPandoc (Inline e) (Pandoc _ [Para [g]]) = e @=? g +assertPandoc (Inlines e) (Pandoc _ [Para g] ) = e @=? g +assertPandoc (Block e) (Pandoc _ [g] ) = e @=? g +assertPandoc (Blocks e) (Pandoc _ g ) = e @=? g +assertPandoc _ _ = assertFailure "Wrong structur of Pandoc document." + +latexTest :: String-> String -> Expect -> Test +latexTest = latexTestWithState defaultParserState + +latexTestWithState :: ParserState -> String -> String -> Expect -> Test +latexTestWithState state name string exp = testCase name $ exp `assertPandoc` readLaTeX state string + +blocks :: [Block] -> Pandoc +blocks bs = Pandoc (Meta { docTitle = [], docAuthors = [], docDate = [] }) bs + +block :: Block -> Pandoc +block b = blocks [b] + +inlines :: [Inline] -> Pandoc +inlines is = block $ Para is + +inline :: Inline -> Pandoc +inline i = inlines [i] diff --git a/tests/Latex/Reader.hs b/tests/Latex/Reader.hs new file mode 100644 index 000000000..d313b33eb --- /dev/null +++ b/tests/Latex/Reader.hs @@ -0,0 +1,35 @@ +module Latex.Reader (tests) where + +import Text.Pandoc.Definition + +import Test.Framework +import Helpers + +tests :: [Test] +tests = [ testGroup "basic" [ latexTest "simplest" "word" + (Inline $ Str "word") + + , latexTest "space" "some text" + (Inlines $ [Str "some", Space, Str "text"]) + + , latexTest "emphasis" "\\emph{emphasized}" + (Inline $ Emph [Str "emphasized"]) + ] + + , testGroup "headers" [ latexTest "1. level" "\\section{header}" + $ Block $ Header 1 [Str "header"] + + , latexTest "2. level" "\\subsection{header}" + $ Block $ Header 2 [Str "header"] + + , latexTest "3. level" "\\subsubsection{header}" + $ Block $ Header 3 [Str "header"] + + , latexTest "with emphasis" "\\section{text \\emph{emph}}" + $ Block $ Header 1 [Str "text", Space, Emph [Str "emph"]] + + , latexTest "with link" "\\section{text \\href{/url}{link}}" + $ Block $ Header 1 [Str "text", Space, Link [Str "link"] ("/url", "")] + ] + ] + diff --git a/tests/test-pandoc.hs b/tests/test-pandoc.hs index ae367fc53..cf7a7e5e4 100644 --- a/tests/test-pandoc.hs +++ b/tests/test-pandoc.hs @@ -5,9 +5,12 @@ module Main where import Test.Framework import qualified Old +import qualified Latex.Reader tests :: [Test] tests = [ testGroup "Old" Old.tests + , testGroup "Latex" [ testGroup "Reader" Latex.Reader.tests + ] ] main :: IO () -- cgit v1.2.3 From ff74c51b532f05303343b4c9de3a8c392298c014 Mon Sep 17 00:00:00 2001 From: Nathan Gass Date: Wed, 12 Jan 2011 14:44:32 +0100 Subject: Remove some accidentally commited functions. Fixed a type and alignment. --- tests/Helpers.hs | 19 ++++--------------- 1 file changed, 4 insertions(+), 15 deletions(-) (limited to 'tests') diff --git a/tests/Helpers.hs b/tests/Helpers.hs index c61207153..a8732fa7a 100644 --- a/tests/Helpers.hs +++ b/tests/Helpers.hs @@ -12,11 +12,11 @@ data Expect = Inline Inline | Blocks [Block] assertPandoc :: Expect -> Pandoc -> Assertion -assertPandoc (Inline e) (Pandoc _ [Para [g]]) = e @=? g +assertPandoc (Inline e) (Pandoc _ [Para [g]]) = e @=? g assertPandoc (Inlines e) (Pandoc _ [Para g] ) = e @=? g -assertPandoc (Block e) (Pandoc _ [g] ) = e @=? g -assertPandoc (Blocks e) (Pandoc _ g ) = e @=? g -assertPandoc _ _ = assertFailure "Wrong structur of Pandoc document." +assertPandoc (Block e) (Pandoc _ [g] ) = e @=? g +assertPandoc (Blocks e) (Pandoc _ g ) = e @=? g +assertPandoc _ _ = assertFailure "Wrong structure of Pandoc document." latexTest :: String-> String -> Expect -> Test latexTest = latexTestWithState defaultParserState @@ -24,14 +24,3 @@ latexTest = latexTestWithState defaultParserState latexTestWithState :: ParserState -> String -> String -> Expect -> Test latexTestWithState state name string exp = testCase name $ exp `assertPandoc` readLaTeX state string -blocks :: [Block] -> Pandoc -blocks bs = Pandoc (Meta { docTitle = [], docAuthors = [], docDate = [] }) bs - -block :: Block -> Pandoc -block b = blocks [b] - -inlines :: [Inline] -> Pandoc -inlines is = block $ Para is - -inline :: Inline -> Pandoc -inline i = inlines [i] -- cgit v1.2.3 From a2f562719d858f56dbbcdf783900cde6a41d01df Mon Sep 17 00:00:00 2001 From: John MacFarlane Date: Wed, 12 Jan 2011 08:17:38 -0800 Subject: Updated lhs tests for new positioning of . --- tests/lhs-test.html | 2 +- tests/lhs-test.html+lhs | 2 +- tests/lhs-test.nohl.html | 2 +- tests/lhs-test.nohl.html+lhs | 2 +- 4 files changed, 4 insertions(+), 4 deletions(-) (limited to 'tests') diff --git a/tests/lhs-test.html b/tests/lhs-test.html index 5a0f27af7..2c4bedc00 100644 --- a/tests/lhs-test.html +++ b/tests/lhs-test.html @@ -1,9 +1,9 @@ <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"> <html xmlns="http://www.w3.org/1999/xhtml"> <head> - <title> +