summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJohn MacFarlane <jgm@berkeley.edu>2011-01-11 17:36:58 -0800
committerNathan Gass <gass@search.ch>2011-01-12 11:35:10 +0100
commiteb1d0148596b91c2887233e034411763196490a5 (patch)
tree2a3ca115e319249d4edd4a17ce7327cef17406d7
parent3bc0a55af0994f34c1d7b2ebdc8b960f0f713ebf (diff)
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.
-rw-r--r--Setup.hs11
-rw-r--r--pandoc.cabal7
-rw-r--r--tests/lhs-test.native4
-rw-r--r--tests/lhs-test.nohl.html39
-rw-r--r--tests/lhs-test.nohl.html+lhs39
-rw-r--r--tests/test-pandoc.hs24
6 files changed, 103 insertions, 21 deletions
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 @@
+<!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) =&gt; (b -&gt; c -&gt; d) -&gt; a (b, c) d
+unsplit = arr . uncurry
+ -- arr (\op (x,y) -&gt; 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 &gt;&gt;&gt; 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
+ >&gt; unsplit :: (Arrow a) =&gt; (b -&gt; c -&gt; d) -&gt; a (b, c) d
+&gt; unsplit = arr . uncurry
+&gt; -- arr (\op (x,y) -&gt; 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 &gt;&gt;&gt; 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)