Merge branch 'tests'
This commit is contained in:
John MacFarlane
commit
a0e19ba8aa
11 changed files with 571 additions and 233 deletions
11
Setup.hs
11
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 = ["lhs" | highlightingSupport]
|
||||
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
|
||||
|
|
|
|||
21
pandoc.cabal
21
pandoc.cabal
|
|
@ -150,6 +150,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
|
||||
|
||||
|
|
@ -303,11 +305,22 @@ Executable markdown2pdf
|
|||
Buildable: False
|
||||
|
||||
Executable test-pandoc
|
||||
Hs-Source-Dirs: src
|
||||
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
|
||||
Build-Depends: base >= 4 && < 5, Diff
|
||||
Other-Modules: Text.Pandoc.Shared
|
||||
if impl(ghc >= 6.12)
|
||||
Ghc-Options: -Wall -fno-warn-unused-do-bind
|
||||
else
|
||||
Ghc-Options: -Wall
|
||||
Extensions: CPP
|
||||
Build-Depends: base >= 4 && < 5, Diff, test-framework >= 0.3 && < 0.4,
|
||||
test-framework-hunit >= 0.2 && < 0.3,
|
||||
HUnit >= 1.2 && < 1.3
|
||||
Other-Modules: Tests.Old
|
||||
Tests.Helpers
|
||||
Tests.Arbitrary
|
||||
Tests.Readers.LaTeX
|
||||
|
|
|
|||
|
|
@ -1,219 +0,0 @@
|
|||
{-# OPTIONS_GHC -Wall #-}
|
||||
-- RunTests.hs - run test suite for pandoc
|
||||
-- This script is designed to be run from the tests directory.
|
||||
-- It assumes the pandoc executable is in dist/build/pandoc.
|
||||
--
|
||||
-- runhaskell -i.. RunTests.hs [lhs]
|
||||
--
|
||||
-- If the lhs argument is provided, tests for lhs support will be
|
||||
-- run. These presuppose that pandoc has been compiled with the
|
||||
-- -fhighlighting flag, so these tests are not run by default.
|
||||
--
|
||||
-- This program assumes that the Diff package has been installed:
|
||||
-- cabal install Diff
|
||||
|
||||
module Main where
|
||||
import System.IO ( openTempFile, stderr, stdout, hFlush )
|
||||
import System.Process ( runProcess, waitForProcess )
|
||||
import System.FilePath ( (</>), (<.>) )
|
||||
import System.Directory
|
||||
import System.Environment
|
||||
import System.Exit
|
||||
import Text.Printf
|
||||
import Data.Algorithm.Diff
|
||||
import Text.Pandoc.Shared ( substitute )
|
||||
import Prelude hiding ( readFile )
|
||||
import qualified Data.ByteString.Lazy as B
|
||||
import Data.ByteString.Lazy.UTF8 (toString, fromString)
|
||||
|
||||
readFileUTF8 :: FilePath -> IO String
|
||||
readFileUTF8 f = B.readFile f >>= return . toString
|
||||
|
||||
pandocPath :: FilePath
|
||||
pandocPath = ".." </> "dist" </> "build" </> "pandoc" </> "pandoc"
|
||||
|
||||
data TestResult = TestPassed
|
||||
| TestError ExitCode
|
||||
| TestFailed [(DI, String)]
|
||||
deriving (Eq)
|
||||
|
||||
instance Show TestResult where
|
||||
show TestPassed = "PASSED"
|
||||
show (TestError ec) = "ERROR " ++ show ec
|
||||
show (TestFailed d) = "FAILED\n" ++ showDiff d
|
||||
|
||||
showDiff :: [(DI, String)] -> String
|
||||
showDiff [] = ""
|
||||
showDiff ((F, ln) : ds) = "|TEST| " ++ ln ++ "\n" ++ showDiff ds
|
||||
showDiff ((S, ln) : ds) = "|NORM| " ++ ln ++ "\n" ++ showDiff ds
|
||||
showDiff ((B, _ ) : ds) = showDiff ds
|
||||
|
||||
writerFormats :: [String]
|
||||
writerFormats = [ "native"
|
||||
, "html"
|
||||
, "docbook"
|
||||
, "opendocument"
|
||||
, "latex"
|
||||
, "context"
|
||||
, "texinfo"
|
||||
, "man"
|
||||
, "plain"
|
||||
, "markdown"
|
||||
, "rst"
|
||||
, "mediawiki"
|
||||
, "textile"
|
||||
, "rtf"
|
||||
, "org"
|
||||
]
|
||||
|
||||
lhsWriterFormats :: [String]
|
||||
lhsWriterFormats = [ "markdown"
|
||||
, "markdown+lhs"
|
||||
, "rst"
|
||||
, "rst+lhs"
|
||||
, "latex"
|
||||
, "latex+lhs"
|
||||
, "html"
|
||||
, "html+lhs"
|
||||
]
|
||||
|
||||
lhsReaderFormats :: [String]
|
||||
lhsReaderFormats = [ "markdown+lhs"
|
||||
, "rst+lhs"
|
||||
, "latex+lhs"
|
||||
]
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
args <- getArgs
|
||||
let runLhsTests = "lhs" `elem` args
|
||||
r1s <- mapM runWriterTest writerFormats
|
||||
r2 <- runS5WriterTest "basic" ["-s"] "s5"
|
||||
r3 <- runS5WriterTest "fancy" ["-s","-m","-i"] "s5"
|
||||
r4 <- runS5WriterTest "fragment" [] "html"
|
||||
r5 <- runS5WriterTest "inserts" ["-s", "-H", "insert",
|
||||
"-B", "insert", "-A", "insert", "-c", "main.css"] "html"
|
||||
r6 <- runTest "markdown reader" ["-r", "markdown", "-w", "native", "-s", "-S"]
|
||||
"testsuite.txt" "testsuite.native"
|
||||
r7 <- runTest "markdown reader (tables)" ["-r", "markdown", "-w", "native"]
|
||||
"tables.txt" "tables.native"
|
||||
r7a <- runTest "markdown reader (more)" ["-r", "markdown", "-w", "native", "-S"]
|
||||
"markdown-reader-more.txt" "markdown-reader-more.native"
|
||||
r8 <- runTest "rst reader" ["-r", "rst", "-w", "native", "-s", "-S"]
|
||||
"rst-reader.rst" "rst-reader.native"
|
||||
r8a <- runTest "rst reader (tables)" ["-r", "rst", "-w", "native"]
|
||||
"tables.rst" "tables-rstsubset.native"
|
||||
r9 <- runTest "html reader" ["-r", "html", "-w", "native", "-s"]
|
||||
"html-reader.html" "html-reader.native"
|
||||
r10 <- runTest "latex reader" ["-r", "latex", "-w", "native", "-s", "-R"]
|
||||
"latex-reader.latex" "latex-reader.native"
|
||||
rTextile1 <- runTest "textile reader" ["-r", "textile", "-w", "native", "-s"]
|
||||
"textile-reader.textile" "textile-reader.native"
|
||||
r11 <- runTest "native reader" ["-r", "native", "-w", "native", "-s"]
|
||||
"testsuite.native" "testsuite.native"
|
||||
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"]
|
||||
let citopts = ["--bibliography", "biblio.bib", "--csl", "chicago-author-date.csl", "--no-citeproc"]
|
||||
r15 <- runTest "markdown writer (citations)" (["-r", "markdown", "-w", "markdown", "--no-wrap"] ++ citopts)
|
||||
"markdown-citations.txt" "markdown-citations.txt"
|
||||
r16s <- runLatexCitationTests citopts "biblatex"
|
||||
r17s <- runLatexCitationTests citopts "natbib"
|
||||
r12s <- if runLhsTests
|
||||
then mapM runLhsWriterTest lhsWriterFormats
|
||||
else putStrLn "Skipping lhs writer tests because they presuppose highlighting support" >> return []
|
||||
r13s <- if runLhsTests
|
||||
then mapM runLhsReaderTest lhsReaderFormats
|
||||
else putStrLn "Skipping lhs reader tests because they presuppose highlighting support" >> return []
|
||||
let results = r1s ++
|
||||
|
||||
[ r2, r3, r4, r5 -- S5
|
||||
, r6, r7, r7a -- markdown reader
|
||||
, r8, r8a -- rst
|
||||
, r9 -- html
|
||||
, r10 -- latex
|
||||
, rTextile1 -- textile
|
||||
, r11 -- native
|
||||
, r15 -- markdown citations
|
||||
] ++ r12s ++ r13s ++ r14s ++ r16s ++ r17s
|
||||
if all id results
|
||||
then do
|
||||
putStrLn "\nAll tests passed."
|
||||
exitWith ExitSuccess
|
||||
else do
|
||||
let failures = length $ filter not results
|
||||
putStrLn $ "\n" ++ show failures ++ " tests failed."
|
||||
exitWith (ExitFailure failures)
|
||||
|
||||
-- makes sure file is fully closed after reading
|
||||
readFile' :: FilePath -> IO String
|
||||
readFile' f = do s <- readFileUTF8 f
|
||||
return $! (length s `seq` s)
|
||||
|
||||
runLhsWriterTest :: String -> IO Bool
|
||||
runLhsWriterTest format =
|
||||
runTest ("(lhs) " ++ format ++ " writer") ["--columns=78", "-r", "native", "-s", "-w", format] "lhs-test.native" ("lhs-test" <.> format)
|
||||
|
||||
runLhsReaderTest :: String -> IO Bool
|
||||
runLhsReaderTest format =
|
||||
runTest ("(lhs) " ++ format ++ " reader") ["-r", format, "-w", "html+lhs"] ("lhs-test" <.> format) "lhs-test.fragment.html+lhs"
|
||||
|
||||
|
||||
runLatexCitationTests :: [String] -> String -> IO [Bool]
|
||||
runLatexCitationTests o n
|
||||
= sequence [ rt ("latex reader (" ++ n ++ " citations)") (["-r", "latex", "-w", "markdown", "-s", "--no-wrap"] ++ o')
|
||||
f "markdown-citations.txt"
|
||||
, rt ("latex writer (" ++ n ++ " citations)") (["-r", "markdown", "-w", "latex", "-s", "--no-wrap"] ++ o')
|
||||
"markdown-citations.txt" f
|
||||
]
|
||||
where
|
||||
o' = o ++ ["--" ++ n]
|
||||
f = n ++ "-citations.latex"
|
||||
normalize = substitute "\160" " " . substitute "\8211" "-"
|
||||
rt = runTestWithNormalize normalize
|
||||
|
||||
runWriterTest :: String -> IO Bool
|
||||
runWriterTest format = do
|
||||
r1 <- runTest (format ++ " writer") ["-r", "native", "-s", "-w", format, "--columns=78"] "testsuite.native" ("writer" <.> format)
|
||||
r2 <- runTest (format ++ " writer (tables)") ["-r", "native", "-w", format, "--columns=78"] "tables.native" ("tables" <.> format)
|
||||
return (r1 && r2)
|
||||
|
||||
runS5WriterTest :: String -> [String] -> String -> IO Bool
|
||||
runS5WriterTest modifier opts format = runTest (format ++ " writer (" ++ modifier ++ ")")
|
||||
(["-r", "native", "-w", format] ++ opts) "s5.native" ("s5." ++ modifier <.> "html")
|
||||
|
||||
|
||||
-- | Run a test without normalize function, return True if test passed.
|
||||
runTest :: String -- ^ Title of test
|
||||
-> [String] -- ^ Options to pass to pandoc
|
||||
-> String -- ^ Input filepath
|
||||
-> FilePath -- ^ Norm (for test results) filepath
|
||||
-> IO Bool
|
||||
runTest = runTestWithNormalize id
|
||||
|
||||
-- | Run a test with normalize function, return True if test passed.
|
||||
runTestWithNormalize :: (String -> String) -- ^ Normalize function for output
|
||||
-> String -- ^ Title of test
|
||||
-> [String] -- ^ Options to pass to pandoc
|
||||
-> String -- ^ Input filepath
|
||||
-> FilePath -- ^ Norm (for test results) filepath
|
||||
-> IO Bool
|
||||
runTestWithNormalize normalize testname opts inp norm = do
|
||||
putStr $ printf "%-28s ---> " testname
|
||||
(outputPath, hOut) <- openTempFile "" "pandoc-test"
|
||||
let inpPath = inp
|
||||
let normPath = norm
|
||||
hFlush stdout
|
||||
ph <- runProcess pandocPath (["--columns=80"] ++ [inpPath] ++ ["--data-dir", ".."] ++ opts) Nothing
|
||||
(Just [("LANG","en_US.UTF-8"),("HOME", "./")]) Nothing (Just hOut) (Just stderr)
|
||||
ec <- waitForProcess ph
|
||||
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')
|
||||
if outputContents == normContents
|
||||
then return TestPassed
|
||||
else return $ TestFailed $ getDiff (lines outputContents) (lines normContents)
|
||||
else return $ TestError ec
|
||||
removeFile outputPath
|
||||
B.putStrLn (fromString $ show result)
|
||||
return (result == TestPassed)
|
||||
167
tests/Tests/Arbitrary.hs
Normal file
167
tests/Tests/Arbitrary.hs
Normal file
|
|
@ -0,0 +1,167 @@
|
|||
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
||||
-- provides Arbitrary instance for Pandoc types
|
||||
module Tests.Arbitrary ()
|
||||
where
|
||||
import Test.QuickCheck.Gen
|
||||
import Test.QuickCheck.Arbitrary
|
||||
import Control.Monad (liftM, liftM2)
|
||||
import Text.Pandoc
|
||||
import Text.Pandoc.Shared
|
||||
|
||||
realString :: Gen String
|
||||
realString = elements wordlist
|
||||
|
||||
wordlist :: [String]
|
||||
wordlist = ["foo","Bar","baz","\\","/",":","\"","'","féé"]
|
||||
|
||||
instance Arbitrary Inline where
|
||||
arbitrary = resize 3 $ arbInline 3
|
||||
|
||||
-- restrict to 3 levels of nesting max; otherwise we get
|
||||
-- bogged down in indefinitely large structures
|
||||
arbInline :: Int -> Gen Inline
|
||||
arbInline n = frequency $ [ (60, liftM Str realString)
|
||||
, (60, return Space)
|
||||
, (10, liftM Code realString)
|
||||
, (5, return EmDash)
|
||||
, (5, return EnDash)
|
||||
, (5, return Apostrophe)
|
||||
, (5, return Ellipses)
|
||||
] ++ [ x | x <- nesters, n > 1]
|
||||
where nesters = [ (10, liftM Emph $ listOf $ arbInline (n-1))
|
||||
, (10, liftM Strong $ listOf $ arbInline (n-1))
|
||||
, (10, liftM Strikeout $ listOf $ arbInline (n-1))
|
||||
, (10, liftM Superscript $ listOf $ arbInline (n-1))
|
||||
, (10, liftM Subscript $ listOf $ arbInline (n-1))
|
||||
, (10, liftM SmallCaps $ listOf $ arbInline (n-1))
|
||||
, (10, do x1 <- arbitrary
|
||||
x2 <- listOf $ arbInline (n-1)
|
||||
return $ Quoted x1 x2)
|
||||
, (10, do x1 <- arbitrary
|
||||
x2 <- realString
|
||||
return $ Math x1 x2)
|
||||
, (10, do x1 <- listOf $ arbInline (n-1)
|
||||
x3 <- realString
|
||||
x2 <- realString
|
||||
return $ Link x1 (x2,x3))
|
||||
, (10, do x1 <- listOf $ arbInline (n-1)
|
||||
x3 <- realString
|
||||
x2 <- realString
|
||||
return $ Image x1 (x2,x3))
|
||||
, (2, liftM Note $ resize 3 $ listOf1 arbitrary)
|
||||
]
|
||||
|
||||
instance Arbitrary Block where
|
||||
arbitrary = resize 3 $ arbBlock 3
|
||||
|
||||
arbBlock :: Int -> Gen Block
|
||||
arbBlock n = frequency $ [ (10, liftM Plain arbitrary)
|
||||
, (15, liftM Para arbitrary)
|
||||
, (5, liftM2 CodeBlock arbitrary realString)
|
||||
, (2, liftM RawHtml realString)
|
||||
, (5, do x1 <- choose (1 :: Int, 6)
|
||||
x2 <- arbitrary
|
||||
return (Header x1 x2))
|
||||
, (2, return HorizontalRule)
|
||||
] ++ [x | x <- nesters, n > 0]
|
||||
where nesters = [ (5, liftM BlockQuote $ listOf $ arbBlock (n-1))
|
||||
, (5, liftM2 OrderedList arbitrary
|
||||
$ (listOf $ listOf $ arbBlock (n-1)))
|
||||
, (5, liftM BulletList $ (listOf $ listOf $ arbBlock (n-1)))
|
||||
, (5, do x1 <- listOf $ listOf $ listOf $ arbBlock (n-1)
|
||||
x2 <- arbitrary
|
||||
return (DefinitionList $ zip x2 x1))
|
||||
, (2, do rs <- choose (1 :: Int, 4)
|
||||
cs <- choose (1 :: Int, 4)
|
||||
x1 <- arbitrary
|
||||
x2 <- vector cs
|
||||
x3 <- vectorOf cs $ elements [0, 0.25]
|
||||
x4 <- vectorOf cs $ listOf $ arbBlock (n-1)
|
||||
x5 <- vectorOf rs $ vectorOf cs
|
||||
$ listOf $ arbBlock (n-1)
|
||||
return (Table x1 x2 x3 x4 x5))
|
||||
]
|
||||
|
||||
instance Arbitrary Pandoc where
|
||||
arbitrary
|
||||
= do x1 <- arbitrary
|
||||
x2 <- arbitrary
|
||||
return $ normalize (Pandoc x1 x2)
|
||||
|
||||
{-
|
||||
instance Arbitrary CitationMode where
|
||||
arbitrary
|
||||
= do x <- choose (0 :: Int, 2)
|
||||
case x of
|
||||
0 -> return AuthorInText
|
||||
1 -> return SuppressAuthor
|
||||
2 -> return NormalCitation
|
||||
_ -> error "FATAL ERROR: Arbitrary instance, logic bug"
|
||||
|
||||
instance Arbitrary Citation where
|
||||
arbitrary
|
||||
= do x1 <- liftM (filter (`notElem` ",;]@ \t\n")) arbitrary
|
||||
x2 <- arbitrary
|
||||
x3 <- arbitrary
|
||||
x4 <- arbitrary
|
||||
x5 <- arbitrary
|
||||
x6 <- arbitrary
|
||||
return (Citation x1 x2 x3 x4 x5 x6)
|
||||
-}
|
||||
|
||||
instance Arbitrary MathType where
|
||||
arbitrary
|
||||
= do x <- choose (0 :: Int, 1)
|
||||
case x of
|
||||
0 -> return DisplayMath
|
||||
1 -> return InlineMath
|
||||
_ -> error "FATAL ERROR: Arbitrary instance, logic bug"
|
||||
|
||||
instance Arbitrary QuoteType where
|
||||
arbitrary
|
||||
= do x <- choose (0 :: Int, 1)
|
||||
case x of
|
||||
0 -> return SingleQuote
|
||||
1 -> return DoubleQuote
|
||||
_ -> error "FATAL ERROR: Arbitrary instance, logic bug"
|
||||
|
||||
instance Arbitrary Meta where
|
||||
arbitrary
|
||||
= do x1 <- arbitrary
|
||||
x2 <- liftM (filter (not . null)) arbitrary
|
||||
x3 <- arbitrary
|
||||
return (Meta x1 x2 x3)
|
||||
|
||||
instance Arbitrary Alignment where
|
||||
arbitrary
|
||||
= do x <- choose (0 :: Int, 3)
|
||||
case x of
|
||||
0 -> return AlignLeft
|
||||
1 -> return AlignRight
|
||||
2 -> return AlignCenter
|
||||
3 -> return AlignDefault
|
||||
_ -> error "FATAL ERROR: Arbitrary instance, logic bug"
|
||||
|
||||
instance Arbitrary ListNumberStyle where
|
||||
arbitrary
|
||||
= do x <- choose (0 :: Int, 6)
|
||||
case x of
|
||||
0 -> return DefaultStyle
|
||||
1 -> return Example
|
||||
2 -> return Decimal
|
||||
3 -> return LowerRoman
|
||||
4 -> return UpperRoman
|
||||
5 -> return LowerAlpha
|
||||
6 -> return UpperAlpha
|
||||
_ -> error "FATAL ERROR: Arbitrary instance, logic bug"
|
||||
|
||||
instance Arbitrary ListNumberDelim where
|
||||
arbitrary
|
||||
= do x <- choose (0 :: Int, 3)
|
||||
case x of
|
||||
0 -> return DefaultDelim
|
||||
1 -> return Period
|
||||
2 -> return OneParen
|
||||
3 -> return TwoParens
|
||||
_ -> error "FATAL ERROR: Arbitrary instance, logic bug"
|
||||
|
||||
34
tests/Tests/Helpers.hs
Normal file
34
tests/Tests/Helpers.hs
Normal file
|
|
@ -0,0 +1,34 @@
|
|||
-- Utility functions for the test suite.
|
||||
|
||||
module Tests.Helpers where
|
||||
|
||||
import Text.Pandoc
|
||||
|
||||
import Test.Framework
|
||||
import Test.Framework.Providers.HUnit
|
||||
import Test.HUnit hiding (Test)
|
||||
|
||||
data Expect = Inline Inline
|
||||
| Inlines [Inline]
|
||||
| Block Block
|
||||
| Blocks [Block]
|
||||
|
||||
assertPandoc :: Expect -> Pandoc -> Assertion
|
||||
assertPandoc (Inline e) (Pandoc _ [Para [g]]) = e @=? g
|
||||
assertPandoc (Inlines e) (Pandoc _ [Para g] ) = e @=? g
|
||||
assertPandoc (Block e) (Pandoc _ [g] ) = e @=? g
|
||||
assertPandoc (Blocks e) (Pandoc _ g ) = e @=? g
|
||||
assertPandoc _ _ = assertFailure "Wrong structure of Pandoc document."
|
||||
|
||||
latexTest :: String -> String -> Expect -> Test
|
||||
latexTest = readerTestWithState defaultParserState readLaTeX
|
||||
|
||||
readerTestWithState :: ParserState
|
||||
-> (ParserState -> String -> Pandoc)
|
||||
-> String
|
||||
-> String
|
||||
-> Expect
|
||||
-> Test
|
||||
readerTestWithState state reader name string e =
|
||||
testCase name $ e `assertPandoc` reader state string
|
||||
|
||||
216
tests/Tests/Old.hs
Normal file
216
tests/Tests/Old.hs
Normal file
|
|
@ -0,0 +1,216 @@
|
|||
module Tests.Old (tests) where
|
||||
|
||||
import Test.Framework (testGroup, Test )
|
||||
import Test.Framework.Providers.HUnit
|
||||
import Test.HUnit ( assertBool )
|
||||
|
||||
import System.IO ( openTempFile, stderr )
|
||||
import System.Process ( runProcess, waitForProcess )
|
||||
import System.FilePath ( (</>), (<.>) )
|
||||
import System.Directory
|
||||
import System.Exit
|
||||
import Data.Algorithm.Diff
|
||||
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)
|
||||
import Text.Printf
|
||||
|
||||
readFileUTF8 :: FilePath -> IO String
|
||||
readFileUTF8 f = B.readFile f >>= return . toString
|
||||
|
||||
pandocPath :: FilePath
|
||||
pandocPath = ".." </> "dist" </> "build" </> "pandoc" </> "pandoc"
|
||||
|
||||
data TestResult = TestPassed
|
||||
| TestError ExitCode
|
||||
| TestFailed String FilePath [(DI, String)]
|
||||
deriving (Eq)
|
||||
|
||||
instance Show TestResult where
|
||||
show TestPassed = "PASSED"
|
||||
show (TestError ec) = "ERROR " ++ show ec
|
||||
show (TestFailed cmd file d) = "\n--- " ++ file ++
|
||||
"\n+++ " ++ cmd ++ "\n" ++ showDiff (1,1) d
|
||||
|
||||
showDiff :: (Int,Int) -> [(DI, String)] -> String
|
||||
showDiff _ [] = ""
|
||||
showDiff (l,r) ((F, ln) : ds) =
|
||||
printf "+%4d " l ++ ln ++ "\n" ++ showDiff (l+1,r) ds
|
||||
showDiff (l,r) ((S, ln) : ds) =
|
||||
printf "-%4d " r ++ ln ++ "\n" ++ showDiff (l,r+1) ds
|
||||
showDiff (l,r) ((B, _ ) : ds) =
|
||||
showDiff (l+1,r+1) ds
|
||||
|
||||
tests :: [Test]
|
||||
tests = [ testGroup "markdown"
|
||||
[ testGroup "writer"
|
||||
$ writerTests "markdown" ++ lhsWriterTests "markdown"
|
||||
, testGroup "reader"
|
||||
[ test "basic" ["-r", "markdown", "-w", "native", "-s", "-S"]
|
||||
"testsuite.txt" "testsuite.native"
|
||||
, test "tables" ["-r", "markdown", "-w", "native", "--columns=80"]
|
||||
"tables.txt" "tables.native"
|
||||
, test "more" ["-r", "markdown", "-w", "native", "-S"]
|
||||
"markdown-reader-more.txt" "markdown-reader-more.native"
|
||||
, lhsReaderTest "markdown+lhs"
|
||||
]
|
||||
, testGroup "citations" markdownCitationTests
|
||||
]
|
||||
, testGroup "rst"
|
||||
[ testGroup "writer" (writerTests "rst" ++ lhsWriterTests "rst")
|
||||
, testGroup "reader"
|
||||
[ test "basic" ["-r", "rst", "-w", "native",
|
||||
"-s", "-S", "--columns=80"] "rst-reader.rst" "rst-reader.native"
|
||||
, test "tables" ["-r", "rst", "-w", "native", "--columns=80"]
|
||||
"tables.rst" "tables-rstsubset.native"
|
||||
, lhsReaderTest "rst+lhs"
|
||||
]
|
||||
]
|
||||
, testGroup "latex"
|
||||
[ testGroup "writer" (writerTests "latex" ++ lhsWriterTests "latex")
|
||||
, testGroup "reader"
|
||||
[ test "basic" ["-r", "latex", "-w", "native", "-s", "-R"]
|
||||
"latex-reader.latex" "latex-reader.native"
|
||||
, lhsReaderTest "latex+lhs"
|
||||
]
|
||||
, latexCitationTests "biblatex"
|
||||
, latexCitationTests "natbib"
|
||||
]
|
||||
, testGroup "html"
|
||||
[ testGroup "writer" (writerTests "html" ++ lhsWriterTests "html")
|
||||
, test "reader" ["-r", "html", "-w", "native", "-s"]
|
||||
"html-reader.html" "html-reader.native"
|
||||
]
|
||||
, testGroup "s5"
|
||||
[ s5WriterTest "basic" ["-s"] "s5"
|
||||
, s5WriterTest "fancy" ["-s","-m","-i"] "s5"
|
||||
, s5WriterTest "fragment" [] "html"
|
||||
, s5WriterTest "inserts" ["-s", "-H", "insert",
|
||||
"-B", "insert", "-A", "insert", "-c", "main.css"] "html"
|
||||
]
|
||||
, testGroup "textile"
|
||||
[ testGroup "writer" $ writerTests "textile"
|
||||
, test "reader" ["-r", "textile", "-w", "native", "-s"]
|
||||
"textile-reader.textile" "textile-reader.native"
|
||||
]
|
||||
, testGroup "native"
|
||||
[ testGroup "writer" $ writerTests "native"
|
||||
, test "reader" ["-r", "native", "-w", "native", "-s"]
|
||||
"testsuite.native" "testsuite.native"
|
||||
]
|
||||
, testGroup "other writers" $ map (\f -> testGroup f $ writerTests f)
|
||||
[ "docbook", "opendocument" , "context" , "texinfo"
|
||||
, "man" , "plain" , "mediawiki", "rtf", "org"
|
||||
]
|
||||
]
|
||||
|
||||
-- makes sure file is fully closed after reading
|
||||
readFile' :: FilePath -> IO String
|
||||
readFile' f = do s <- readFileUTF8 f
|
||||
return $! (length s `seq` s)
|
||||
|
||||
lhsWriterTests :: String -> [Test]
|
||||
lhsWriterTests format
|
||||
= [ t "lhs to normal" 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" <.> ext f)
|
||||
ext f = if null languages && format == "html"
|
||||
then "nohl" <.> f
|
||||
else f
|
||||
|
||||
lhsReaderTest :: String -> Test
|
||||
lhsReaderTest format =
|
||||
testWithNormalize normalizer "lhs" ["-r", format, "-w", "native"]
|
||||
("lhs-test" <.> format) "lhs-test.native"
|
||||
where normalizer = writeNative defaultWriterOptions . normalize . read
|
||||
|
||||
latexCitationTests :: String -> Test
|
||||
latexCitationTests n
|
||||
= testGroup (n ++ " citations")
|
||||
[ t ("latex reader (" ++ n ++ " citations)")
|
||||
(["-r", "latex", "-w", "markdown", "-s", "--no-wrap"] ++ o)
|
||||
f "markdown-citations.txt"
|
||||
, t ("latex writer (" ++ n ++ " citations)")
|
||||
(["-r", "markdown", "-w", "latex", "-s", "--no-wrap"] ++ o)
|
||||
"markdown-citations.txt" f
|
||||
]
|
||||
where
|
||||
o = ["--bibliography", "biblio.bib", "--csl", "chicago-author-date.csl",
|
||||
"--no-citeproc", "--" ++ n]
|
||||
f = n ++ "-citations.latex"
|
||||
normalizer = substitute "\160" " " . substitute "\8211" "-"
|
||||
t = testWithNormalize normalizer
|
||||
|
||||
writerTests :: String -> [Test]
|
||||
writerTests format
|
||||
= [ test "basic" (opts ++ ["-s"]) "testsuite.native" ("writer" <.> format)
|
||||
, test "tables" opts "tables.native" ("tables" <.> format)
|
||||
]
|
||||
where
|
||||
opts = ["-r", "native", "-w", format, "--columns=78"]
|
||||
|
||||
s5WriterTest :: String -> [String] -> String -> Test
|
||||
s5WriterTest modifier opts format
|
||||
= test (format ++ " writer (" ++ modifier ++ ")")
|
||||
(["-r", "native", "-w", format] ++ opts)
|
||||
"s5.native" ("s5." ++ modifier <.> "html")
|
||||
|
||||
markdownCitationTests :: [Test]
|
||||
markdownCitationTests
|
||||
= map styleToTest ["chicago-author-date","ieee","mhra"]
|
||||
++ [test "no-citeproc" wopts "markdown-citations.txt"
|
||||
"markdown-citations.txt"]
|
||||
where
|
||||
ropts = ["-r", "markdown", "-w", "markdown", "--bibliography",
|
||||
"biblio.bib", "--no-wrap"]
|
||||
wopts = ropts ++ ["--no-citeproc"]
|
||||
styleToTest style = test style (ropts ++ ["--csl", style ++ ".csl"])
|
||||
"markdown-citations.txt"
|
||||
("markdown-citations." ++ style ++ ".txt")
|
||||
|
||||
-- | Run a test without normalize function, return True if test passed.
|
||||
test :: String -- ^ Title of test
|
||||
-> [String] -- ^ Options to pass to pandoc
|
||||
-> String -- ^ Input filepath
|
||||
-> FilePath -- ^ Norm (for test results) filepath
|
||||
-> Test
|
||||
test = testWithNormalize id
|
||||
|
||||
-- | Run a test with normalize function, return True if test passed.
|
||||
testWithNormalize :: (String -> String) -- ^ Normalize function for output
|
||||
-> String -- ^ Title of test
|
||||
-> [String] -- ^ Options to pass to pandoc
|
||||
-> String -- ^ Input filepath
|
||||
-> FilePath -- ^ Norm (for test results) filepath
|
||||
-> Test
|
||||
testWithNormalize normalizer testname opts inp norm = testCase testname $ do
|
||||
(outputPath, hOut) <- openTempFile "" "pandoc-test"
|
||||
let inpPath = inp
|
||||
let normPath = norm
|
||||
let options = ["--data-dir", ".."] ++ [inpPath] ++ opts
|
||||
let cmd = pandocPath ++ " " ++ unwords options
|
||||
ph <- runProcess pandocPath options Nothing
|
||||
(Just [("LANG","en_US.UTF-8"),("HOME", "./")]) Nothing (Just hOut)
|
||||
(Just stderr)
|
||||
ec <- waitForProcess ph
|
||||
result <- if ec == ExitSuccess
|
||||
then do
|
||||
-- filter \r so the tests will work on Windows machines
|
||||
outputContents <- readFile' outputPath >>=
|
||||
return . filter (/='\r') . normalizer
|
||||
normContents <- readFile' normPath >>=
|
||||
return . filter (/='\r') . normalizer
|
||||
if outputContents == normContents
|
||||
then return TestPassed
|
||||
else return
|
||||
$ TestFailed cmd normPath
|
||||
$ getDiff (lines outputContents) (lines normContents)
|
||||
else return $ TestError ec
|
||||
removeFile outputPath
|
||||
assertBool (show result) (result == TestPassed)
|
||||
36
tests/Tests/Readers/LaTeX.hs
Normal file
36
tests/Tests/Readers/LaTeX.hs
Normal file
|
|
@ -0,0 +1,36 @@
|
|||
module Tests.Readers.LaTeX (tests) where
|
||||
|
||||
import Text.Pandoc.Definition
|
||||
|
||||
import Test.Framework
|
||||
import Tests.Helpers
|
||||
|
||||
tests :: [Test]
|
||||
tests = [ testGroup "basic"
|
||||
[ latexTest "simplest" "word" (Inline $ Str "word")
|
||||
, latexTest "space" "some text"
|
||||
(Inlines $ [Str "some", Space, Str "text"])
|
||||
|
||||
, latexTest "emphasis" "\\emph{emphasized}"
|
||||
(Inline $ Emph [Str "emphasized"])
|
||||
]
|
||||
|
||||
, testGroup "headers"
|
||||
[ latexTest "1. level" "\\section{header}"
|
||||
$ Block $ Header 1 [Str "header"]
|
||||
|
||||
, latexTest "2. level" "\\subsection{header}"
|
||||
$ Block $ Header 2 [Str "header"]
|
||||
|
||||
, latexTest "3. level" "\\subsubsection{header}"
|
||||
$ Block $ Header 3 [Str "header"]
|
||||
|
||||
, latexTest "with emphasis" "\\section{text \\emph{emph}}"
|
||||
$ Block $ Header 1 [Str "text", Space, Emph [Str "emph"]]
|
||||
|
||||
, latexTest "with link" "\\section{text \\href{/url}{link}}"
|
||||
$ Block
|
||||
$ Header 1 [Str "text", Space, Link [Str "link"] ("/url", "")]
|
||||
]
|
||||
]
|
||||
|
||||
|
|
@ -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"] ]
|
||||
]
|
||||
|
|
|
|||
39
tests/lhs-test.nohl.html
Normal file
39
tests/lhs-test.nohl.html
Normal file
|
|
@ -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>
|
||||
<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
|
||||
<meta name="generator" content="pandoc" />
|
||||
<title></title>
|
||||
</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>
|
||||
39
tests/lhs-test.nohl.html+lhs
Normal file
39
tests/lhs-test.nohl.html+lhs
Normal file
|
|
@ -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>
|
||||
<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
|
||||
<meta name="generator" content="pandoc" />
|
||||
<title></title>
|
||||
</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>
|
||||
18
tests/test-pandoc.hs
Normal file
18
tests/test-pandoc.hs
Normal file
|
|
@ -0,0 +1,18 @@
|
|||
{-# OPTIONS_GHC -Wall #-}
|
||||
|
||||
module Main where
|
||||
|
||||
import Test.Framework
|
||||
|
||||
import qualified Tests.Old
|
||||
import qualified Tests.Readers.LaTeX
|
||||
|
||||
tests :: [Test]
|
||||
tests = [ testGroup "Old" Tests.Old.tests
|
||||
, testGroup "Readers"
|
||||
[ testGroup "LaTeX" Tests.Readers.LaTeX.tests
|
||||
]
|
||||
]
|
||||
|
||||
main :: IO ()
|
||||
main = defaultMain tests
|
||||
Loading…
Add table
Reference in a new issue