aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--test/Tests/Command.hs61
-rw-r--r--test/Tests/Helpers.hs29
-rw-r--r--test/Tests/Old.hs21
-rw-r--r--test/test-pandoc.hs25
4 files changed, 64 insertions, 72 deletions
diff --git a/test/Tests/Command.hs b/test/Tests/Command.hs
index b3e2a0509..bbfa62dea 100644
--- a/test/Tests/Command.hs
+++ b/test/Tests/Command.hs
@@ -1,4 +1,5 @@
{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE TupleSections #-}
{- |
Module : Tests.Command
Copyright : © 2006-2021 John MacFarlane
@@ -10,11 +11,12 @@
Run commands, and test results, defined in markdown files.
-}
-module Tests.Command (findPandoc, runTest, tests)
+module Tests.Command (runTest, tests)
where
import Prelude
import Data.Algorithm.Diff
+import System.Environment.Executable (getExecutablePath)
import qualified Data.ByteString as BS
import qualified Data.Text as T
import Data.List (isSuffixOf, intercalate)
@@ -34,27 +36,21 @@ import Text.Pandoc
import qualified Text.Pandoc.UTF8 as UTF8
-- | Run a test with and return output.
-execTest :: FilePath -- ^ Path to pandoc
+execTest :: String -- ^ Path to test executable
-> String -- ^ Shell command
-> String -- ^ Input text
-> IO (ExitCode, String) -- ^ Exit code and actual output
-execTest pandocpath cmd inp = do
+execTest testExePath cmd inp = do
mldpath <- Env.lookupEnv "LD_LIBRARY_PATH"
mdyldpath <- Env.lookupEnv "DYLD_LIBRARY_PATH"
- let findDynlibDir [] = Nothing
- findDynlibDir ("build":xs) = Just $ joinPath (reverse xs) </> "build"
- findDynlibDir (_:xs) = findDynlibDir xs
- let mbDynlibDir = findDynlibDir (reverse $ splitDirectories $
- takeDirectory $ takeWhile (/=' ') cmd)
- let dynlibEnv = [("DYLD_LIBRARY_PATH",
- intercalate ":" $ catMaybes [mbDynlibDir, mdyldpath])
- ,("LD_LIBRARY_PATH",
- intercalate ":" $ catMaybes [mbDynlibDir, mldpath])]
- let env' = dynlibEnv ++ [("PATH",takeDirectory pandocpath),("TMP","."),
- ("LANG","en_US.UTF-8"),
- ("HOME", "./"),
- ("pandoc_datadir", "..")]
- let pr = (shell cmd){ env = Just env' }
+ let env' = ("PATH",takeDirectory testExePath) :
+ ("TMP",".") :
+ ("LANG","en_US.UTF-8") :
+ ("HOME", "./") :
+ ("pandoc_datadir", "..") :
+ maybe [] ((:[]) . ("LD_LIBRARY_PATH",)) mldpath ++
+ maybe [] ((:[]) . ("DYLD_LIBRARY_PATH",)) mdyldpath
+ let pr = (shell (pandocToEmulate True cmd)){ env = Just env' }
(ec, out', err') <- readCreateProcessWithExitCode pr inp
-- filter \r so the tests will work on Windows machines
let out = filter (/= '\r') $ err' ++ out'
@@ -63,15 +59,23 @@ execTest pandocpath cmd inp = do
ExitSuccess -> return ()
return (ec, out)
+pandocToEmulate :: Bool -> String -> String
+pandocToEmulate True ('p':'a':'n':'d':'o':'c':cs) =
+ "test-pandoc --emulate" ++ pandocToEmulate False cs
+pandocToEmulate False ('|':' ':'p':'a':'n':'d':'o':'c':cs) =
+ "| " ++ "test-pandoc --emulate" ++ pandocToEmulate False cs
+pandocToEmulate _ (c:cs) = c : pandocToEmulate False cs
+pandocToEmulate _ [] = []
+
-- | Run a test, return True if test passed.
-runTest :: String -- ^ Title of test
- -> FilePath -- ^ Path to pandoc
+runTest :: String -- ^ Path to test executable
+ -> String -- ^ Title of test
-> String -- ^ Shell command
-> String -- ^ Input text
-> String -- ^ Expected output
-> TestTree
-runTest testname pandocpath cmd inp norm = testCase testname $ do
- (ec, out) <- execTest pandocpath cmd inp
+runTest testExePath testname cmd inp norm = testCase testname $ do
+ (ec, out) <- execTest testExePath cmd inp
result <- if ec == ExitSuccess
then
if out == norm
@@ -82,12 +86,13 @@ runTest testname pandocpath cmd inp norm = testCase testname $ do
else return $ TestError ec
assertBool (show result) (result == TestPassed)
-tests :: FilePath -> TestTree
+tests :: TestTree
{-# NOINLINE tests #-}
-tests pandocPath = unsafePerformIO $ do
+tests = unsafePerformIO $ do
files <- filter (".md" `isSuffixOf`) <$>
getDirectoryContents "command"
- let cmds = map (extractCommandTest pandocPath) files
+ testExePath <- getExecutablePath
+ let cmds = map (extractCommandTest testExePath) files
return $ testGroup "Command:" cmds
isCodeBlock :: Block -> Bool
@@ -103,7 +108,7 @@ dropPercent ('%':xs) = dropWhile (== ' ') xs
dropPercent xs = xs
runCommandTest :: FilePath -> FilePath -> Int -> String -> TestTree
-runCommandTest pandocpath fp num code =
+runCommandTest testExePath fp num code =
goldenTest testname getExpected getActual compareValues updateGolden
where
testname = "#" <> show num
@@ -116,7 +121,7 @@ runCommandTest pandocpath fp num code =
input = unlines inplines
norm = unlines normlines
getExpected = return norm
- getActual = snd <$> execTest pandocpath cmd input
+ getActual = snd <$> execTest testExePath cmd input
compareValues expected actual
| actual == expected = return Nothing
| otherwise = return $ Just $ "--- test/command/" ++ fp ++ "\n+++ " ++
@@ -132,10 +137,10 @@ runCommandTest pandocpath fp num code =
UTF8.writeFile fp' updated
extractCommandTest :: FilePath -> FilePath -> TestTree
-extractCommandTest pandocpath fp = unsafePerformIO $ do
+extractCommandTest testExePath fp = unsafePerformIO $ do
contents <- UTF8.toText <$> BS.readFile ("command" </> fp)
Pandoc _ blocks <- runIOorExplode (readMarkdown
def{ readerExtensions = pandocExtensions } contents)
let codeblocks = map extractCode $ filter isCodeBlock blocks
- let cases = zipWith (runCommandTest pandocpath fp) [1..] codeblocks
+ let cases = zipWith (runCommandTest testExePath fp) [1..] codeblocks
return $ testGroup fp cases
diff --git a/test/Tests/Helpers.hs b/test/Tests/Helpers.hs
index 21898d10e..a4a3c0af5 100644
--- a/test/Tests/Helpers.hs
+++ b/test/Tests/Helpers.hs
@@ -15,7 +15,6 @@ Utility functions for the test suite.
module Tests.Helpers ( test
, TestResult(..)
, showDiff
- , findPandoc
, (=?>)
, purely
, ToString(..)
@@ -86,34 +85,6 @@ showDiff (l,r) (Second ln : ds) =
showDiff (l,r) (Both _ _ : ds) =
showDiff (l+1,r+1) ds
--- | Find pandoc executable relative to test-pandoc
-findPandoc :: IO FilePath
-findPandoc = do
- testExePath <- getExecutablePath
- let pandocDir =
- case reverse (splitDirectories (takeDirectory testExePath)) of
- -- cabalv2 with --disable-optimization
- "test-pandoc" : "build" : "noopt" : "test-pandoc" : "t" : ps
- -> joinPath (reverse ps) </>
- "x" </> "pandoc" </> "noopt" </> "build" </> "pandoc"
- -- cabalv2 without --disable-optimization
- "test-pandoc" : "build" : "test-pandoc" : "t" : ps
- -> joinPath (reverse ps) </>
- "x" </> "pandoc" </> "build" </> "pandoc"
- -- cabalv1
- "test-pandoc" : "build" : ps
- -> joinPath (reverse ps) </> "build" </> "pandoc"
- _ -> error "findPandoc: could not find pandoc executable"
- let pandocPath = pandocDir </> "pandoc"
-#ifdef _WINDOWS
- <.> "exe"
-#endif
- found <- doesFileExist pandocPath
- if found
- then return pandocPath
- else error $ "findPandoc: could not find pandoc executable at "
- ++ pandocPath
-
vividize :: Diff String -> String
vividize (Both s _) = " " ++ s
vividize (First s) = "- " ++ s
diff --git a/test/Tests/Old.hs b/test/Tests/Old.hs
index 638620a36..528388c51 100644
--- a/test/Tests/Old.hs
+++ b/test/Tests/Old.hs
@@ -1,4 +1,5 @@
{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE TupleSections #-}
{- |
Module : Tests.Old
Copyright : © 2006-2021 John MacFarlane
@@ -19,6 +20,7 @@ import Data.Maybe (catMaybes)
import System.Exit
import System.FilePath (joinPath, splitDirectories, (<.>), (</>))
import qualified System.Environment as Env
+import System.Environment.Executable (getExecutablePath)
import Text.Pandoc.Process (pipeProcess)
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.Golden.Advanced (goldenTest)
@@ -322,13 +324,14 @@ testWithNormalize normalizer pandocPath testname opts inp norm =
getActual = do
mldpath <- Env.lookupEnv "LD_LIBRARY_PATH"
mdyldpath <- Env.lookupEnv "DYLD_LIBRARY_PATH"
- let mbDynlibDir = findDynlibDir (reverse $
- splitDirectories pandocPath)
- let dynlibEnv = [("DYLD_LIBRARY_PATH", intercalate ":" $ catMaybes [mbDynlibDir, mdyldpath])
- ,("LD_LIBRARY_PATH", intercalate ":" $ catMaybes [mbDynlibDir, mldpath])]
- let env = dynlibEnv ++
- [("TMP","."),("LANG","en_US.UTF-8"),("HOME", "./")]
- (ec, out) <- pipeProcess (Just env) pandocPath options mempty
+ let env = ("TMP",".") :
+ ("LANG","en_US.UTF-8") :
+ ("HOME", "./") :
+ maybe [] ((:[]) . ("LD_LIBRARY_PATH",)) mldpath ++
+ maybe [] ((:[]) . ("DYLD_LIBRARY_PATH",)) mdyldpath
+
+ (ec, out) <- pipeProcess (Just env) pandocPath
+ ("--emulate":options) mempty
if ec == ExitSuccess
then return $ filter (/='\r') . normalizer
$ UTF8.toStringLazy out
@@ -339,8 +342,8 @@ testWithNormalize normalizer pandocPath testname opts inp norm =
compareValues :: FilePath -> [String] -> String -> String -> IO (Maybe String)
compareValues norm options expected actual = do
- pandocPath <- findPandoc
- let cmd = pandocPath ++ " " ++ unwords options
+ testExePath <- getExecutablePath
+ let cmd = testExePath ++ " --emulate " ++ unwords options
let dash = replicate 72 '-'
let diff = getDiff (lines actual) (lines expected)
if expected == actual
diff --git a/test/test-pandoc.hs b/test/test-pandoc.hs
index bb4db90b9..9973dffc8 100644
--- a/test/test-pandoc.hs
+++ b/test/test-pandoc.hs
@@ -4,6 +4,12 @@
module Main where
import Prelude
+import System.Environment (getArgs)
+import qualified Control.Exception as E
+import Text.Pandoc.App (convertWithOpts, defaultOpts, options,
+ parseOptionsFromArgs)
+import Text.Pandoc.Error (handleError)
+import System.Environment.Executable (getExecutablePath)
import GHC.IO.Encoding
import Test.Tasty
import qualified Tests.Command
@@ -46,12 +52,11 @@ import qualified Tests.Writers.Powerpoint
import qualified Tests.Writers.RST
import qualified Tests.Writers.AnnotatedTable
import qualified Tests.Writers.TEI
-import Tests.Helpers (findPandoc)
import Text.Pandoc.Shared (inDirectory)
tests :: FilePath -> TestTree
tests pandocPath = testGroup "pandoc tests"
- [ Tests.Command.tests pandocPath
+ [ Tests.Command.tests
, testGroup "Old" (Tests.Old.tests pandocPath)
, testGroup "Shared" Tests.Shared.tests
, testGroup "Writers"
@@ -102,7 +107,15 @@ tests pandocPath = testGroup "pandoc tests"
main :: IO ()
main = do
setLocaleEncoding utf8
- inDirectory "test" $ do
- fp <- findPandoc
- putStrLn $ "Using pandoc executable at " ++ fp
- defaultMain $ tests fp
+ args <- getArgs
+ case args of
+ "--emulate":args' -> -- emulate pandoc executable
+ E.catch
+ (parseOptionsFromArgs options defaultOpts "pandoc" args' >>=
+ convertWithOpts)
+ (handleError . Left)
+ _ -> inDirectory "test" $ do
+ fp <- getExecutablePath
+ -- putStrLn $ "Using pandoc executable at " ++ fp
+ defaultMain $ tests fp
+
generated by cgit v1.2.3 (git 2.39.1) at 2024-12-15 13:11:08 +0000