Tests.Helpers: export testGolden and use it in RTF reader.

This gives a diff output on failure.
This commit is contained in:
John MacFarlane 2021-08-10 22:07:48 -07:00
parent 3a924d8f96
commit 06d97131e5
2 changed files with 27 additions and 13 deletions

View file

@ -16,6 +16,7 @@ module Tests.Helpers ( test
, TestResult(..)
, setupEnvironment
, showDiff
, testGolden
, (=?>)
, purely
, ToString(..)
@ -23,13 +24,16 @@ module Tests.Helpers ( test
)
where
import System.FilePath
import Data.Algorithm.Diff
import qualified Data.Map as M
import qualified Text.Pandoc.UTF8 as UTF8
import Data.Text (Text, unpack)
import qualified Data.Text as T
import System.Exit
import System.FilePath (takeDirectory)
import qualified System.Environment as Env
import Test.Tasty
import Test.Tasty.Golden.Advanced (goldenTest)
import Test.Tasty.HUnit
import Text.Pandoc.Builder (Blocks, Inlines, doc, plain)
import Text.Pandoc.Class
@ -61,6 +65,23 @@ test fn name (input, expected) =
dashes "" = replicate 72 '-'
dashes x = replicate (72 - length x - 5) '-' ++ " " ++ x ++ " ---"
testGolden :: TestName -> FilePath -> FilePath -> (Text -> IO Text) -> TestTree
testGolden name expectedPath inputPath fn =
goldenTest
name
(UTF8.readFile expectedPath)
(UTF8.readFile inputPath >>= fn)
compareVals
(UTF8.writeFile expectedPath)
where
compareVals expected actual
| expected == actual = return Nothing
| otherwise = return $ Just $
"\n--- " ++ expectedPath ++ "\n+++\n" ++
showDiff (1,1)
(getDiff (lines . filter (/='\r') $ T.unpack actual)
(lines . filter (/='\r') $ T.unpack expected))
-- | Set up environment for pandoc command tests.
setupEnvironment :: FilePath -> IO [(String, String)]
setupEnvironment testExePath = do

View file

@ -13,25 +13,18 @@ module Tests.Readers.RTF (tests) where
import Test.Tasty
import Tests.Helpers
import Test.Tasty.Golden (goldenVsString)
import qualified Data.ByteString as BS
import Text.Pandoc
import Text.Pandoc.UTF8 (toText, fromStringLazy)
import Data.Text (Text, unpack)
import System.FilePath (replaceExtension, (</>), (<.>))
rtfToNative :: Text -> Text
rtfToNative =
purely (writeNative def{ writerTemplate = Just mempty }) .
purely (readRTF def)
rtfTest :: TestName -> TestTree
rtfTest name = goldenVsString name native
(fromStringLazy . filter (/='\r') . unpack . rtfToNative . toText
<$> BS.readFile path)
rtfTest name = testGolden name native path
(\t -> runIOorExplode
(readRTF def t >>=
writeNative def{ writerTemplate = Just mempty }))
where native = replaceExtension path ".native"
path = "rtf" </> name <.> "rtf"
tests :: [TestTree]
tests = map rtfTest [ "footnote"
, "accent"