summaryrefslogtreecommitdiff
path: root/test/Tests/Old.hs
diff options
context:
space:
mode:
Diffstat (limited to 'test/Tests/Old.hs')
-rw-r--r--test/Tests/Old.hs289
1 files changed, 289 insertions, 0 deletions
diff --git a/test/Tests/Old.hs b/test/Tests/Old.hs
new file mode 100644
index 000000000..b82251a56
--- /dev/null
+++ b/test/Tests/Old.hs
@@ -0,0 +1,289 @@
+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
+
generated by cgit v1.2.3 (git 2.25.1) at 2024-04-16 23:51:12 +0000