diff options
| -rw-r--r-- | Setup.hs | 11 | ||||
| -rw-r--r-- | pandoc.cabal | 7 | ||||
| -rw-r--r-- | tests/lhs-test.native | 4 | ||||
| -rw-r--r-- | tests/lhs-test.nohl.html | 39 | ||||
| -rw-r--r-- | tests/lhs-test.nohl.html+lhs | 39 | ||||
| -rw-r--r-- | tests/test-pandoc.hs | 24 |
6 files changed, 103 insertions, 21 deletions
@@ -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 @@ +<!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></title> + <meta http-equiv="Content-Type" content="text/html; charset=utf-8" /> + <meta name="generator" content="pandoc" /> +</head> +<body> +<h1 id="lhs-test" +>lhs test</h1 +><p +><code + >unsplit</code + > is an arrow that takes a pair of values and combines them to return a single value:</p +><pre class="sourceCode haskell" +><code + >unsplit :: (Arrow a) => (b -> c -> d) -> a (b, c) d +unsplit = arr . uncurry + -- arr (\op (x,y) -> x `op` y) +</code + ></pre +><p +><code + >(***)</code + > 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).</p +><pre +><code + >f *** g = first f >>> second g +</code + ></pre +><p +>Block quote:</p +><blockquote +><p + >foo bar</p + ></blockquote +> +</body> +</html> 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 @@ +<!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></title> + <meta http-equiv="Content-Type" content="text/html; charset=utf-8" /> + <meta name="generator" content="pandoc" /> +</head> +<body> +<h1 id="lhs-test" +>lhs test</h1 +><p +><code + >unsplit</code + > is an arrow that takes a pair of values and combines them to return a single value:</p +><pre class="sourceCode literate haskell" +><code + >> unsplit :: (Arrow a) => (b -> c -> d) -> a (b, c) d +> unsplit = arr . uncurry +> -- arr (\op (x,y) -> x `op` y) +</code + ></pre +><p +><code + >(***)</code + > 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).</p +><pre +><code + >f *** g = first f >>> second g +</code + ></pre +><p +>Block quote:</p +><blockquote +><p + >foo bar</p + ></blockquote +> +</body> +</html> 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) |