Tissevert/pandoc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions 1

Test suite: a more robust way of testing the executable.

Browse source 
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.
This commit is contained in:
John MacFarlane 2021-02-02 17:09:16 -08:00
parent ec8509295a
commit 2415b2680a
4 changed files with 64 additions and 72 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

61
test/Tests/Command.hs
View file

@ -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

29
test/Tests/Helpers.hs
View file

@ -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

21
test/Tests/Old.hs
View file

@ -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

25
test/test-pandoc.hs
View file

@ -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