Use tasty-golden for golden tests in Old.

1 files changed, 52 insertions, 39 deletions

diff --git a/test/Tests/Old.hs b/test/Tests/Old.hs
index 87ebfda93..9e772e791 100644
--- a/test/Tests/Old.hs
+++ b/test/Tests/Old.hs
@@ -2,13 +2,12 @@ module Tests.Old (tests) where
 
 import Data.Algorithm.Diff
 import Prelude hiding (readFile)
-import System.Directory
 import System.Exit
 import System.FilePath (joinPath, splitDirectories, (<.>), (</>))
-import System.IO (openTempFile, stderr)
+import System.IO.Temp (withTempFile)
 import System.Process (runProcess, waitForProcess)
 import Test.Tasty (TestTree, testGroup)
-import Test.Tasty.HUnit
+import Test.Tasty.Golden.Advanced (goldenTest)
 import Tests.Helpers hiding (test)
 import qualified Text.Pandoc.UTF8 as UTF8
 
@@ -211,40 +210,54 @@ testWithNormalize  :: (String -> String) -- ^ Normalize function for output
                    -> String    -- ^ Input filepath
                    -> FilePath  -- ^ Norm (for test results) filepath
                    -> TestTree
-testWithNormalize normalizer testname opts inp norm = testCase testname $ do
-  -- find pandoc executable relative to test-pandoc
-  -- First, try in same directory (e.g. if both in ~/.cabal/bin)
-  -- Second, try ../pandoc (e.g. if in dist/XXX/build/test-pandoc)
+testWithNormalize normalizer testname opts inp norm =
+  goldenTest testname getExpected getActual
+    (compareValues norm options) updateGolden
+  where getExpected = normalizer <$> readFile' norm
+        getActual   =
+          withTempFile "." "pandoc-test" $ \outputPath hOut -> do
+            withTempFile "." "pandoc-test" $ \errorPath hErr -> do
+              pandocPath <- findPandoc
+              let mbDynlibDir = findDynlibDir (reverse $
+                                 splitDirectories pandocPath)
+              let dynlibEnv = case mbDynlibDir of
+                                   Nothing  -> []
+                                   Just d   -> [("DYLD_LIBRARY_PATH", d),
+                                                ("LD_LIBRARY_PATH", d)]
+              let env = dynlibEnv ++
+                        [("TMP","."),("LANG","en_US.UTF-8"),("HOME", "./")]
+              ph <- runProcess pandocPath options Nothing
+                    (Just env) Nothing (Just hOut) (Just hErr)
+              ec <- waitForProcess ph
+              if ec == ExitSuccess
+                 then
+                   -- filter \r so the tests will work on Windows machines
+                   (filter (/='\r') . normalizer) <$> readFile' outputPath
+                 else do
+                   errcontents <- UTF8.readFile errorPath
+                   fail $ "Pandoc failed with " ++ show ec ++
+                           if null errcontents
+                              then ""
+                              else '\n':errcontents
+        updateGolden = UTF8.writeFile norm
+        options = ["--quiet", "--data-dir", ".." </> "data"] ++ [inp] ++ opts
+
+compareValues :: FilePath -> [String] -> String -> String -> IO (Maybe String)
+compareValues norm options expected actual = do
   pandocPath <- findPandoc
-  (outputPath, hOut) <- openTempFile "" "pandoc-test"
-  let inpPath = inp
-  let normPath = norm
-  let options = ["--quiet", "--data-dir", ".." </> "data"] ++ [inpPath] ++ opts
-  let cmd = pandocPath ++ " " ++ unwords options
-  let findDynlibDir []           = Nothing
-      findDynlibDir ("build":xs) = Just $ joinPath (reverse xs) </> "build"
-      findDynlibDir (_:xs)       = findDynlibDir xs
-  let mbDynlibDir = findDynlibDir (reverse $ splitDirectories pandocPath)
-  let dynlibEnv = case mbDynlibDir of
-                       Nothing  -> []
-                       Just d   -> [("DYLD_LIBRARY_PATH", d),
-                                    ("LD_LIBRARY_PATH", d)]
-  let env = dynlibEnv ++ [("TMP","."),("LANG","en_US.UTF-8"),("HOME", "./")]
-  ph <- runProcess pandocPath options Nothing
-        (Just env) Nothing (Just hOut) (Just stderr)
-  ec <- waitForProcess ph
-  result  <- if ec == ExitSuccess
-                then do
-                  -- filter \r so the tests will work on Windows machines
-                  outputContents <- readFile' outputPath >>=
-                    return . filter (/='\r') . normalizer
-                  normContents <- readFile' normPath >>=
-                    return . filter (/='\r') . normalizer
-                  if outputContents == normContents
-                     then return TestPassed
-                     else return
-                          $ TestFailed cmd normPath
-                          $ getDiff (lines outputContents) (lines normContents)
-                else return $ TestError ec
-  removeFile outputPath
-  assertBool (show result) (result == TestPassed)
+  let cmd  = pandocPath ++ " " ++ unwords options
+  let dash = replicate 72 '-'
+  let diff = getDiff (lines actual) (lines expected)
+  if expected == actual
+     then return Nothing
+     else return $ Just $
+        '\n' : dash ++
+        "\n--- " ++ norm ++
+        "\n+++ " ++ cmd ++ "\n" ++
+        showDiff (1,1) diff ++ dash
+
+findDynlibDir :: [FilePath] -> Maybe FilePath
+findDynlibDir []           = Nothing
+findDynlibDir ("build":xs) = Just $ joinPath (reverse xs) </> "build"
+findDynlibDir (_:xs)       = findDynlibDir xs
+