From e61348dc11f743289e9cb8cb4981eaba1d4fccdc Mon Sep 17 00:00:00 2001 From: Nathan Gass Date: Wed, 12 Jan 2011 19:10:56 +0100 Subject: Reordered test files. --- tests/Helpers.hs | 26 ------ tests/Latex/Reader.hs | 35 -------- tests/Old.hs | 189 ------------------------------------------- tests/Tests/Old.hs | 189 +++++++++++++++++++++++++++++++++++++++++++ tests/Tests/Readers/LaTeX.hs | 35 ++++++++ tests/Tests/Shared.hs | 26 ++++++ tests/test-pandoc.hs | 10 +-- 7 files changed, 255 insertions(+), 255 deletions(-) delete mode 100644 tests/Helpers.hs delete mode 100644 tests/Latex/Reader.hs delete mode 100644 tests/Old.hs create mode 100644 tests/Tests/Old.hs create mode 100644 tests/Tests/Readers/LaTeX.hs create mode 100644 tests/Tests/Shared.hs (limited to 'tests') diff --git a/tests/Helpers.hs b/tests/Helpers.hs deleted file mode 100644 index a8732fa7a..000000000 --- a/tests/Helpers.hs +++ /dev/null @@ -1,26 +0,0 @@ -module 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 = latexTestWithState defaultParserState - -latexTestWithState :: ParserState -> String -> String -> Expect -> Test -latexTestWithState state name string exp = testCase name $ exp `assertPandoc` readLaTeX state string - diff --git a/tests/Latex/Reader.hs b/tests/Latex/Reader.hs deleted file mode 100644 index d313b33eb..000000000 --- a/tests/Latex/Reader.hs +++ /dev/null @@ -1,35 +0,0 @@ -module Latex.Reader (tests) where - -import Text.Pandoc.Definition - -import Test.Framework -import 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", "")] - ] - ] - diff --git a/tests/Old.hs b/tests/Old.hs deleted file mode 100644 index 1d9540fdd..000000000 --- a/tests/Old.hs +++ /dev/null @@ -1,189 +0,0 @@ - -module 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/Old.hs b/tests/Tests/Old.hs new file mode 100644 index 000000000..c7dca6ec1 --- /dev/null +++ b/tests/Tests/Old.hs @@ -0,0 +1,189 @@ + +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..58a27f09b --- /dev/null +++ b/tests/Tests/Readers/LaTeX.hs @@ -0,0 +1,35 @@ +module Tests.Readers.LaTeX (tests) where + +import Text.Pandoc.Definition + +import Test.Framework +import Tests.Shared + +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", "")] + ] + ] + diff --git a/tests/Tests/Shared.hs b/tests/Tests/Shared.hs new file mode 100644 index 000000000..3cf8d5689 --- /dev/null +++ b/tests/Tests/Shared.hs @@ -0,0 +1,26 @@ +module Tests.Shared 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 = latexTestWithState defaultParserState + +latexTestWithState :: ParserState -> String -> String -> Expect -> Test +latexTestWithState state name string exp = testCase name $ exp `assertPandoc` readLaTeX state string + diff --git a/tests/test-pandoc.hs b/tests/test-pandoc.hs index cf7a7e5e4..b67998177 100644 --- a/tests/test-pandoc.hs +++ b/tests/test-pandoc.hs @@ -4,13 +4,13 @@ module Main where import Test.Framework -import qualified Old -import qualified Latex.Reader +import qualified Tests.Old +import qualified Tests.Readers.LaTeX tests :: [Test] -tests = [ testGroup "Old" Old.tests - , testGroup "Latex" [ testGroup "Reader" Latex.Reader.tests - ] +tests = [ testGroup "Old" Tests.Old.tests + , testGroup "Readers" [ testGroup "LaTeX" Tests.Readers.LaTeX.tests + ] ] main :: IO () -- cgit v1.2.3