git.iko.soy/typeable/pandoc
on master help sign in
Merge branch 'tests'
a0e19baJohn MacFarlane
Setup.hs+3−8
compare with master
unifiedsplit
@@ -38,17 +38,12 @@ main = do
38
38
39-- | Run test suite.
39-- | Run test suite.
40runTestSuite :: Args -> Bool -> PackageDescription -> LocalBuildInfo -> IO a
40runTestSuite :: Args -> Bool -> PackageDescription -> LocalBuildInfo -> IO a
41−runTestSuite _ _ pkg lbi = do
41+runTestSuite args _ pkg lbi = do
42 let testDir = buildDir lbi </> "test-pandoc"
42 let testDir = buildDir lbi </> "test-pandoc"
43 testDir' <- canonicalizePath testDir
43 testDir' <- canonicalizePath testDir
44+ let testArgs = concatMap (\arg -> ["-t",arg]) args
44 if any id [buildable (buildInfo exe) | exe <- executables pkg, exeName exe == "test-pandoc"]
45 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")
46+ then inDirectory "tests" $ rawSystem (testDir' </> "test-pandoc") testArgs >>= exitWith
51− testArgs >>= exitWith
52 else do
47 else do
53 putStrLn "Build pandoc with the 'tests' flag to run tests"
48 putStrLn "Build pandoc with the 'tests' flag to run tests"
54 exitWith $ ExitFailure 3
49 exitWith $ ExitFailure 3
pandoc.cabal+17−4
@@ -150,6 +150,8 @@ Extra-Source-Files:
150 tests/lhs-test.latex+lhs,
150 tests/lhs-test.latex+lhs,
151 tests/lhs-test.html,
151 tests/lhs-test.html,
152 tests/lhs-test.html+lhs,
152 tests/lhs-test.html+lhs,
153+ tests/lhs-test.nohl.html,
154+ tests/lhs-test.nohl.html+lhs,
153 tests/lhs-test.fragment.html+lhs
155 tests/lhs-test.fragment.html+lhs
154Extra-Tmp-Files: man/man1/pandoc.1, man/man1/markdown2pdf.1
156Extra-Tmp-Files: man/man1/pandoc.1, man/man1/markdown2pdf.1
155
157
@@ -303,11 +305,22 @@ Executable markdown2pdf
303 Buildable: False
305 Buildable: False
304
306
305Executable test-pandoc
307Executable test-pandoc
306− Hs-Source-Dirs: src
308+ Hs-Source-Dirs: tests, src
307 Main-Is: test-pandoc.hs
309 Main-Is: test-pandoc.hs
310+ if flag(highlighting)
311+ cpp-options: -D_HIGHLIGHTING
308 if !flag(tests)
312 if !flag(tests)
309 Buildable: False
313 Buildable: False
310 else
314 else
315+ if impl(ghc >= 6.12)
311− Ghc-Options: -Wall
316+ Ghc-Options: -Wall -fno-warn-unused-do-bind
317+ else
318+ Ghc-Options: -Wall
319+ Extensions: CPP
312− Build-Depends: base >= 4 && < 5, Diff
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
313− Other-Modules: Text.Pandoc.Shared
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.
2+
3+module Tests.Helpers where
4+
5+import Text.Pandoc
6+
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
2+
3+import Test.Framework (testGroup, Test )
4+import Test.Framework.Providers.HUnit
5+import Test.HUnit ( assertBool )
6+
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
2+
3+import Text.Pandoc.Definition
4+
5+import Test.Framework
6+import Tests.Helpers
7+
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 @@
1Pandoc (Meta {docTitle = [], docAuthors = [], docDate = []})
1Pandoc (Meta {docTitle = [], docAuthors = [], docDate = []})
2[ Header 1 [Str "lhs",Space,Str "test"]
2[ 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 ":"]
4, 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) "
4, 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) "
5, 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 "."]
5, 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 "."]
6, CodeBlock ("",[],[]) "f *** g = first f >>> second g"
6, CodeBlock ("",[],[]) "f *** g = first f >>> second g"
7−, Para [Str "Block",Space,Str "quote:"]
7+, Para [Str "Block",Space,Str "quote",Str ":"]
8, BlockQuote
8, BlockQuote
9 [ Para [Str "foo",Space,Str "bar"] ]
9 [ Para [Str "foo",Space,Str "bar"] ]
10 ]
10 ]
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) =&gt; (b -&gt; c -&gt; d) -&gt; a (b, c) d
18+unsplit = arr . uncurry
19+ -- arr (\op (x,y) -&gt; 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 &gt;&gt;&gt; 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+ >&gt; unsplit :: (Arrow a) =&gt; (b -&gt; c -&gt; d) -&gt; a (b, c) d
18+&gt; unsplit = arr . uncurry
19+&gt; -- arr (\op (x,y) -&gt; 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 &gt;&gt;&gt; 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 #-}
2+
3+module Main where
4+
5+import Test.Framework
6+
7+import qualified Tests.Old
8+import qualified Tests.Readers.LaTeX
9+
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