From 2415b2680a522e89b63abb370c02bfff54b824a2 Mon Sep 17 00:00:00 2001
From: John MacFarlane <jgm@berkeley.edu>
Date: Tue, 2 Feb 2021 17:09:16 -0800
Subject: [PATCH] Test suite: a more robust way of testing the executable.
Mmny of our tests require running the pandoc
executable. This is problematic for a few different reasons.
First, cabal-install will sometimes run the test suite
after building the library but before building the executable,
which means the executable isn't in place for the tests.
One can work around that by first building, then building
and running the tests, but that's fragile. Second,
we have to find the executable. So far, we've done that
using a function findPandoc that attempts to locate it
relative to the test executable (which can be located
using findExecutablePath). But the logic here is delicate
and work with every combination of options.
To solve both problems, we add an `--emulate` option to
the `test-pandoc` executable. When `--emulate` occurs
as the first argument passed to `test-pandoc`, the
program simply emulates the regular pandoc executable,
using the rest of the arguments (after `--emulate`).
Thus,
test-pandoc --emulate -f markdown -t latex
is just like
pandoc -f markdown -t latex
Since all the work is done by library functions,
implementing this emulation just takes a couple lines
of code and should be entirely reliable.
With this change, we can test the pandoc executable
by running the test program itself (locatable using
findExecutablePath) with the `--emulate` option.
This removes the need for the fragile `findPandoc`
step, and it means we can run our integration tests
even when we're just building the library, not the
executable.
Part of this change involved simplifying some complex
handling to set environment variables for dynamic
library paths. I have tested a build with
`--enable-dynamic-executable`, and it works, but
further testing may be needed.
---
test/Tests/Command.hs | 61 +++++++++++++++++++++++--------------------
test/Tests/Helpers.hs | 29 --------------------
test/Tests/Old.hs | 21 ++++++++-------
test/test-pandoc.hs | 25 +++++++++++++-----
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
+