Use tasty-golden for golden tests in Old.
This commit is contained in:
parent
93c49a2865
commit
2235c2a8f7
2 changed files with 54 additions and 39 deletions
|
@ -509,10 +509,12 @@ Test-Suite test-pandoc
|
|||
filepath >= 1.1 && < 1.5,
|
||||
process >= 1.2.3 && < 1.5,
|
||||
skylighting >= 0.3.1 && < 0.4,
|
||||
temporary >= 1.1 && < 1.3,
|
||||
Diff >= 0.2 && < 0.4,
|
||||
tasty >= 0.11 && < 0.12,
|
||||
tasty-hunit >= 0.9 && < 0.10,
|
||||
tasty-quickcheck >= 0.8 && < 0.9,
|
||||
tasty-golden >= 2.3 && < 2.4,
|
||||
QuickCheck >= 2.4 && < 2.10,
|
||||
HUnit >= 1.2 && < 1.6,
|
||||
containers >= 0.1 && < 0.6,
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
Loading…
Add table
Reference in a new issue