packages feed

tasty-golden (empty) → 2.0

raw patch · 7 files changed

+351/−0 lines, 7 filesdep +basedep +bytestringdep +mtlsetup-changed

Dependencies added: base, bytestring, mtl, optparse-applicative, process, tasty

Files

+ LICENSE view
@@ -0,0 +1,19 @@+Copyright (c) 2012 Roman Cheplyaka++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in+all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN+THE SOFTWARE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ Test/Tasty/Golden.hs view
@@ -0,0 +1,100 @@+{- |+This module provides a simplified interface. If you want more, see+"Test.Tasty.Golden.Advanced".+-}+module Test.Tasty.Golden+  ( goldenVsFile+  , goldenVsString+  , goldenVsFileDiff+  )+  where++import Test.Tasty.Providers+import Test.Tasty.Golden.Advanced+import Text.Printf+import qualified Data.ByteString.Lazy as LB+import System.IO+import System.Process+import System.Exit+import Control.Exception++-- 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+  -> FilePath -- ^ path to the «golden» file (the file that contains correct output)+  -> FilePath -- ^ path to the output file+  -> IO () -- ^ action that creates the output file+  -> TestTree -- ^ the test verifies that the output file contents is the same as the golden file contents+goldenVsFile name ref new act =+  goldenTest+    name+    (vgReadFile ref)+    (liftIO act >> vgReadFile new)+    cmp+    upd+  where+  cmp = simpleCmp $ printf "Files '%s' and '%s' differ" ref new+  upd = LB.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+  -> 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)+    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++simpleCmp :: Eq a => String -> a -> a -> IO (Maybe String)+simpleCmp e x y =+  return $ if x == y then Nothing else Just e++-- | Same as 'goldenVsFile', but invokes an external diff command.+goldenVsFileDiff+  :: TestName -- ^ test name+  -> (FilePath -> FilePath -> [String])+    -- ^ function that constructs the command line to invoke the diff+    -- command.+    --+    -- E.g.+    --+    -- >\ref new -> ["diff", "-u", ref, new]+  -> FilePath -- ^ path to the golden file+  -> FilePath -- ^ path to the output file+  -> IO ()    -- ^ action that produces the output file+  -> TestTree+goldenVsFileDiff name cmdf ref new act =+  goldenTest+    name+    (return ())+    (liftIO act)+    cmp+    upd+  where+  cmd = cmdf ref new+  cmp _ _ | null cmd = error "goldenVsFileDiff: empty command line"+  cmp _ _ = do+    (_, Just sout, _, pid) <- createProcess (proc (head cmd) (tail cmd)) { std_out = CreatePipe }+    -- strictly read the whole output, so that the process can terminate+    out <- hGetContents sout+    evaluate $ length out++    r <- waitForProcess pid+    return $ case r of+      ExitSuccess -> Nothing+      _ -> Just out++  upd _ = LB.readFile new >>= LB.writeFile ref
+ Test/Tasty/Golden/Advanced.hs view
@@ -0,0 +1,31 @@+{-# LANGUAGE RankNTypes #-}+module Test.Tasty.Golden.Advanced+  ( -- * The main function+    goldenTest,++    -- * ValueGetter monad+    ValueGetter(..),+    vgReadFile+  )+where++import Test.Tasty.Providers+import Test.Tasty.Golden.Internal++-- | 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+  -> (a -> a -> IO (Maybe String))+    -- ^ comparison function.+    --+    -- If two values are the same, it should return 'Nothing'. If they are+    -- different, it should return an error that will be printed to the user.+    -- First argument is the golden value.+    --+    -- The function may use 'IO', for example, to launch an external @diff@+    -- command.+  -> (a -> IO ()) -- ^ update the golden file+  -> TestTree+goldenTest t golden test cmp upd = singleTest t $ Golden golden test cmp upd
+ Test/Tasty/Golden/Internal.hs view
@@ -0,0 +1,64 @@+{-# LANGUAGE RankNTypes, ExistentialQuantification, DeriveDataTypeable,+    MultiParamTypeClasses, GeneralizedNewtypeDeriving #-}+module Test.Tasty.Golden.Internal where++import Data.Typeable (Typeable)+import Control.Applicative+import Control.Monad.Cont+import Test.Tasty.Providers+import Data.ByteString.Lazy as LB+import Control.Exception+import System.IO+import Data.Maybe++-- | See 'goldenTest' for explanation of the fields+data Golden =+  forall a .+    Golden+      (forall r . ValueGetter r a)+      (forall r . ValueGetter r 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++instance IsTest Golden where+  run opts golden _ = runGolden golden+  testOptions = return []++runGolden :: Golden -> IO Result+runGolden (Golden getGolden getTested cmp _) = do+  result <- vgRun $ do+    new <- getTested+    ref <- getGolden+    liftIO $ cmp ref new++  return $+    case result of+      Just reason ->+        Result False reason+      Nothing ->+        Result True ""
+ Test/Tasty/Golden/Manage.hs view
@@ -0,0 +1,97 @@+{-# LANGUAGE GeneralizedNewtypeDeriving, PatternGuards, DeriveDataTypeable #-}+-- | Golden test management+module Test.Tasty.Golden.Manage+  (+  -- * Command line helpers+    defaultMain+  , defaultMainWithRunner+  , goldenManagerParser++  -- * Programmatic API+  , acceptGoldenTests+  )+  where++import Test.Tasty hiding (defaultMainWithRunner, defaultMain)+import Test.Tasty.Runners hiding (defaultMainWithRunner)+import Test.Tasty.Options+import Test.Tasty.Golden.Internal+import Data.Maybe+import Data.Typeable+import Control.Monad.Cont+import Text.Printf+import Options.Applicative++-- | Parse possible management commands. Fail (as a parser) if no+-- management commands are given.+goldenManagerParser :: Parser (OptionSet -> TestTree -> IO ())+goldenManagerParser =+  flag'+    acceptGoldenTests+    (  long "accept"+    <> help "Accept current results of golden tests"+    )++-- | Parse the command line arguments and run the tests using the provided+-- runner.+--+-- If any golden test management commands are specified, execute them+-- instead.+--+-- Note: this is a replacement for "Test.Tasty"'s 'defaultMainWithRunner'+-- and has a name conflict with it. You'll need to use @hiding@ or+-- a similar means to resolve this.+defaultMainWithRunner :: Runner -> TestTree -> IO ()+defaultMainWithRunner runner testTree = do+  let+    runTests opts =+      runner opts testTree =<< launchTestTree opts testTree++    optsParser = treeOptionParser testTree++    -- partially apply goldenManagerParser to testTree+    mgmntParser :: Parser (OptionSet -> IO ())+    mgmntParser =+      (\mgr opts -> mgr opts testTree) <$> goldenManagerParser++    parser =+      (mgmntParser <|> pure runTests) <*> optsParser++  join $ execParser $+    info (helper <*> parser)+    ( fullDesc <>+      header "Mmm... tasty test suite (with golden test management capabilities)"+    )++-- | Parse the command line arguments and run the tests using the standard+-- console runner.+--+-- If any golden test management commands are specified, execute them+-- instead.+--+-- Note: this is a replacement for "Test.Tasty"'s 'defaultMain'+-- and has a name conflict with it. You'll need to use @hiding@ or+-- a similar means to resolve this.+defaultMain :: TestTree -> IO ()+defaultMain = defaultMainWithRunner runUI++-- | Get the list of all golden tests in a given test tree+getGoldenTests :: OptionSet -> TestTree -> [(TestName, Golden)]+getGoldenTests =+  foldTestTree+    (\_ name t -> fmap ((,) name) $ maybeToList $ cast t)+    (const id)++-- | «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 ()+acceptGoldenTests opts tests = do+  let gs = getGoldenTests opts tests+  forM_ gs $ \(n,g) -> do+    acceptGoldenTest g+    printf "Accepted %s\n" n
+ tasty-golden.cabal view
@@ -0,0 +1,38 @@+name:                tasty-golden+version:             2.0+synopsis:            Golden tests support for tasty+description:+  This package provides support for «golden testing».++  A golden test is an IO action that writes its result to a file.+  To pass the test, this output file should be identical to the corresponding+  «golden» file, which contains the correct result for the test.++license:             MIT+license-file:        LICENSE+Homepage:            https://github.com/feuerbach/tasty-golden+Bug-reports:         https://github.com/feuerbach/tasty-golden/issues+author:              Roman Cheplyaka+maintainer:          Roman Cheplyaka <roma@ro-che.info>+-- copyright:           +category:            Testing+build-type:          Simple+cabal-version:       >=1.8++Source-repository head+  type:     git+  location: git://github.com/feuerbach/tasty-golden.git++library+  exposed-modules:     Test.Tasty.Golden+                       Test.Tasty.Golden.Advanced+                       Test.Tasty.Golden.Manage+  other-modules:+                       Test.Tasty.Golden.Internal+  build-depends:+    base ==4.*,+    tasty,+    bytestring,+    process,+    mtl,+    optparse-applicative