pandoc/test/test-pandoc.hs

123 lines
4.8 KiB
Haskell
Raw Normal View History

{-# OPTIONS_GHC -Wall #-}
module Main where
import System.Environment (getArgs, getExecutablePath)
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.
2021-02-03 02:09:16 +01:00
import qualified Control.Exception as E
import Text.Pandoc.App (convertWithOpts, defaultOpts, options,
parseOptionsFromArgs)
import Text.Pandoc.Error (handleError)
import GHC.IO.Encoding
import Test.Tasty
2017-02-04 17:38:03 +01:00
import qualified Tests.Command
import qualified Tests.Lua
import qualified Tests.Lua.Module
import qualified Tests.Old
import qualified Tests.Readers.Creole
import qualified Tests.Readers.Docx
import qualified Tests.Readers.DokuWiki
import qualified Tests.Readers.EPUB
2018-04-26 21:33:18 +02:00
import qualified Tests.Readers.FB2
import qualified Tests.Readers.HTML
import qualified Tests.Readers.JATS
2019-12-18 06:07:46 +01:00
import qualified Tests.Readers.Jira
2011-01-12 19:10:56 +01:00
import qualified Tests.Readers.LaTeX
2011-01-27 07:09:09 +01:00
import qualified Tests.Readers.Markdown
import qualified Tests.Readers.Muse
import qualified Tests.Readers.Odt
import qualified Tests.Readers.Org
2011-01-26 18:10:39 +01:00
import qualified Tests.Readers.RST
import qualified Tests.Readers.RTF
2014-07-25 21:39:13 +02:00
import qualified Tests.Readers.Txt2Tags
2018-02-25 01:34:17 +01:00
import qualified Tests.Readers.Man
import qualified Tests.Shared
import qualified Tests.Writers.AsciiDoc
import qualified Tests.Writers.ConTeXt
import qualified Tests.Writers.Docbook
import qualified Tests.Writers.Docx
2017-10-28 17:13:51 +02:00
import qualified Tests.Writers.FB2
import qualified Tests.Writers.HTML
import qualified Tests.Writers.JATS
import qualified Tests.Writers.Jira
import qualified Tests.Writers.LaTeX
import qualified Tests.Writers.Markdown
import qualified Tests.Writers.Ms
import qualified Tests.Writers.Muse
import qualified Tests.Writers.Native
2017-02-12 15:09:07 +01:00
import qualified Tests.Writers.Org
import qualified Tests.Writers.Plain
import qualified Tests.Writers.Powerpoint
import qualified Tests.Writers.RST
import qualified Tests.Writers.AnnotatedTable
2015-12-24 17:36:58 +01:00
import qualified Tests.Writers.TEI
import qualified Tests.Writers.Markua
import Text.Pandoc.Shared (inDirectory)
tests :: FilePath -> TestTree
tests pandocPath = testGroup "pandoc tests"
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.
2021-02-03 02:09:16 +01:00
[ Tests.Command.tests
, testGroup "Old" (Tests.Old.tests pandocPath)
, testGroup "Shared" Tests.Shared.tests
, testGroup "Writers"
[ testGroup "Native" Tests.Writers.Native.tests
, testGroup "ConTeXt" Tests.Writers.ConTeXt.tests
, testGroup "LaTeX" Tests.Writers.LaTeX.tests
, testGroup "HTML" Tests.Writers.HTML.tests
, testGroup "JATS" Tests.Writers.JATS.tests
, testGroup "Jira" Tests.Writers.Jira.tests
, testGroup "Docbook" Tests.Writers.Docbook.tests
, testGroup "Markdown" Tests.Writers.Markdown.tests
2017-02-12 15:09:07 +01:00
, testGroup "Org" Tests.Writers.Org.tests
, testGroup "Plain" Tests.Writers.Plain.tests
, testGroup "AsciiDoc" Tests.Writers.AsciiDoc.tests
2015-03-03 12:37:02 +01:00
, testGroup "Docx" Tests.Writers.Docx.tests
, testGroup "RST" Tests.Writers.RST.tests
2015-12-24 17:36:58 +01:00
, testGroup "TEI" Tests.Writers.TEI.tests
, testGroup "markua" Tests.Writers.Markua.tests
, testGroup "Muse" Tests.Writers.Muse.tests
2017-10-28 17:13:51 +02:00
, testGroup "FB2" Tests.Writers.FB2.tests
, testGroup "PowerPoint" Tests.Writers.Powerpoint.tests
, testGroup "Ms" Tests.Writers.Ms.tests
, testGroup "AnnotatedTable" Tests.Writers.AnnotatedTable.tests
]
, testGroup "Readers"
[ testGroup "LaTeX" Tests.Readers.LaTeX.tests
2011-01-27 07:09:09 +01:00
, testGroup "Markdown" Tests.Readers.Markdown.tests
, testGroup "HTML" Tests.Readers.HTML.tests
, testGroup "JATS" Tests.Readers.JATS.tests
2019-12-18 06:07:46 +01:00
, testGroup "Jira" Tests.Readers.Jira.tests
, testGroup "Org" Tests.Readers.Org.tests
2011-01-26 18:10:39 +01:00
, testGroup "RST" Tests.Readers.RST.tests
, testGroup "RTF" Tests.Readers.RTF.tests
, testGroup "Docx" Tests.Readers.Docx.tests
, testGroup "Odt" Tests.Readers.Odt.tests
2014-07-25 21:39:13 +02:00
, testGroup "Txt2Tags" Tests.Readers.Txt2Tags.tests
, testGroup "EPUB" Tests.Readers.EPUB.tests
2017-06-19 10:46:02 +02:00
, testGroup "Muse" Tests.Readers.Muse.tests
, testGroup "Creole" Tests.Readers.Creole.tests
2018-05-09 02:24:45 +02:00
, testGroup "Man" Tests.Readers.Man.tests
2018-04-26 21:33:18 +02:00
, testGroup "FB2" Tests.Readers.FB2.tests
, testGroup "DokuWiki" Tests.Readers.DokuWiki.tests
]
, testGroup "Lua"
[ testGroup "Lua filters" Tests.Lua.tests
, testGroup "Lua modules" Tests.Lua.Module.tests
]
]
main :: IO ()
main = do
setLocaleEncoding utf8
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.
2021-02-03 02:09:16 +01:00
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