diff options
Diffstat (limited to 'test/Tests/Old.hs.orig')
-rw-r--r-- | test/Tests/Old.hs.orig | 288 |
1 files changed, 288 insertions, 0 deletions
diff --git a/test/Tests/Old.hs.orig b/test/Tests/Old.hs.orig new file mode 100644 index 000000000..ed4dcc076 --- /dev/null +++ b/test/Tests/Old.hs.orig @@ -0,0 +1,288 @@ +module Tests.Old (tests) where + +import Data.Algorithm.Diff +import Prelude hiding (readFile) +import System.Exit +import System.FilePath (joinPath, splitDirectories, (<.>), (</>)) +import System.IO.Temp (withTempFile) +import System.Process (runProcess, waitForProcess) +import Test.Tasty (TestTree, testGroup) +import Test.Tasty.Golden.Advanced (goldenTest) +import Tests.Helpers hiding (test) +import qualified Text.Pandoc.UTF8 as UTF8 + +tests :: [TestTree] +tests = [ testGroup "markdown" + [ testGroup "writer" + $ writerTests "markdown" ++ lhsWriterTests "markdown" + , testGroup "reader" + [ test "basic" ["-r", "markdown", "-w", "native", "-s"] + "testsuite.txt" "testsuite.native" + , test "tables" ["-r", "markdown", "-w", "native", "--columns=80"] + "tables.txt" "tables.native" + , test "pipe tables" ["-r", "markdown", "-w", "native", "--columns=80"] + "pipe-tables.txt" "pipe-tables.native" + , test "more" ["-r", "markdown", "-w", "native", "-s"] + "markdown-reader-more.txt" "markdown-reader-more.native" + , lhsReaderTest "markdown+lhs" + ] + , testGroup "citations" + [ test "citations" ["-r", "markdown", "-w", "native"] + "markdown-citations.txt" "markdown-citations.native" + ] + ] + , testGroup "rst" + [ testGroup "writer" (writerTests "rst" ++ lhsWriterTests "rst") + , testGroup "reader" + [ test "basic" ["-r", "rst+smart", "-w", "native", + "-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+raw_tex", "-w", "native", "-s"] + "latex-reader.latex" "latex-reader.native" + , lhsReaderTest "latex+lhs" + ] + ] + , testGroup "html" + [ testGroup "writer" (writerTests "html4" ++ writerTests "html5" ++ + 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" [] "html4" + , s5WriterTest "inserts" ["-s", "-H", "insert", + "-B", "insert", "-A", "insert", "-c", "main.css"] "html4" + ] + , testGroup "textile" + [ testGroup "writer" $ writerTests "textile" + , test "reader" ["-r", "textile", "-w", "native", "-s"] + "textile-reader.textile" "textile-reader.native" + ] + , testGroup "docbook" + [ testGroup "writer" $ writerTests "docbook4" + , test "reader" ["-r", "docbook", "-w", "native", "-s"] + "docbook-reader.docbook" "docbook-reader.native" + , test "reader" ["-r", "docbook", "-w", "native", "-s"] + "docbook-xref.docbook" "docbook-xref.native" + ] + , testGroup "docbook5" + [ testGroup "writer" $ writerTests "docbook5" + ] + , testGroup "jats" + [ testGroup "writer" $ writerTests "jats" + , test "reader" ["-r", "jats", "-w", "native", "-s"] + "jats-reader.xml" "jats-reader.native" + ] + , testGroup "native" + [ testGroup "writer" $ writerTests "native" + , test "reader" ["-r", "native", "-w", "native", "-s"] + "testsuite.native" "testsuite.native" + ] + , testGroup "fb2" + [ fb2WriterTest "basic" [] "fb2/basic.markdown" "fb2/basic.fb2" + , fb2WriterTest "titles" [] "fb2/titles.markdown" "fb2/titles.fb2" + , fb2WriterTest "images" [] "fb2/images.markdown" "fb2/images.fb2" + , fb2WriterTest "images-embedded" [] "fb2/images-embedded.html" "fb2/images-embedded.fb2" + , fb2WriterTest "math" [] "fb2/math.markdown" "fb2/math.fb2" + , fb2WriterTest "tables" [] "tables.native" "tables.fb2" + , fb2WriterTest "testsuite" [] "testsuite.native" "writer.fb2" + ] + , testGroup "mediawiki" + [ testGroup "writer" $ writerTests "mediawiki" + , test "reader" ["-r", "mediawiki", "-w", "native", "-s"] + "mediawiki-reader.wiki" "mediawiki-reader.native" + ] + , testGroup "vimwiki" + [ test "reader" ["-r", "vimwiki", "-w", "native", "-s"] + "vimwiki-reader.wiki" "vimwiki-reader.native" + ] + , testGroup "dokuwiki" + [ testGroup "writer" $ writerTests "dokuwiki" + , test "inline_formatting" ["-r", "native", "-w", "dokuwiki", "-s"] + "dokuwiki_inline_formatting.native" "dokuwiki_inline_formatting.dokuwiki" + , test "multiblock table" ["-r", "native", "-w", "dokuwiki", "-s"] + "dokuwiki_multiblock_table.native" "dokuwiki_multiblock_table.dokuwiki" + , test "external images" ["-r", "native", "-w", "dokuwiki", "-s"] + "dokuwiki_external_images.native" "dokuwiki_external_images.dokuwiki" + ] + , testGroup "opml" + [ test "basic" ["-r", "native", "-w", "opml", "--columns=78", "-s"] + "testsuite.native" "writer.opml" + , test "reader" ["-r", "opml", "-w", "native", "-s"] + "opml-reader.opml" "opml-reader.native" + ] + , testGroup "haddock" + [ testGroup "writer" $ writerTests "haddock" + , test "reader" ["-r", "haddock", "-w", "native", "-s"] + "haddock-reader.haddock" "haddock-reader.native" + ] + , testGroup "txt2tags" + [ test "reader" ["-r", "t2t", "-w", "native", "-s"] + "txt2tags.t2t" "txt2tags.native" ] + , testGroup "epub" [ + test "features" ["-r", "epub", "-w", "native"] + "epub/features.epub" "epub/features.native" + , test "wasteland" ["-r", "epub", "-w", "native"] + "epub/wasteland.epub" "epub/wasteland.native" + , test "formatting" ["-r", "epub", "-w", "native"] + "epub/formatting.epub" "epub/formatting.native" + ] + , testGroup "twiki" + [ test "reader" ["-r", "twiki", "-w", "native", "-s"] + "twiki-reader.twiki" "twiki-reader.native" ] + , testGroup "tikiwiki" + [ test "reader" ["-r", "tikiwiki", "-w", "native", "-s"] + "tikiwiki-reader.tikiwiki" "tikiwiki-reader.native" ] + , testGroup "other writers" $ map (\f -> testGroup f $ writerTests f) + [ "opendocument" , "context" , "texinfo", "icml", "tei" + , "man" , "plain" , "rtf", "org", "asciidoc", "zimwiki" + ] + , testGroup "writers-lang-and-dir" + [ test "latex" ["-f", "native", "-t", "latex", "-s"] + "writers-lang-and-dir.native" "writers-lang-and-dir.latex" + , test "context" ["-f", "native", "-t", "context", "-s"] + "writers-lang-and-dir.native" "writers-lang-and-dir.context" + ] + , testGroup "muse" + [ testGroup "writer" $ writerTests "muse" + ] + , testGroup "ms" + [ testGroup "writer" $ writerTests "ms" + ] + , testGroup "creole" + [ test "reader" ["-r", "creole", "-w", "native", "-s"] + "creole-reader.txt" "creole-reader.native" + ] + , testGroup "custom writer" + [ test "basic" ["-f", "native", "-t", "../data/sample.lua"] + "testsuite.native" "writer.custom" + , test "tables" ["-f", "native", "-t", "../data/sample.lua"] + "tables.native" "tables.custom" + ] + ] + +-- makes sure file is fully closed after reading +readFile' :: FilePath -> IO String +readFile' f = do s <- UTF8.readFile f + return $! (length s `seq` s) + +lhsWriterTests :: String -> [TestTree] +lhsWriterTests format + = [ t "lhs to normal" format + , t "lhs to lhs" (format ++ "+lhs") + ] + where + t n f = test n ["--wrap=preserve", "-r", "native", "-s", "-w", f] + "lhs-test.native" ("lhs-test" <.> f) + +lhsReaderTest :: String -> TestTree +lhsReaderTest format = + test "lhs" ["-r", format, "-w", "native"] + ("lhs-test" <.> format) norm + where norm = if format == "markdown+lhs" + then "lhs-test-markdown.native" + else "lhs-test.native" + +writerTests :: String -> [TestTree] +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", + "--variable", "pandoc-version="] + +s5WriterTest :: String -> [String] -> String -> TestTree +s5WriterTest modifier opts format + = test (format ++ " writer (" ++ modifier ++ ")") + (["-r", "native", "-w", format] ++ opts) + "s5.native" ("s5-" ++ modifier <.> "html") + +fb2WriterTest :: String -> [String] -> String -> String -> TestTree +fb2WriterTest title opts inputfile normfile = + testWithNormalize (ignoreBinary . formatXML) + title (["-t", "fb2"]++opts) inputfile normfile + where + formatXML xml = splitTags $ zip xml (drop 1 xml) + splitTags [] = [] + splitTags [end] = fst end : snd end : [] + splitTags (('>','<'):rest) = ">\n" ++ splitTags rest + splitTags ((c,_):rest) = c : splitTags rest + ignoreBinary = unlines . filter (not . startsWith "<binary ") . lines + startsWith tag str = all (uncurry (==)) $ zip tag str + +-- | 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 + -> TestTree +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 + -> TestTree +testWithNormalize normalizer testname opts inp norm = + goldenTest testname getExpected getActual + (compareValues norm options) updateGolden + where getExpected = normalizer <$> readFile' norm + getActual = + withTempFile "." "pandoc-test" $ \outputPath hOut -> do + withTempFile "." "pandoc-test" $ \errorPath hErr -> do + pandocPath <- findPandoc + let mbDynlibDir = findDynlibDir (reverse $ + splitDirectories pandocPath) + let dynlibEnv = case mbDynlibDir of + Nothing -> [] + Just d -> [("DYLD_LIBRARY_PATH", d), + ("LD_LIBRARY_PATH", d)] + let env = dynlibEnv ++ + [("TMP","."),("LANG","en_US.UTF-8"),("HOME", "./"), + ("pandoc_datadir","..")] + ph <- runProcess pandocPath options Nothing + (Just env) Nothing (Just hOut) (Just hErr) + ec <- waitForProcess ph + if ec == ExitSuccess + then + -- filter \r so the tests will work on Windows machines + (filter (/='\r') . normalizer) <$> readFile' outputPath + else do + errcontents <- UTF8.readFile errorPath + fail $ "Pandoc failed with " ++ show ec ++ + if null errcontents + then "" + else '\n':errcontents + updateGolden = UTF8.writeFile norm + options = ["--quiet"] ++ [inp] ++ opts + +compareValues :: FilePath -> [String] -> String -> String -> IO (Maybe String) +compareValues norm options expected actual = do + pandocPath <- findPandoc + let cmd = pandocPath ++ " " ++ unwords options + let dash = replicate 72 '-' + let diff = getDiff (lines actual) (lines expected) + if expected == actual + then return Nothing + else return $ Just $ + '\n' : dash ++ + "\n--- " ++ norm ++ + "\n+++ " ++ cmd ++ "\n" ++ + showDiff (1,1) diff ++ dash + +findDynlibDir :: [FilePath] -> Maybe FilePath +findDynlibDir [] = Nothing +findDynlibDir ("build":xs) = Just $ joinPath (reverse xs) </> "build" +findDynlibDir (_:xs) = findDynlibDir xs |