tasty-silver 3.1.7 → 3.1.8

raw patch · 5 files changed

+93/−65 lines, 5 filesdep ~basePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• Test/Tasty/Silver.hs +3/−10
• Test/Tasty/Silver/Advanced.hs +21/−1
• Test/Tasty/Silver/Interactive.hs +63/−48
• Test/Tasty/Silver/Internal.hs +5/−5
• tasty-silver.cabal +1/−1

@@ -56,7 +56,6 @@  import Test.Tasty.Providers import Test.Tasty.Silver.Advanced-import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString as BS import System.Exit #if __GLASGOW_HASKELL__ < 710@@ -82,7 +81,7 @@ goldenVsFile name ref new act =   goldenTest1     name-    (maybe Nothing (Just . decodeUtf8) <$> readFileMaybe ref)+    (fmap decodeUtf8 <$> readFileMaybe ref)     (act >> (decodeUtf8 <$> BS.readFile new))     textLikeDiff     textLikeShow@@ -115,17 +114,11 @@ goldenVsAction name ref act toTxt =   goldenTest1     name-    (maybe Nothing (Just . decodeUtf8) <$> readFileMaybe ref)+    (fmap decodeUtf8 <$> readFileMaybe ref)     (toTxt <$> act)     textLikeDiff     textLikeShow-    (upd . fromStrict . encodeUtf8)-  where upd = BL.writeFile ref-#if __GLASGOW_HASKELL__ < 706-        fromStrict x = BL.fromChunks [x]-#else-        fromStrict = BL.fromStrict-#endif+    (BS.writeFile ref . encodeUtf8)  textLikeShow :: T.Text -> GShow textLikeShow = ShowText

@@ -5,6 +5,7 @@     goldenTest1,      goldenTestIO,+    goldenTestIO1,     goldenTest,      GShow (..),@@ -80,4 +81,23 @@   -> (a -> IO GShow) -- ^ Show the golden/actual value.   -> (a -> IO ()) -- ^ update the golden file   -> TestTree-goldenTestIO t golden test diff shw upd = singleTest t $ Golden golden test diff shw upd+goldenTestIO t golden test diff shw upd = goldenTestIO1 t golden test diff shw (Just upd)++-- | A very general testing function.+-- Experimental function, may change in later versions!+-- The IO version of show/diff are useful when using external diff or show mechanisms. If IO is not required,+-- the `goldenTest1` function should be used instead.+goldenTestIO1+  :: TestName -- ^ test name+  -> (IO (Maybe a)) -- ^ get the golden correct value+  -> (IO a) -- ^ get the tested value+  -> (a -> a -> IO GDiff)+    -- ^ comparison function.+    --+    -- If two values are the same, it should return 'Equal'. If they are+    -- different, it should return a diff representation.+    -- First argument is golden value.+  -> (a -> IO GShow) -- ^ Show the golden/actual value.+  -> (Maybe (a -> IO ())) -- ^ update the golden file+  -> TestTree+goldenTestIO1 t golden test diff shw upd = singleTest t $ Golden golden test diff shw upd

@@ -288,7 +288,6 @@         pref = indent level ++ replicate (length name) ' ' ++ "  " ++ align         printTestName =           printf "%s%s: %s" (indent level) name align-        hsep = putStrLn (replicate 40 '=')         printResultLine result forceTime = do           -- use an appropriate printing function           let@@ -321,28 +320,7 @@             RTFail -> infoFail) $               printf "%s%s\n" pref (formatDesc (level+1) rDesc) -          stat' <- case resultOutcome result of-            Failure (TestThrewException e) ->-              case fromException e of-                Just (Mismatch (GRNoGolden a shw _)) -> do-                  infoFail $ printf "%sActual value is:\n" pref-                  let a' = runIdentity a-                  shw' <- shw a'-                  hsep-                  printValue name shw'-                  hsep-                  return ( mempty { statFailures = 1 } )-                Just (Mismatch (GRDifferent _ _ diff _)) -> do-                  infoFail $ printf "%sDiff between actual and golden value:\n" pref-                  hsep-                  printDiff name diff-                  hsep-                  return ( mempty { statFailures = 1 } )-                Just (Mismatch _) -> error "Impossible case!"-                Just Disabled -> return ( mempty { statDisabled = 1 } )-                Nothing -> return ( mempty { statFailures = 1 } )-            Failure _ -> return ( mempty { statFailures = 1 } )-            Success -> return ( mempty { statSuccesses = 1 } )+          stat' <- printTestOutput pref name result            return stat' @@ -350,44 +328,54 @@           (result', stat') <- case (resultOutcome result) of             Failure (TestThrewException e) ->               case fromException e of-                Just (Mismatch (GRNoGolden a shw upd)) -> do+                Just (Mismatch (GRDifferent _ a diff Nothing)) -> do+                  printResultLine result False+                  s <- printTestOutput pref name result+                  return (testFailed "", s)+                Just (Mismatch (GRNoGolden a shw (Just upd))) -> do                   printf "Golden value missing. Press <enter> to show actual value.\n"                   _ <- getLine                   let a' = runIdentity a                   shw' <- shw a'                   showValue name shw'                   isUpd <- tryAccept pref name upd a'--                  return (-                      if isUpd-                      then ( testPassed "Created golden value."-                           , mempty { statCreatedGolden = 1 } )-                      else ( testFailed "Golden value missing."-                           , mempty { statFailures = 1 } )-                      )-                Just (Mismatch (GRDifferent _ a diff upd)) -> do+                  let r =+                        if isUpd+                        then ( testPassed "Created golden value."+                             , mempty { statCreatedGolden = 1 } )+                        else ( testFailed "Golden value missing."+                             , mempty { statFailures = 1 } )+                  printResultLine (fst r) False+                  return r+                Just (Mismatch (GRDifferent _ a diff (Just upd))) -> do                   printf "Golden value differs from actual value.\n"                   showDiff name diff                   isUpd <- tryAccept pref name upd a-                  return (-                      if isUpd-                      then ( testPassed "Updated golden value."-                           , mempty { statUpdatedGolden = 1 } )-                      else ( testFailed "Golden value does not match actual output."-                           , mempty { statFailures = 1 } )-                      )+                  let r =+                        if isUpd+                        then ( testPassed "Updated golden value."+                             , mempty { statUpdatedGolden = 1 } )+                        else ( testFailed "Golden value does not match actual output."+                             , mempty { statFailures = 1 } )+                  printResultLine (fst r) False+                  return r                 Just (Mismatch _) -> error "Impossible case!"-                Just Disabled -> return-                            ( result-                            , mempty { statDisabled = 1 } )-                Nothing -> return (result, mempty {statFailures = 1})-            Success -> return (result, mempty { statSuccesses = 1 })-            Failure _ -> return (result, mempty { statFailures = 1 })+                Just Disabled -> do+                  printResultLine result False+                  return ( result+                         , mempty { statDisabled = 1 } )+                Nothing -> do+                  printResultLine result False+                  return (result, mempty {statFailures = 1})+            Success -> do+              printResultLine result False+              return (result, mempty { statSuccesses = 1 })+            Failure _ -> do+              printResultLine result False+              return (result, mempty { statFailures = 1 })            let result'' = result' { resultTime = resultTime result } -          printResultLine result'' False-           rDesc <- formatMessage $ resultDescription result''           when (not $ null rDesc) $ (case getResultType result'' of             RTSuccess -> infoOk@@ -416,6 +404,33 @@           , foldGroup = handleGroup           }           opts tree++printTestOutput :: (?colors :: Bool) => String -> TestName -> Result -> IO Statistics+printTestOutput prefix name result = case resultOutcome result of+  Failure (TestThrewException e) ->+    case fromException e of+      Just (Mismatch (GRNoGolden a shw _)) -> do+        infoFail $ printf "%sActual value is:\n" prefix+        let a' = runIdentity a+        shw' <- shw a'+        hsep+        printValue name shw'+        hsep+        return ( mempty { statFailures = 1 } )+      Just (Mismatch (GRDifferent _ _ diff _)) -> do+        infoFail $ printf "%sDiff between actual and golden value:\n" prefix+        hsep+        printDiff name diff+        hsep+        return ( mempty { statFailures = 1 } )+      Just (Mismatch _) -> error "Impossible case!"+      Just Disabled -> return ( mempty { statDisabled = 1 } )+      Nothing -> return ( mempty { statFailures = 1 } )+  Failure _ -> return ( mempty { statFailures = 1 } )+  Success -> return ( mempty { statSuccesses = 1 } )++hsep :: IO ()+hsep = putStrLn (replicate 40 '=')  foldTestOutput   :: (?colors :: Bool, Monoid b)

@@ -27,7 +27,7 @@         (IO a)            -- Get actual value.         (a -> a -> IO GDiff)                       -- Compare/diff.         (a -> IO GShow)                            -- How to produce a show.-        (a -> IO ())                            -- Update golden value.+        (Maybe (a -> IO ()))                       -- Update golden value.   deriving Typeable  @@ -71,10 +71,10 @@     (r, gr) <- runGolden golden     let (AcceptTests accept) = lookupOption opts :: AcceptTests     case gr of-      GRNoGolden act _ upd | accept -> do+      GRNoGolden act _ (Just upd) | accept -> do             act >>= upd             return $ testPassed "Created golden file."-      GRDifferent _ act _ upd | accept -> do+      GRDifferent _ act _ (Just upd) | accept -> do             upd act             return $ testPassed "Updated golden file."       _ -> return r@@ -90,11 +90,11 @@         (a)     -- golden         (a)     -- actual         (GDiff) -- diff-        (a -> IO ()) -- update+        (Maybe (a -> IO ())) -- update   | forall a . GRNoGolden         (m a) -- compute actual (we don't want to compute it if it is not used)         (a -> IO GShow) --show-        (a -> IO ()) -- update+        (Maybe (a -> IO ())) -- update  runGolden :: Golden -> IO (Result, GoldenResult) runGolden (Golden getGolden getActual cmp shw upd) = do

@@ -1,5 +1,5 @@ name:                tasty-silver-version:             3.1.7+version:             3.1.8 synopsis:            A fancy test runner, including support for golden tests. description:   This package provides a fancy test runner and support for «golden testing».