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.

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
+