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.

1 files changed, 33 insertions, 28 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