eb1d014 · typeable/pandoc

git.iko.soy/typeable/pandoc

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.

commiteb1d0148596b91c2887233e034411763196490a5 authorJohn MacFarlane <jgm@berkeley.edu> dateTue 11 Jan 2011, 17:36 (16 years ago) parent3bc0a55

6 files changed+103−21

compare with master

unifiedsplit

Setup.hs+3−8 pandoc.cabal+6−1 tests/lhs-test.native+2−2 tests/lhs-test.nohl.html+39 tests/lhs-test.nohl.html+lhs+39 tests/test-pandoc.hs+14−10

Setup.hs+3−8

@@ -38,17 +38,12 @@ main = do

3838

3939-- | Run test suite.

4040runTestSuite :: Args -> Bool -> PackageDescription -> LocalBuildInfo -> IO a

41−runTestSuite _ _ pkg lbi = do

41+runTestSuite args _ pkg lbi = do

4242 let testDir = buildDir lbi </> "test-pandoc"

4343 testDir' <- canonicalizePath testDir

44+ let testArgs = concatMap (\arg -> ["-t",arg]) args

4445 if any id [buildable (buildInfo exe) | exe <- executables pkg, exeName exe == "test-pandoc"]

45− then do

46− let isHighlightingKate (Dependency (PackageName "highlighting-kate") _) = True

47− isHighlightingKate _ = False

48− let highlightingSupport = any isHighlightingKate $ buildDepends pkg

49− let testArgs = if highlightingSupport then [] else ["-t", "!lhs"]

50− inDirectory "tests" $ rawSystem (testDir' </> "test-pandoc")

51− testArgs >>= exitWith

46+ then inDirectory "tests" $ rawSystem (testDir' </> "test-pandoc") testArgs >>= exitWith

5247 else do

5348 putStrLn "Build pandoc with the 'tests' flag to run tests"

5449 exitWith $ ExitFailure 3

pandoc.cabal+6−1

@@ -136,6 +136,8 @@ Extra-Source-Files:

136136 tests/lhs-test.latex+lhs,

137137 tests/lhs-test.html,

138138 tests/lhs-test.html+lhs,

139+ tests/lhs-test.nohl.html,

140+ tests/lhs-test.nohl.html+lhs,

139141 tests/lhs-test.fragment.html+lhs

140142Extra-Tmp-Files: man/man1/pandoc.1, man/man1/markdown2pdf.1

141143

@@ -291,9 +293,12 @@ Executable markdown2pdf

291293Executable test-pandoc

292294 Hs-Source-Dirs: tests, src

293295 Main-Is: test-pandoc.hs

296+ if flag(highlighting)

297+ cpp-options: -D_HIGHLIGHTING

294298 if !flag(tests)

295299 Buildable: False

296300 else

297301 Ghc-Options: -Wall

302+ Extensions: CPP

298303 Build-Depends: base >= 4 && < 5, Diff, test-framework, test-framework-hunit, HUnit

299− Other-Modules: Text.Pandoc.Shared

304+ Other-Modules: Text.Pandoc.Shared, Text.Pandoc.Highlighting, Text.Pandoc.Writers.Native

tests/lhs-test.native+2−2

@@ -1,10 +1,10 @@

11Pandoc (Meta {docTitle = [], docAuthors = [], docDate = []})

22[ Header 1 [Str "lhs",Space,Str "test"]

3−, 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:"]

3+, 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 ":"]

44, 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) "

55, 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 "."]

66, CodeBlock ("",[],[]) "f *** g = first f >>> second g"

7−, Para [Str "Block",Space,Str "quote:"]

7+, Para [Str "Block",Space,Str "quote",Str ":"]

88, BlockQuote

99 [ Para [Str "foo",Space,Str "bar"] ]

1010 ]

tests/lhs-test.nohl.htmlnew file+39

@@ -0,0 +1,39 @@

1+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">

2+<html xmlns="http://www.w3.org/1999/xhtml">

3+<head>

4+ <title></title>

5+ <meta http-equiv="Content-Type" content="text/html; charset=utf-8" />

6+ <meta name="generator" content="pandoc" />

7+</head>

8+<body>

9+<h1 id="lhs-test"

10+>lhs test</h1

11+><p

12+><code

13+ >unsplit</code

14+ > is an arrow that takes a pair of values and combines them to return a single value:</p

15+><pre class="sourceCode haskell"

16+><code

17+ >unsplit :: (Arrow a) => (b -> c -> d) -> a (b, c) d

18+unsplit = arr . uncurry

19+ -- arr (\op (x,y) -> x `op` y)

20+</code

21+ ></pre

22+><p

23+><code

24+ >(***)</code

25+ > 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

26+><pre

27+><code

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

29+</code

30+ ></pre

31+><p

32+>Block quote:</p

33+><blockquote

34+><p

35+ >foo bar</p

36+ ></blockquote

37+>

38+</body>

39+</html>

tests/lhs-test.nohl.html+lhsnew file+39

@@ -0,0 +1,39 @@

1+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">

2+<html xmlns="http://www.w3.org/1999/xhtml">

3+<head>

4+ <title></title>

5+ <meta http-equiv="Content-Type" content="text/html; charset=utf-8" />

6+ <meta name="generator" content="pandoc" />

7+</head>

8+<body>

9+<h1 id="lhs-test"

10+>lhs test</h1

11+><p

12+><code

13+ >unsplit</code

14+ > is an arrow that takes a pair of values and combines them to return a single value:</p

15+><pre class="sourceCode literate haskell"

16+><code

17+ >> unsplit :: (Arrow a) => (b -> c -> d) -> a (b, c) d

18+> unsplit = arr . uncurry

19+> -- arr (\op (x,y) -> x `op` y)

20+</code

21+ ></pre

22+><p

23+><code

24+ >(***)</code

25+ > 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

26+><pre

27+><code

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

29+</code

30+ ></pre

31+><p

32+>Block quote:</p

33+><blockquote

34+><p

35+ >foo bar</p

36+ ></blockquote

37+>

38+</body>

39+</html>

tests/test-pandoc.hs+14−10

@@ -12,7 +12,9 @@ import System.FilePath ( (</>), (<.>) )

1212import System.Directory

1313import System.Exit

1414import Data.Algorithm.Diff

15−import Text.Pandoc.Shared ( substitute )

15+import Text.Pandoc.Shared ( substitute, normalize, defaultWriterOptions )

16+import Text.Pandoc.Writers.Native ( writeNative )

17+import Text.Pandoc.Highlighting ( languages )

1618import Prelude hiding ( readFile )

1719import qualified Data.ByteString.Lazy as B

1820import Data.ByteString.Lazy.UTF8 (toString)

@@ -105,13 +107,15 @@ lhsWriterTests format

105107 , t "lhs to lhs" (format ++ "+lhs")

106108 ]

107109 where

108− t n f = test n ["--columns=78", "-r", "native", "-s", "-w", f]

109− "lhs-test.native" ("lhs-test" <.> f)

110+ t n f = test n ["--columns=78", "-r", "native", "-s", "-w", f] "lhs-test.native" ("lhs-test" <.> ext f)

111+ ext f = if null languages && format == "html"

112+ then "nohl" <.> f

113+ else f

110114

111115lhsReaderTest :: String -> Test

112116lhsReaderTest format =

113− test "lhs" ["-r", format, "-w", "html+lhs"] ("lhs-test" <.> format) "lhs-test.fragment.html+lhs"

114−

117+ testWithNormalize normalizer "lhs" ["-r", format, "-w", "native"] ("lhs-test" <.> format) "lhs-test.native"

118+ where normalizer = writeNative defaultWriterOptions . normalize . read

115119

116120latexCitationTests :: String -> Test

117121latexCitationTests n

@@ -124,8 +128,8 @@ latexCitationTests n

124128 where

125129 o = ["--bibliography", "biblio.bib", "--csl", "chicago-author-date.csl", "--no-citeproc", "--" ++ n]

126130 f = n ++ "-citations.latex"

127− normalize = substitute "\160" " " . substitute "\8211" "-"

128− t = testWithNormalize normalize

131+ normalizer = substitute "\160" " " . substitute "\8211" "-"

132+ t = testWithNormalize normalizer

129133

130134writerTests :: String -> [Test]

131135writerTests format

@@ -165,7 +169,7 @@ testWithNormalize :: (String -> String) -- ^ Normalize function for output

165169 -> String -- ^ Input filepath

166170 -> FilePath -- ^ Norm (for test results) filepath

167171 -> Test

168−testWithNormalize normalize testname opts inp norm = testCase testname $ do

172+testWithNormalize normalizer testname opts inp norm = testCase testname $ do

169173 (outputPath, hOut) <- openTempFile "" "pandoc-test"

170174 let inpPath = inp

171175 let normPath = norm

@@ -175,8 +179,8 @@ testWithNormalize normalize testname opts inp norm = testCase testname $ do

175179 result <- if ec == ExitSuccess

176180 then do

177181 -- filter \r so the tests will work on Windows machines

178− outputContents <- readFile' outputPath >>= return . filter (/='\r') . normalize

179− normContents <- readFile' normPath >>= return . filter (/='\r')

182+ outputContents <- readFile' outputPath >>= return . filter (/='\r') . normalizer

183+ normContents <- readFile' normPath >>= return . filter (/='\r') . normalizer

180184 if outputContents == normContents

181185 then return TestPassed

182186 else return $ TestFailed $ getDiff (lines outputContents) (lines normContents)