Merge branch 'tests'

4 files changed, 453 insertions, 0 deletions

diff --git a/tests/Tests/Arbitrary.hs b/tests/Tests/Arbitrary.hs
new file mode 100644
index 000000000..bd506a44f
--- /dev/null
+++ b/tests/Tests/Arbitrary.hs
@@ -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"
+
diff --git a/tests/Tests/Helpers.hs b/tests/Tests/Helpers.hs
new file mode 100644
index 000000000..539b26dcd
--- /dev/null
+++ b/tests/Tests/Helpers.hs
@@ -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 
+
diff --git a/tests/Tests/Old.hs b/tests/Tests/Old.hs
new file mode 100644
index 000000000..7d1df3758
--- /dev/null
+++ b/tests/Tests/Old.hs
@@ -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)
diff --git a/tests/Tests/Readers/LaTeX.hs b/tests/Tests/Readers/LaTeX.hs
new file mode 100644
index 000000000..99ccb3fe2
--- /dev/null
+++ b/tests/Tests/Readers/LaTeX.hs
@@ -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", "")]
+          ]
+        ]
+