tasty-golden 2.2.2.4 → 2.3

raw patch · 6 files changed

+117/−142 lines, 6 filesdep ~bytestringPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: bytestring

API changes (from Hackage documentation)

Files

• CHANGELOG.md +22/−0
• Test/Tasty/Golden.hs +17/−18
• Test/Tasty/Golden/Advanced.hs +12/−8
• Test/Tasty/Golden/Internal.hs +53/−44
• Test/Tasty/Golden/Manage.hs +12/−71
• tasty-golden.cabal +1/−1

@@ -1,6 +1,28 @@ Changes ======= +Version 2.3+-----------++* Accepting tests is no longer done by a separate ingredient; instead it is now+  an option that affects tests themselves.+    * `--accept` used to run only golden tests; now all tests are run, but only+      golden tests are affected by this option+    * when accepting, all the usual options apply (such as `-j`)+    * when accepting, the interace is the same as when running+    * `defaultMain` and `acceptingTests` are kept for compatibility, but do not+      do anything and are obsolete+* When a golden test file does not exist, it is created automatically, even when+  `--accept` is not specified. You'll see a message like++        UnboxedTuples:                 OK (0.04s)+          Golden file did not exist; created++* No longer use lazy IO+    * `ValueGetter` type is gone (replaced by `IO`)+    * Because of that, the type of the primitive `goldenTest` is changed+    * `vgReadFile` function is gone (replaced by `Data.ByteString.readFile`)+ Version 2.2.2.4 --------------- 

@@ -55,7 +55,8 @@ import Test.Tasty.Providers import Test.Tasty.Golden.Advanced import Text.Printf-import qualified Data.ByteString.Lazy as LB+import qualified Data.ByteString as BS+import qualified Data.ByteString.Lazy as LBS import System.IO import System.IO.Temp import System.Process@@ -64,12 +65,10 @@ import System.Directory import Control.Exception import Control.Monad+import Control.Applicative import Control.DeepSeq import qualified Data.Set as Set --- trick to avoid an explicit dependency on transformers-import Control.Monad.Error (liftIO)- -- | Compare a given file contents against the golden file contents goldenVsFile   :: TestName -- ^ test name@@ -80,32 +79,32 @@ goldenVsFile name ref new act =   goldenTest     name-    (vgReadFile ref)-    (liftIO act >> vgReadFile new)+    (BS.readFile ref)+    (act >> BS.readFile new)     cmp     upd   where   cmp = simpleCmp $ printf "Files '%s' and '%s' differ" ref new-  upd = LB.writeFile ref+  upd = BS.writeFile ref  -- | Compare a given string against the golden file contents goldenVsString   :: TestName -- ^ test name   -> FilePath -- ^ path to the «golden» file (the file that contains correct output)-  -> IO LB.ByteString -- ^ action that returns a string+  -> IO LBS.ByteString -- ^ action that returns a string   -> TestTree -- ^ the test verifies that the returned string is the same as the golden file contents goldenVsString name ref act =   goldenTest     name-    (vgReadFile ref)-    (liftIO act)+    (BS.readFile ref)+    (LBS.toStrict <$> act)     cmp     upd   where   cmp x y = simpleCmp msg x y     where     msg = printf "Test output was different from '%s'. It was: %s" ref (show y)-  upd = LB.writeFile ref+  upd = BS.writeFile ref  simpleCmp :: Eq a => String -> a -> a -> IO (Maybe String) simpleCmp e x y =@@ -129,7 +128,7 @@   goldenTest     name     (return ())-    (liftIO act)+    act     cmp     upd   where@@ -146,7 +145,7 @@       ExitSuccess -> Nothing       _ -> Just out -  upd _ = LB.readFile new >>= LB.writeFile ref+  upd _ = BS.readFile new >>= BS.writeFile ref  -- | Same as 'goldenVsString', but invokes an external diff command. goldenVsStringDiff@@ -159,13 +158,13 @@     --     -- >\ref new -> ["diff", "-u", ref, new]   -> FilePath -- ^ path to the golden file-  -> IO LB.ByteString -- ^ action that returns a string+  -> IO LBS.ByteString -- ^ action that returns a string   -> TestTree goldenVsStringDiff name cmdf ref act =   goldenTest     name-    (vgReadFile ref)-    (liftIO act)+    (BS.readFile ref)+    (LBS.toStrict <$> act)     cmp     upd   where@@ -173,7 +172,7 @@   cmp _ actBS = withSystemTempFile template $ \tmpFile tmpHandle -> do      -- Write act output to temporary ("new") file-    LB.hPut tmpHandle actBS >> hFlush tmpHandle+    BS.hPut tmpHandle actBS >> hFlush tmpHandle      let cmd = cmdf ref tmpFile @@ -189,7 +188,7 @@       ExitSuccess -> Nothing       _ -> Just (printf "Test output was different from '%s'. Output of %s:\n%s" ref (show cmd) out) -  upd = LB.writeFile ref+  upd = BS.writeFile ref  -- | Like 'writeFile', but uses binary mode writeBinaryFile :: FilePath -> String -> IO ()

@@ -1,11 +1,7 @@ {-# LANGUAGE RankNTypes #-} module Test.Tasty.Golden.Advanced   ( -- * The main function-    goldenTest,--    -- * ValueGetter monad-    ValueGetter(..),-    vgReadFile+    goldenTest   ) where @@ -15,8 +11,15 @@ -- | A very general testing function. goldenTest   :: TestName -- ^ test name-  -> (forall r . ValueGetter r a) -- ^ get the golden correct value-  -> (forall r . ValueGetter r a) -- ^ get the tested value+  -> (IO a)+    -- ^ get the golden correct value+    --+    -- Note that this action may be followed by the update function call.+    --+    -- Therefore, this action *should avoid* reading the file lazily;+    -- otherwise, the file may remain half-open and the update action will+    -- fail.+  -> (IO a) -- ^ get the tested value   -> (a -> a -> IO (Maybe String))     -- ^ comparison function.     --@@ -26,6 +29,7 @@     --     -- The function may use 'IO', for example, to launch an external @diff@     -- command.-  -> (a -> IO ()) -- ^ update the golden file+  -> (a -> IO ())+    -- ^ update the golden file   -> TestTree goldenTest t golden test cmp upd = singleTest t $ Golden golden test cmp upd

@@ -2,65 +2,74 @@     MultiParamTypeClasses, GeneralizedNewtypeDeriving #-} module Test.Tasty.Golden.Internal where -import Control.Applicative-import Control.Monad.Cont import Control.DeepSeq import Control.Exception import Data.Typeable (Typeable)-import Data.ByteString.Lazy as LB-import System.IO+import Options.Applicative+import Data.Tagged+import Data.Proxy+import System.IO.Error (isDoesNotExistError) import Test.Tasty.Providers+import Test.Tasty.Options  -- | See 'goldenTest' for explanation of the fields data Golden =   forall a .     Golden-      (forall r . ValueGetter r a)-      (forall r . ValueGetter r a)+      (IO a)+      (IO a)       (a -> a -> IO (Maybe String))       (a -> IO ())   deriving Typeable --- | An action that yields a value (either golden or tested).------ CPS allows closing the file handle when using lazy IO to read data.-newtype ValueGetter r a = ValueGetter-  { runValueGetter :: ContT r IO a }-  deriving (Functor, Applicative, Monad, MonadCont, MonadIO)---- | Lazily read a file. The file handle will be closed after the--- 'ValueGetter' action is run.-vgReadFile :: FilePath -> ValueGetter r ByteString-vgReadFile path =-  (liftIO . LB.hGetContents =<<) $-  ValueGetter $-  ContT $ \k ->-  bracket-    (openBinaryFile path ReadMode)-    hClose-    k---- | Ensures that the result is fully evaluated (so that lazy file handles--- can be closed)-vgRun :: ValueGetter r r -> IO r-vgRun (ValueGetter a) = runContT a evaluate+-- | This option, when set to 'True', specifies that we should run in the+-- «accept tests» mode+newtype AcceptTests = AcceptTests Bool+  deriving (Eq, Ord, Typeable)+instance IsOption AcceptTests where+  defaultValue = AcceptTests False+  parseValue = fmap AcceptTests . safeRead+  optionName = return "accept"+  optionHelp = return "Accept current results of golden tests"+  optionCLParser =+    fmap AcceptTests $+    switch+      (  long (untag (optionName :: Tagged AcceptTests String))+      <> help (untag (optionHelp :: Tagged AcceptTests String))+      )  instance IsTest Golden where-  run _ golden _ = runGolden golden-  testOptions = return []+  run opts golden _ = runGolden golden (lookupOption opts)+  testOptions = return [Option (Proxy :: Proxy AcceptTests)] -runGolden :: Golden -> IO Result-runGolden (Golden getGolden getTested cmp _) = do-  vgRun $ do+runGolden :: Golden -> AcceptTests -> IO Result+runGolden (Golden getGolden getTested cmp update) (AcceptTests accept) = do+  do     new <- getTested-    ref <- getGolden-    result <- liftIO $ cmp ref new+    mbRef <- try getGolden -    case result of-      Just reason -> do-        -- Make sure that the result is fully evaluated and doesn't depend-        -- on yet un-read lazy input-        liftIO $ evaluate . rnf $ reason-        return $ testFailed reason-      Nothing ->-        return $ testPassed ""+    case mbRef of+      Left e | isDoesNotExistError e -> do+        update new+        return $ testPassed "Golden file did not exist; created"++        | otherwise -> throwIO e++      Right ref -> do++        result <- cmp ref new++        case result of+          Just _reason | accept -> do+            -- test failed; accept the new version+            update new+            return $ testPassed "Accepted the new version"++          Just reason -> do+            -- Make sure that the result is fully evaluated and doesn't depend+            -- on yet un-read lazy input+            evaluate . rnf $ reason+            return $ testFailed reason++          Nothing ->+            return $ testPassed ""

@@ -1,5 +1,11 @@ {-# LANGUAGE GeneralizedNewtypeDeriving, PatternGuards, DeriveDataTypeable #-}--- | Golden test management+-- | Previously, accepting tests (by the @--accept@ flag) was done by this+-- module, and there was an ingredient to handle that mode.+--+-- Now it's done as part of a normal test run. When the `--accept` flag is+-- given, it makes golden tests to update the files whenever there is+-- a mismatch. So you no longer need this module. It remains only for+-- backwards compatibility. module Test.Tasty.Golden.Manage   (   -- * Command line helpers@@ -8,84 +14,19 @@   -- * The ingredient   , acceptingTests   , AcceptTests(..)--  -- * Programmatic API-  , acceptGoldenTests   )   where  import Test.Tasty hiding (defaultMain) import Test.Tasty.Runners-import Test.Tasty.Options import Test.Tasty.Golden.Internal-import Data.Typeable-import Data.Tagged-import Data.Proxy-import Data.Maybe-import Control.Monad.Cont-import Control.Monad.State-import Control.Exception-import Control.Concurrent.Async-import Text.Printf-import Options.Applicative --- | Like @defaultMain@ from the main tasty package, but also includes the--- golden test management capabilities.+-- | This exists only for backwards compatibility. Use+-- 'Test.Tasty.defaultMain' instead. defaultMain :: TestTree -> IO () defaultMain = defaultMainWithIngredients [acceptingTests, listingTests, consoleTestReporter] --- | This option, when set to 'True', specifies that we should run in the--- «accept tests» mode-newtype AcceptTests = AcceptTests Bool-  deriving (Eq, Ord, Typeable)-instance IsOption AcceptTests where-  defaultValue = AcceptTests False-  parseValue = fmap AcceptTests . safeRead-  optionName = return "accept"-  optionHelp = return "Accept current results of golden tests"-  optionCLParser =-    fmap AcceptTests $-    switch-      (  long (untag (optionName :: Tagged AcceptTests String))-      <> help (untag (optionHelp :: Tagged AcceptTests String))-      )-+-- | This exists only for backwards compatibility. You don't need to+-- include this anymore. acceptingTests :: Ingredient-acceptingTests = TestManager [Option (Proxy :: Proxy AcceptTests)] $-  \opts tree ->-    case lookupOption opts of-      AcceptTests False -> Nothing-      AcceptTests True -> Just $-        acceptGoldenTests opts tree---- | Get the list of all golden tests in a given test tree-getGoldenTests :: OptionSet -> TestTree -> [(TestName, Golden)]-getGoldenTests =-  foldTestTree-    trivialFold { foldSingle = \_ name t -> fmap ((,) name) $ maybeToList $ cast t }---- | «Accept» a golden test, i.e. reset the golden value to the currently--- produced value-acceptGoldenTest :: Golden -> IO ()-acceptGoldenTest (Golden _ getTested _ update) =-  vgRun $ liftIO . update =<< getTested---- | Accept all golden tests in the test tree-acceptGoldenTests :: OptionSet -> TestTree -> IO Bool-acceptGoldenTests opts tests = do-  let gs = getGoldenTests opts tests-  numExns <- flip execStateT (0 :: Int) $ forM_ gs $ \(n,g) -> do-    mbExn <- liftIO $ withAsync (acceptGoldenTest g) waitCatch-    case mbExn of-      Right {} -> liftIO $ printf "Accepted %s\n" n-      Left e -> do-        liftIO $ printf "Error when trying to accept %s: %s\n" n (show (e :: SomeException))-        ne <- get-        put $! ne+1--  -- warn when there were problems-  when (numExns > 0) $-    printf "NOTE: %d tests threw exceptions!\n" numExns--  -- is everything ok?-  return (numExns == 0)+acceptingTests = TestManager [] $ \_ _ -> Nothing

@@ -1,5 +1,5 @@ name:                tasty-golden-version:             2.2.2.4+version:             2.3 synopsis:            Golden tests support for tasty description:   This package provides support for «golden testing».