Use Diff for diffs in golden tests

haskell · Aug 16, 2017 · e3ca680 · e3ca680
1 parent b25965d
commit e3ca680
Show file tree

Hide file tree

Showing 3 changed files with 46 additions and 6 deletions.
diff --git a/Cabal/Cabal.cabal b/Cabal/Cabal.cabal
@@ -388,6 +388,7 @@ test-suite parser-tests
     tasty-hunit,
     tasty-quickcheck,
     tasty-golden >=2.3.1.1 && <2.4,
+    Diff >=0.3.4 && <0.4,
     Cabal
   ghc-options: -Wall
   default-language: Haskell2010
@@ -402,6 +403,7 @@ test-suite check-tests
     filepath,
     tasty,
     tasty-golden >=2.3.1.1 && <2.4,
+    Diff >=0.3.4 && <0.4,
     Cabal
   ghc-options: -Wall
   default-language: Haskell2010

diff --git a/Cabal/tests/CheckTests.hs b/Cabal/tests/CheckTests.hs
@@ -3,15 +3,18 @@ module Main
     ) where
 
 import Test.Tasty
-import Test.Tasty.Golden (goldenVsString)
+import Test.Tasty.Golden.Advanced (goldenTest)
 
 import Distribution.PackageDescription.Parsec (parseGenericPackageDescription)
 import Distribution.PackageDescription.Check (checkPackage)
 import Distribution.Parsec.Types.ParseResult (runParseResult)
-import Distribution.Utils.Generic (toUTF8LBS)
+import Distribution.Utils.Generic (toUTF8LBS, fromUTF8LBS)
 import System.FilePath ((</>), replaceExtension)
+import Data.Algorithm.Diff (Diff (..), getGroupedDiff)
 
 import qualified Data.ByteString as BS
+import qualified Data.ByteString.Lazy as LBS
+import qualified Data.ByteString.Lazy.Char8 as LBS8
 
 tests :: TestTree
 tests = checkTests
@@ -26,7 +29,7 @@ checkTests = testGroup "regressions"
     ]
 
 checkTest :: FilePath -> TestTree
-checkTest fp = goldenVsString fp correct $ do
+checkTest fp = cabalGoldenTest fp correct $ do
     contents <- BS.readFile input
     let res =  parseGenericPackageDescription contents
     let (_, errs, x) = runParseResult res
@@ -46,3 +49,19 @@ checkTest fp = goldenVsString fp correct $ do
 
 main :: IO ()
 main = defaultMain tests
+
+cabalGoldenTest :: TestName -> FilePath -> IO LBS.ByteString -> TestTree
+cabalGoldenTest name ref act = goldenTest name (LBS.readFile ref) act cmp upd
+  where
+    upd = LBS.writeFile ref
+    cmp x y | x == y = return Nothing
+    cmp x y = return $ Just $ unlines $
+        concatMap f (getGroupedDiff (LBS8.lines x) (LBS8.lines y))
+      where
+        f (First xs)  = map (cons3 '-' . fromUTF8LBS) xs
+        f (Second ys) = map (cons3 '+' . fromUTF8LBS) ys
+        -- we print unchanged lines too. It shouldn't be a problem while we have
+        -- reasonably small examples
+        f (Both xs _) = map (cons3 ' ' . fromUTF8LBS) xs
+        -- we add three characters, so the changed lines are easier to spot
+        cons3 c cs = c : c : c : ' ' : cs
diff --git a/Cabal/tests/ParserTests.hs b/Cabal/tests/ParserTests.hs
@@ -4,17 +4,20 @@ module Main
 
 import Test.Tasty
 import Test.Tasty.HUnit
-import Test.Tasty.Golden (goldenVsString)
+import Test.Tasty.Golden.Advanced (goldenTest)
 
 import Data.Maybe (isJust)
 import Distribution.PackageDescription.Parsec (parseGenericPackageDescription)
 import Distribution.PackageDescription.PrettyPrint (showGenericPackageDescription)
 import Distribution.Parsec.Types.Common (PWarnType (..), PWarning (..))
 import Distribution.Parsec.Types.ParseResult (runParseResult)
-import Distribution.Utils.Generic (toUTF8LBS)
+import Distribution.Utils.Generic (toUTF8LBS, fromUTF8LBS)
 import System.FilePath ((</>), replaceExtension)
+import Data.Algorithm.Diff (Diff (..), getGroupedDiff)
 
 import qualified Data.ByteString as BS
+import qualified Data.ByteString.Lazy as LBS
+import qualified Data.ByteString.Lazy.Char8 as LBS8
 
 tests :: TestTree
 tests = testGroup "parsec tests"
@@ -71,7 +74,7 @@ regressionTests = testGroup "regressions"
     ]
 
 regressionTest :: FilePath -> TestTree
-regressionTest fp = goldenVsString fp correct $ do
+regressionTest fp = cabalGoldenTest fp correct $ do
     contents <- BS.readFile input
     let res =  parseGenericPackageDescription contents
     let (_, errs, x) = runParseResult res
@@ -91,3 +94,19 @@ regressionTest fp = goldenVsString fp correct $ do
 
 main :: IO ()
 main = defaultMain tests
+
+cabalGoldenTest :: TestName -> FilePath -> IO LBS.ByteString -> TestTree
+cabalGoldenTest name ref act = goldenTest name (LBS.readFile ref) act cmp upd
+  where
+    upd = LBS.writeFile ref
+    cmp x y | x == y = return Nothing
+    cmp x y = return $ Just $ unlines $
+        concatMap f (getGroupedDiff (LBS8.lines x) (LBS8.lines y))
+      where
+        f (First xs)  = map (cons3 '-' . fromUTF8LBS) xs
+        f (Second ys) = map (cons3 '+' . fromUTF8LBS) ys
+        -- we print unchanged lines too. It shouldn't be a problem while we have
+        -- reasonably small examples
+        f (Both xs _) = map (cons3 ' ' . fromUTF8LBS) xs
+        -- we add three characters, so the changed lines are easier to spot
+        cons3 c cs = c : c : c : ' ' : cs