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(..) , TestResult(..)
, setupEnvironment , setupEnvironment
, showDiff , showDiff
, testGolden
, (=?>) , (=?>)
, purely , purely
, ToString(..) , ToString(..)
@ -23,13 +24,16 @@ module Tests.Helpers ( test
) )
where where
import System.FilePath
import Data.Algorithm.Diff import Data.Algorithm.Diff
import qualified Data.Map as M import qualified Data.Map as M
import qualified Text.Pandoc.UTF8 as UTF8
import Data.Text (Text, unpack) import Data.Text (Text, unpack)
import qualified Data.Text as T
import System.Exit import System.Exit
import System.FilePath (takeDirectory)
import qualified System.Environment as Env import qualified System.Environment as Env
import Test.Tasty import Test.Tasty
import Test.Tasty.Golden.Advanced (goldenTest)
import Test.Tasty.HUnit import Test.Tasty.HUnit
import Text.Pandoc.Builder (Blocks, Inlines, doc, plain) import Text.Pandoc.Builder (Blocks, Inlines, doc, plain)
import Text.Pandoc.Class import Text.Pandoc.Class
@ -61,6 +65,23 @@ test fn name (input, expected) =
dashes "" = replicate 72 '-' dashes "" = replicate 72 '-'
dashes x = replicate (72 - length x - 5) '-' ++ " " ++ x ++ " ---" 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. -- | Set up environment for pandoc command tests.
setupEnvironment :: FilePath -> IO [(String, String)] setupEnvironment :: FilePath -> IO [(String, String)]
setupEnvironment testExePath = do setupEnvironment testExePath = do

View file

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