a0e19ba · typeable/pandoc

git.iko.soy/typeable/pandoc

Merge branch 'tests'

commita0e19ba8aaa9304e9b0d1079e8357412e0402d0d authorJohn MacFarlane <jgm@berkeley.edu> dateSat 15 Jan 2011, 09:25 (16 years ago) parent8ad6e01 dc93073

11 files changed+571−233

compare with master

unifiedsplit

Setup.hs+3−8 pandoc.cabal+17−4 src/test-pandoc.hs−219 tests/Tests/Arbitrary.hs+167 tests/Tests/Helpers.hs+34 tests/Tests/Old.hs+216 tests/Tests/Readers/LaTeX.hs+36 tests/lhs-test.native+2−2 tests/lhs-test.nohl.html+39 tests/lhs-test.nohl.html+lhs+39 tests/test-pandoc.hs+18

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 = ["lhs" | highlightingSupport]

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+17−4

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

150150 tests/lhs-test.latex+lhs,

151151 tests/lhs-test.html,

152152 tests/lhs-test.html+lhs,

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

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

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

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

155157

@@ -303,11 +305,22 @@ Executable markdown2pdf

303305 Buildable: False

304306

305307Executable test-pandoc

306− Hs-Source-Dirs: src

308+ Hs-Source-Dirs: tests, src

307309 Main-Is: test-pandoc.hs

310+ if flag(highlighting)

311+ cpp-options: -D_HIGHLIGHTING

308312 if !flag(tests)

309313 Buildable: False

310314 else

311− Ghc-Options: -Wall

312− Build-Depends: base >= 4 && < 5, Diff

313− Other-Modules: Text.Pandoc.Shared

315+ if impl(ghc >= 6.12)

316+ Ghc-Options: -Wall -fno-warn-unused-do-bind

317+ else

318+ Ghc-Options: -Wall

319+ Extensions: CPP

320+ Build-Depends: base >= 4 && < 5, Diff, test-framework >= 0.3 && < 0.4,

321+ test-framework-hunit >= 0.2 && < 0.3,

322+ HUnit >= 1.2 && < 1.3

323+ Other-Modules: Tests.Old

324+ Tests.Helpers

325+ Tests.Arbitrary

326+ Tests.Readers.LaTeX

src/test-pandoc.hsdeleted−219

@@ -1,219 +0,0 @@

1−{-# OPTIONS_GHC -Wall #-}

2−-- RunTests.hs - run test suite for pandoc

3−-- This script is designed to be run from the tests directory.

4−-- It assumes the pandoc executable is in dist/build/pandoc.

5−--

6−-- runhaskell -i.. RunTests.hs [lhs]

7−--

8−-- If the lhs argument is provided, tests for lhs support will be

9−-- run. These presuppose that pandoc has been compiled with the

10−-- -fhighlighting flag, so these tests are not run by default.

11−--

12−-- This program assumes that the Diff package has been installed:

13−-- cabal install Diff

14−

15−module Main where

16−import System.IO ( openTempFile, stderr, stdout, hFlush )

17−import System.Process ( runProcess, waitForProcess )

18−import System.FilePath ( (</>), (<.>) )

19−import System.Directory

20−import System.Environment

21−import System.Exit

22−import Text.Printf

23−import Data.Algorithm.Diff

24−import Text.Pandoc.Shared ( substitute )

25−import Prelude hiding ( readFile )

26−import qualified Data.ByteString.Lazy as B

27−import Data.ByteString.Lazy.UTF8 (toString, fromString)

28−

29−readFileUTF8 :: FilePath -> IO String

30−readFileUTF8 f = B.readFile f >>= return . toString

31−

32−pandocPath :: FilePath

33−pandocPath = ".." </> "dist" </> "build" </> "pandoc" </> "pandoc"

34−

35−data TestResult = TestPassed

36− | TestError ExitCode

37− | TestFailed [(DI, String)]

38− deriving (Eq)

39−

40−instance Show TestResult where

41− show TestPassed = "PASSED"

42− show (TestError ec) = "ERROR " ++ show ec

43− show (TestFailed d) = "FAILED\n" ++ showDiff d

44−

45−showDiff :: [(DI, String)] -> String

46−showDiff [] = ""

47−showDiff ((F, ln) : ds) = "|TEST| " ++ ln ++ "\n" ++ showDiff ds

48−showDiff ((S, ln) : ds) = "|NORM| " ++ ln ++ "\n" ++ showDiff ds

49−showDiff ((B, _ ) : ds) = showDiff ds

50−

51−writerFormats :: [String]

52−writerFormats = [ "native"

53− , "html"

54− , "docbook"

55− , "opendocument"

56− , "latex"

57− , "context"

58− , "texinfo"

59− , "man"

60− , "plain"

61− , "markdown"

62− , "rst"

63− , "mediawiki"

64− , "textile"

65− , "rtf"

66− , "org"

67− ]

68−

69−lhsWriterFormats :: [String]

70−lhsWriterFormats = [ "markdown"

71− , "markdown+lhs"

72− , "rst"

73− , "rst+lhs"

74− , "latex"

75− , "latex+lhs"

76− , "html"

77− , "html+lhs"

78− ]

79−

80−lhsReaderFormats :: [String]

81−lhsReaderFormats = [ "markdown+lhs"

82− , "rst+lhs"

83− , "latex+lhs"

84− ]

85−

86−main :: IO ()

87−main = do

88− args <- getArgs

89− let runLhsTests = "lhs" `elem` args

90− r1s <- mapM runWriterTest writerFormats

91− r2 <- runS5WriterTest "basic" ["-s"] "s5"

92− r3 <- runS5WriterTest "fancy" ["-s","-m","-i"] "s5"

93− r4 <- runS5WriterTest "fragment" [] "html"

94− r5 <- runS5WriterTest "inserts" ["-s", "-H", "insert",

95− "-B", "insert", "-A", "insert", "-c", "main.css"] "html"

96− r6 <- runTest "markdown reader" ["-r", "markdown", "-w", "native", "-s", "-S"]

97− "testsuite.txt" "testsuite.native"

98− r7 <- runTest "markdown reader (tables)" ["-r", "markdown", "-w", "native"]

99− "tables.txt" "tables.native"

100− r7a <- runTest "markdown reader (more)" ["-r", "markdown", "-w", "native", "-S"]

101− "markdown-reader-more.txt" "markdown-reader-more.native"

102− r8 <- runTest "rst reader" ["-r", "rst", "-w", "native", "-s", "-S"]

103− "rst-reader.rst" "rst-reader.native"

104− r8a <- runTest "rst reader (tables)" ["-r", "rst", "-w", "native"]

105− "tables.rst" "tables-rstsubset.native"

106− r9 <- runTest "html reader" ["-r", "html", "-w", "native", "-s"]

107− "html-reader.html" "html-reader.native"

108− r10 <- runTest "latex reader" ["-r", "latex", "-w", "native", "-s", "-R"]

109− "latex-reader.latex" "latex-reader.native"

110− rTextile1 <- runTest "textile reader" ["-r", "textile", "-w", "native", "-s"]

111− "textile-reader.textile" "textile-reader.native"

112− r11 <- runTest "native reader" ["-r", "native", "-w", "native", "-s"]

113− "testsuite.native" "testsuite.native"

114− 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"]

115− let citopts = ["--bibliography", "biblio.bib", "--csl", "chicago-author-date.csl", "--no-citeproc"]

116− r15 <- runTest "markdown writer (citations)" (["-r", "markdown", "-w", "markdown", "--no-wrap"] ++ citopts)

117− "markdown-citations.txt" "markdown-citations.txt"

118− r16s <- runLatexCitationTests citopts "biblatex"

119− r17s <- runLatexCitationTests citopts "natbib"

120− r12s <- if runLhsTests

121− then mapM runLhsWriterTest lhsWriterFormats

122− else putStrLn "Skipping lhs writer tests because they presuppose highlighting support" >> return []

123− r13s <- if runLhsTests

124− then mapM runLhsReaderTest lhsReaderFormats

125− else putStrLn "Skipping lhs reader tests because they presuppose highlighting support" >> return []

126− let results = r1s ++

127−

128− [ r2, r3, r4, r5 -- S5

129− , r6, r7, r7a -- markdown reader

130− , r8, r8a -- rst

131− , r9 -- html

132− , r10 -- latex

133− , rTextile1 -- textile

134− , r11 -- native

135− , r15 -- markdown citations

136− ] ++ r12s ++ r13s ++ r14s ++ r16s ++ r17s

137− if all id results

138− then do

139− putStrLn "\nAll tests passed."

140− exitWith ExitSuccess

141− else do

142− let failures = length $ filter not results

143− putStrLn $ "\n" ++ show failures ++ " tests failed."

144− exitWith (ExitFailure failures)

145−

146−-- makes sure file is fully closed after reading

147−readFile' :: FilePath -> IO String

148−readFile' f = do s <- readFileUTF8 f

149− return $! (length s `seq` s)

150−

151−runLhsWriterTest :: String -> IO Bool

152−runLhsWriterTest format =

153− runTest ("(lhs) " ++ format ++ " writer") ["--columns=78", "-r", "native", "-s", "-w", format] "lhs-test.native" ("lhs-test" <.> format)

154−

155−runLhsReaderTest :: String -> IO Bool

156−runLhsReaderTest format =

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

158−

159−

160−runLatexCitationTests :: [String] -> String -> IO [Bool]

161−runLatexCitationTests o n

162− = sequence [ rt ("latex reader (" ++ n ++ " citations)") (["-r", "latex", "-w", "markdown", "-s", "--no-wrap"] ++ o')

163− f "markdown-citations.txt"

164− , rt ("latex writer (" ++ n ++ " citations)") (["-r", "markdown", "-w", "latex", "-s", "--no-wrap"] ++ o')

165− "markdown-citations.txt" f

166− ]

167− where

168− o' = o ++ ["--" ++ n]

169− f = n ++ "-citations.latex"

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

171− rt = runTestWithNormalize normalize

172−

173−runWriterTest :: String -> IO Bool

174−runWriterTest format = do

175− r1 <- runTest (format ++ " writer") ["-r", "native", "-s", "-w", format, "--columns=78"] "testsuite.native" ("writer" <.> format)

176− r2 <- runTest (format ++ " writer (tables)") ["-r", "native", "-w", format, "--columns=78"] "tables.native" ("tables" <.> format)

177− return (r1 && r2)

178−

179−runS5WriterTest :: String -> [String] -> String -> IO Bool

180−runS5WriterTest modifier opts format = runTest (format ++ " writer (" ++ modifier ++ ")")

181− (["-r", "native", "-w", format] ++ opts) "s5.native" ("s5." ++ modifier <.> "html")

182−

183−

184−-- | Run a test without normalize function, return True if test passed.

185−runTest :: String -- ^ Title of test

186− -> [String] -- ^ Options to pass to pandoc

187− -> String -- ^ Input filepath

188− -> FilePath -- ^ Norm (for test results) filepath

189− -> IO Bool

190−runTest = runTestWithNormalize id

191−

192−-- | Run a test with normalize function, return True if test passed.

193−runTestWithNormalize :: (String -> String) -- ^ Normalize function for output

194− -> String -- ^ Title of test

195− -> [String] -- ^ Options to pass to pandoc

196− -> String -- ^ Input filepath

197− -> FilePath -- ^ Norm (for test results) filepath

198− -> IO Bool

199−runTestWithNormalize normalize testname opts inp norm = do

200− putStr $ printf "%-28s ---> " testname

201− (outputPath, hOut) <- openTempFile "" "pandoc-test"

202− let inpPath = inp

203− let normPath = norm

204− hFlush stdout

205− ph <- runProcess pandocPath (["--columns=80"] ++ [inpPath] ++ ["--data-dir", ".."] ++ opts) Nothing

206− (Just [("LANG","en_US.UTF-8"),("HOME", "./")]) Nothing (Just hOut) (Just stderr)

207− ec <- waitForProcess ph

208− result <- if ec == ExitSuccess

209− then do

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

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

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

213− if outputContents == normContents

214− then return TestPassed

215− else return $ TestFailed $ getDiff (lines outputContents) (lines normContents)

216− else return $ TestError ec

217− removeFile outputPath

218− B.putStrLn (fromString $ show result)

219− return (result == TestPassed)

tests/Tests/Arbitrary.hsnew file+167

@@ -0,0 +1,167 @@

1+{-# OPTIONS_GHC -fno-warn-orphans #-}

2+-- provides Arbitrary instance for Pandoc types

3+module Tests.Arbitrary ()

4+where

5+import Test.QuickCheck.Gen

6+import Test.QuickCheck.Arbitrary

7+import Control.Monad (liftM, liftM2)

8+import Text.Pandoc

9+import Text.Pandoc.Shared

10+

11+realString :: Gen String

12+realString = elements wordlist

13+

14+wordlist :: [String]

15+wordlist = ["foo","Bar","baz","\\","/",":","\"","'","féé"]

16+

17+instance Arbitrary Inline where

18+ arbitrary = resize 3 $ arbInline 3

19+

20+-- restrict to 3 levels of nesting max; otherwise we get

21+-- bogged down in indefinitely large structures

22+arbInline :: Int -> Gen Inline

23+arbInline n = frequency $ [ (60, liftM Str realString)

24+ , (60, return Space)

25+ , (10, liftM Code realString)

26+ , (5, return EmDash)

27+ , (5, return EnDash)

28+ , (5, return Apostrophe)

29+ , (5, return Ellipses)

30+ ] ++ [ x | x <- nesters, n > 1]

31+ where nesters = [ (10, liftM Emph $ listOf $ arbInline (n-1))

32+ , (10, liftM Strong $ listOf $ arbInline (n-1))

33+ , (10, liftM Strikeout $ listOf $ arbInline (n-1))

34+ , (10, liftM Superscript $ listOf $ arbInline (n-1))

35+ , (10, liftM Subscript $ listOf $ arbInline (n-1))

36+ , (10, liftM SmallCaps $ listOf $ arbInline (n-1))

37+ , (10, do x1 <- arbitrary

38+ x2 <- listOf $ arbInline (n-1)

39+ return $ Quoted x1 x2)

40+ , (10, do x1 <- arbitrary

41+ x2 <- realString

42+ return $ Math x1 x2)

43+ , (10, do x1 <- listOf $ arbInline (n-1)

44+ x3 <- realString

45+ x2 <- realString

46+ return $ Link x1 (x2,x3))

47+ , (10, do x1 <- listOf $ arbInline (n-1)

48+ x3 <- realString

49+ x2 <- realString

50+ return $ Image x1 (x2,x3))

51+ , (2, liftM Note $ resize 3 $ listOf1 arbitrary)

52+ ]

53+

54+instance Arbitrary Block where

55+ arbitrary = resize 3 $ arbBlock 3

56+

57+arbBlock :: Int -> Gen Block

58+arbBlock n = frequency $ [ (10, liftM Plain arbitrary)

59+ , (15, liftM Para arbitrary)

60+ , (5, liftM2 CodeBlock arbitrary realString)

61+ , (2, liftM RawHtml realString)

62+ , (5, do x1 <- choose (1 :: Int, 6)

63+ x2 <- arbitrary

64+ return (Header x1 x2))

65+ , (2, return HorizontalRule)

66+ ] ++ [x | x <- nesters, n > 0]

67+ where nesters = [ (5, liftM BlockQuote $ listOf $ arbBlock (n-1))

68+ , (5, liftM2 OrderedList arbitrary

69+ $ (listOf $ listOf $ arbBlock (n-1)))

70+ , (5, liftM BulletList $ (listOf $ listOf $ arbBlock (n-1)))

71+ , (5, do x1 <- listOf $ listOf $ listOf $ arbBlock (n-1)

72+ x2 <- arbitrary

73+ return (DefinitionList $ zip x2 x1))

74+ , (2, do rs <- choose (1 :: Int, 4)

75+ cs <- choose (1 :: Int, 4)

76+ x1 <- arbitrary

77+ x2 <- vector cs

78+ x3 <- vectorOf cs $ elements [0, 0.25]

79+ x4 <- vectorOf cs $ listOf $ arbBlock (n-1)

80+ x5 <- vectorOf rs $ vectorOf cs

81+ $ listOf $ arbBlock (n-1)

82+ return (Table x1 x2 x3 x4 x5))

83+ ]

84+

85+instance Arbitrary Pandoc where

86+ arbitrary

87+ = do x1 <- arbitrary

88+ x2 <- arbitrary

89+ return $ normalize (Pandoc x1 x2)

90+

91+{-

92+instance Arbitrary CitationMode where

93+ arbitrary

94+ = do x <- choose (0 :: Int, 2)

95+ case x of

96+ 0 -> return AuthorInText

97+ 1 -> return SuppressAuthor

98+ 2 -> return NormalCitation

99+ _ -> error "FATAL ERROR: Arbitrary instance, logic bug"

100+

101+instance Arbitrary Citation where

102+ arbitrary

103+ = do x1 <- liftM (filter (`notElem` ",;]@ \t\n")) arbitrary

104+ x2 <- arbitrary

105+ x3 <- arbitrary

106+ x4 <- arbitrary

107+ x5 <- arbitrary

108+ x6 <- arbitrary

109+ return (Citation x1 x2 x3 x4 x5 x6)

110+-}

111+

112+instance Arbitrary MathType where

113+ arbitrary

114+ = do x <- choose (0 :: Int, 1)

115+ case x of

116+ 0 -> return DisplayMath

117+ 1 -> return InlineMath

118+ _ -> error "FATAL ERROR: Arbitrary instance, logic bug"

119+

120+instance Arbitrary QuoteType where

121+ arbitrary

122+ = do x <- choose (0 :: Int, 1)

123+ case x of

124+ 0 -> return SingleQuote

125+ 1 -> return DoubleQuote

126+ _ -> error "FATAL ERROR: Arbitrary instance, logic bug"

127+

128+instance Arbitrary Meta where

129+ arbitrary

130+ = do x1 <- arbitrary

131+ x2 <- liftM (filter (not . null)) arbitrary

132+ x3 <- arbitrary

133+ return (Meta x1 x2 x3)

134+

135+instance Arbitrary Alignment where

136+ arbitrary

137+ = do x <- choose (0 :: Int, 3)

138+ case x of

139+ 0 -> return AlignLeft

140+ 1 -> return AlignRight

141+ 2 -> return AlignCenter

142+ 3 -> return AlignDefault

143+ _ -> error "FATAL ERROR: Arbitrary instance, logic bug"

144+

145+instance Arbitrary ListNumberStyle where

146+ arbitrary

147+ = do x <- choose (0 :: Int, 6)

148+ case x of

149+ 0 -> return DefaultStyle

150+ 1 -> return Example

151+ 2 -> return Decimal

152+ 3 -> return LowerRoman

153+ 4 -> return UpperRoman

154+ 5 -> return LowerAlpha

155+ 6 -> return UpperAlpha

156+ _ -> error "FATAL ERROR: Arbitrary instance, logic bug"

157+

158+instance Arbitrary ListNumberDelim where

159+ arbitrary

160+ = do x <- choose (0 :: Int, 3)

161+ case x of

162+ 0 -> return DefaultDelim

163+ 1 -> return Period

164+ 2 -> return OneParen

165+ 3 -> return TwoParens

166+ _ -> error "FATAL ERROR: Arbitrary instance, logic bug"

167+

tests/Tests/Helpers.hsnew file+34

@@ -0,0 +1,34 @@

1+-- Utility functions for the test suite.

3+module Tests.Helpers where

5+import Text.Pandoc

7+import Test.Framework

8+import Test.Framework.Providers.HUnit

9+import Test.HUnit hiding (Test)

10+

11+data Expect = Inline Inline

12+ | Inlines [Inline]

13+ | Block Block

14+ | Blocks [Block]

15+

16+assertPandoc :: Expect -> Pandoc -> Assertion

17+assertPandoc (Inline e) (Pandoc _ [Para [g]]) = e @=? g

18+assertPandoc (Inlines e) (Pandoc _ [Para g] ) = e @=? g

19+assertPandoc (Block e) (Pandoc _ [g] ) = e @=? g

20+assertPandoc (Blocks e) (Pandoc _ g ) = e @=? g

21+assertPandoc _ _ = assertFailure "Wrong structure of Pandoc document."

22+

23+latexTest :: String -> String -> Expect -> Test

24+latexTest = readerTestWithState defaultParserState readLaTeX

25+

26+readerTestWithState :: ParserState

27+ -> (ParserState -> String -> Pandoc)

28+ -> String

29+ -> String

30+ -> Expect

31+ -> Test

32+readerTestWithState state reader name string e =

33+ testCase name $ e `assertPandoc` reader state string

34+

tests/Tests/Old.hsnew file+216

@@ -0,0 +1,216 @@

1+module Tests.Old (tests) where

3+import Test.Framework (testGroup, Test )

4+import Test.Framework.Providers.HUnit

5+import Test.HUnit ( assertBool )

7+import System.IO ( openTempFile, stderr )

8+import System.Process ( runProcess, waitForProcess )

9+import System.FilePath ( (</>), (<.>) )

10+import System.Directory

11+import System.Exit

12+import Data.Algorithm.Diff

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

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

15+import Text.Pandoc.Highlighting ( languages )

16+import Prelude hiding ( readFile )

17+import qualified Data.ByteString.Lazy as B

18+import Data.ByteString.Lazy.UTF8 (toString)

19+import Text.Printf

20+

21+readFileUTF8 :: FilePath -> IO String

22+readFileUTF8 f = B.readFile f >>= return . toString

23+

24+pandocPath :: FilePath

25+pandocPath = ".." </> "dist" </> "build" </> "pandoc" </> "pandoc"

26+

27+data TestResult = TestPassed

28+ | TestError ExitCode

29+ | TestFailed String FilePath [(DI, String)]

30+ deriving (Eq)

31+

32+instance Show TestResult where

33+ show TestPassed = "PASSED"

34+ show (TestError ec) = "ERROR " ++ show ec

35+ show (TestFailed cmd file d) = "\n--- " ++ file ++

36+ "\n+++ " ++ cmd ++ "\n" ++ showDiff (1,1) d

37+

38+showDiff :: (Int,Int) -> [(DI, String)] -> String

39+showDiff _ [] = ""

40+showDiff (l,r) ((F, ln) : ds) =

41+ printf "+%4d " l ++ ln ++ "\n" ++ showDiff (l+1,r) ds

42+showDiff (l,r) ((S, ln) : ds) =

43+ printf "-%4d " r ++ ln ++ "\n" ++ showDiff (l,r+1) ds

44+showDiff (l,r) ((B, _ ) : ds) =

45+ showDiff (l+1,r+1) ds

46+

47+tests :: [Test]

48+tests = [ testGroup "markdown"

49+ [ testGroup "writer"

50+ $ writerTests "markdown" ++ lhsWriterTests "markdown"

51+ , testGroup "reader"

52+ [ test "basic" ["-r", "markdown", "-w", "native", "-s", "-S"]

53+ "testsuite.txt" "testsuite.native"

54+ , test "tables" ["-r", "markdown", "-w", "native", "--columns=80"]

55+ "tables.txt" "tables.native"

56+ , test "more" ["-r", "markdown", "-w", "native", "-S"]

57+ "markdown-reader-more.txt" "markdown-reader-more.native"

58+ , lhsReaderTest "markdown+lhs"

59+ ]

60+ , testGroup "citations" markdownCitationTests

61+ ]

62+ , testGroup "rst"

63+ [ testGroup "writer" (writerTests "rst" ++ lhsWriterTests "rst")

64+ , testGroup "reader"

65+ [ test "basic" ["-r", "rst", "-w", "native",

66+ "-s", "-S", "--columns=80"] "rst-reader.rst" "rst-reader.native"

67+ , test "tables" ["-r", "rst", "-w", "native", "--columns=80"]

68+ "tables.rst" "tables-rstsubset.native"

69+ , lhsReaderTest "rst+lhs"

70+ ]

71+ ]

72+ , testGroup "latex"

73+ [ testGroup "writer" (writerTests "latex" ++ lhsWriterTests "latex")

74+ , testGroup "reader"

75+ [ test "basic" ["-r", "latex", "-w", "native", "-s", "-R"]

76+ "latex-reader.latex" "latex-reader.native"

77+ , lhsReaderTest "latex+lhs"

78+ ]

79+ , latexCitationTests "biblatex"

80+ , latexCitationTests "natbib"

81+ ]

82+ , testGroup "html"

83+ [ testGroup "writer" (writerTests "html" ++ lhsWriterTests "html")

84+ , test "reader" ["-r", "html", "-w", "native", "-s"]

85+ "html-reader.html" "html-reader.native"

86+ ]

87+ , testGroup "s5"

88+ [ s5WriterTest "basic" ["-s"] "s5"

89+ , s5WriterTest "fancy" ["-s","-m","-i"] "s5"

90+ , s5WriterTest "fragment" [] "html"

91+ , s5WriterTest "inserts" ["-s", "-H", "insert",

92+ "-B", "insert", "-A", "insert", "-c", "main.css"] "html"

93+ ]

94+ , testGroup "textile"

95+ [ testGroup "writer" $ writerTests "textile"

96+ , test "reader" ["-r", "textile", "-w", "native", "-s"]

97+ "textile-reader.textile" "textile-reader.native"

98+ ]

99+ , testGroup "native"

100+ [ testGroup "writer" $ writerTests "native"

101+ , test "reader" ["-r", "native", "-w", "native", "-s"]

102+ "testsuite.native" "testsuite.native"

103+ ]

104+ , testGroup "other writers" $ map (\f -> testGroup f $ writerTests f)

105+ [ "docbook", "opendocument" , "context" , "texinfo"

106+ , "man" , "plain" , "mediawiki", "rtf", "org"

107+ ]

108+ ]

109+

110+-- makes sure file is fully closed after reading

111+readFile' :: FilePath -> IO String

112+readFile' f = do s <- readFileUTF8 f

113+ return $! (length s `seq` s)

114+

115+lhsWriterTests :: String -> [Test]

116+lhsWriterTests format

117+ = [ t "lhs to normal" format

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

119+ ]

120+ where

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

122+ "lhs-test.native" ("lhs-test" <.> ext f)

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

124+ then "nohl" <.> f

125+ else f

126+

127+lhsReaderTest :: String -> Test

128+lhsReaderTest format =

129+ testWithNormalize normalizer "lhs" ["-r", format, "-w", "native"]

130+ ("lhs-test" <.> format) "lhs-test.native"

131+ where normalizer = writeNative defaultWriterOptions . normalize . read

132+

133+latexCitationTests :: String -> Test

134+latexCitationTests n

135+ = testGroup (n ++ " citations")

136+ [ t ("latex reader (" ++ n ++ " citations)")

137+ (["-r", "latex", "-w", "markdown", "-s", "--no-wrap"] ++ o)

138+ f "markdown-citations.txt"

139+ , t ("latex writer (" ++ n ++ " citations)")

140+ (["-r", "markdown", "-w", "latex", "-s", "--no-wrap"] ++ o)

141+ "markdown-citations.txt" f

142+ ]

143+ where

144+ o = ["--bibliography", "biblio.bib", "--csl", "chicago-author-date.csl",

145+ "--no-citeproc", "--" ++ n]

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

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

148+ t = testWithNormalize normalizer

149+

150+writerTests :: String -> [Test]

151+writerTests format

152+ = [ test "basic" (opts ++ ["-s"]) "testsuite.native" ("writer" <.> format)

153+ , test "tables" opts "tables.native" ("tables" <.> format)

154+ ]

155+ where

156+ opts = ["-r", "native", "-w", format, "--columns=78"]

157+

158+s5WriterTest :: String -> [String] -> String -> Test

159+s5WriterTest modifier opts format

160+ = test (format ++ " writer (" ++ modifier ++ ")")

161+ (["-r", "native", "-w", format] ++ opts)

162+ "s5.native" ("s5." ++ modifier <.> "html")

163+

164+markdownCitationTests :: [Test]

165+markdownCitationTests

166+ = map styleToTest ["chicago-author-date","ieee","mhra"]

167+ ++ [test "no-citeproc" wopts "markdown-citations.txt"

168+ "markdown-citations.txt"]

169+ where

170+ ropts = ["-r", "markdown", "-w", "markdown", "--bibliography",

171+ "biblio.bib", "--no-wrap"]

172+ wopts = ropts ++ ["--no-citeproc"]

173+ styleToTest style = test style (ropts ++ ["--csl", style ++ ".csl"])

174+ "markdown-citations.txt"

175+ ("markdown-citations." ++ style ++ ".txt")

176+

177+-- | Run a test without normalize function, return True if test passed.

178+test :: String -- ^ Title of test

179+ -> [String] -- ^ Options to pass to pandoc

180+ -> String -- ^ Input filepath

181+ -> FilePath -- ^ Norm (for test results) filepath

182+ -> Test

183+test = testWithNormalize id

184+

185+-- | Run a test with normalize function, return True if test passed.

186+testWithNormalize :: (String -> String) -- ^ Normalize function for output

187+ -> String -- ^ Title of test

188+ -> [String] -- ^ Options to pass to pandoc

189+ -> String -- ^ Input filepath

190+ -> FilePath -- ^ Norm (for test results) filepath

191+ -> Test

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

193+ (outputPath, hOut) <- openTempFile "" "pandoc-test"

194+ let inpPath = inp

195+ let normPath = norm

196+ let options = ["--data-dir", ".."] ++ [inpPath] ++ opts

197+ let cmd = pandocPath ++ " " ++ unwords options

198+ ph <- runProcess pandocPath options Nothing

199+ (Just [("LANG","en_US.UTF-8"),("HOME", "./")]) Nothing (Just hOut)

200+ (Just stderr)

201+ ec <- waitForProcess ph

202+ result <- if ec == ExitSuccess

203+ then do

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

205+ outputContents <- readFile' outputPath >>=

206+ return . filter (/='\r') . normalizer

207+ normContents <- readFile' normPath >>=

208+ return . filter (/='\r') . normalizer

209+ if outputContents == normContents

210+ then return TestPassed

211+ else return

212+ $ TestFailed cmd normPath

213+ $ getDiff (lines outputContents) (lines normContents)

214+ else return $ TestError ec

215+ removeFile outputPath

216+ assertBool (show result) (result == TestPassed)

tests/Tests/Readers/LaTeX.hsnew file+36

@@ -0,0 +1,36 @@

1+module Tests.Readers.LaTeX (tests) where

3+import Text.Pandoc.Definition

5+import Test.Framework

6+import Tests.Helpers

8+tests :: [Test]

9+tests = [ testGroup "basic"

10+ [ latexTest "simplest" "word" (Inline $ Str "word")

11+ , latexTest "space" "some text"

12+ (Inlines $ [Str "some", Space, Str "text"])

13+

14+ , latexTest "emphasis" "\\emph{emphasized}"

15+ (Inline $ Emph [Str "emphasized"])

16+ ]

17+

18+ , testGroup "headers"

19+ [ latexTest "1. level" "\\section{header}"

20+ $ Block $ Header 1 [Str "header"]

21+

22+ , latexTest "2. level" "\\subsection{header}"

23+ $ Block $ Header 2 [Str "header"]

24+

25+ , latexTest "3. level" "\\subsubsection{header}"

26+ $ Block $ Header 3 [Str "header"]

27+

28+ , latexTest "with emphasis" "\\section{text \\emph{emph}}"

29+ $ Block $ Header 1 [Str "text", Space, Emph [Str "emph"]]

30+

31+ , latexTest "with link" "\\section{text \\href{/url}{link}}"

32+ $ Block

33+ $ Header 1 [Str "text", Space, Link [Str "link"] ("/url", "")]

34+ ]

35+ ]

36+

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+ <meta http-equiv="Content-Type" content="text/html; charset=utf-8" />

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

6+ <title></title>

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+ <meta http-equiv="Content-Type" content="text/html; charset=utf-8" />

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

6+ <title></title>

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.hsnew file+18

@@ -0,0 +1,18 @@

1+{-# OPTIONS_GHC -Wall #-}

3+module Main where

5+import Test.Framework

7+import qualified Tests.Old

8+import qualified Tests.Readers.LaTeX

10+tests :: [Test]

11+tests = [ testGroup "Old" Tests.Old.tests

12+ , testGroup "Readers"

13+ [ testGroup "LaTeX" Tests.Readers.LaTeX.tests

14+ ]

15+ ]

16+

17+main :: IO ()

18+main = defaultMain tests