packages feed

tasty 0.6 → 0.7

raw patch · 8 files changed

+104/−72 lines, 8 filesdep +regex-tdfadep −regex-posix

Dependencies added: regex-tdfa

Dependencies removed: regex-posix

Files

Test/Tasty.hs view
@@ -23,9 +23,6 @@   -- a file or a socket. We want to create or grab the resource before   -- the tests are run, and destroy or release afterwards.   , withResource--  -- ** Accessing the resource-  -- $example   )   where @@ -53,44 +50,18 @@ localOption :: IsOption v => v -> TestTree -> TestTree localOption v = PlusTestOptions (setOption v) +-- | Customize the test tree based on the run-time options askOption :: IsOption v => (v -> TestTree) -> TestTree askOption f = AskOptions $ f . lookupOption --- | Add resource initialization and finalization to the test tree+-- | Acquire the resource to run this test (sub)tree and release it+-- afterwards withResource   :: IO a -- ^ initialize the resource   -> (a -> IO ()) -- ^ free the resource-  -> TestTree+  -> (IO a -> TestTree)+    -- ^ @'IO' a@ is an action which returns the acquired resource.+    -- Despite it being an 'IO' action, the resource it returns will be+    -- acquired only once and shared across all the tests in the tree.   -> TestTree withResource acq rel = WithResource (ResourceSpec acq rel)---- $example------ If you need to access the resource in your tests, just put it in an--- IORef during initialization, and get it from there in the tests.------ Here's an example:------ >import Test.Tasty--- >import Test.Tasty.HUnit--- >import Data.IORef--- >--- >-- assumed defintions--- >data Foo--- >acquire :: IO Foo--- >release :: Foo -> IO ()--- >testWithFoo :: Foo -> Assertion--- >--- >main = do--- >  ref <- newIORef $--- >    -- If you get this error, then either you forgot to actually write to--- >    -- the IORef, or it's a bug in tasty--- >    error "Resource isn't accessible"--- >  defaultMain $--- >    withResource (do r <- acquire; writeIORef ref r; return r) release (tests ref)--- >--- >tests :: IORef Foo -> TestTree--- >tests ref =--- >  testGroup "Tests"--- >    [ testCase "x" $ readIORef ref >>= testWithFoo--- >    ]
Test/Tasty/Core.hs view
@@ -1,9 +1,10 @@ -- | Core types and definitions {-# LANGUAGE GeneralizedNewtypeDeriving, FlexibleContexts,-             ExistentialQuantification, RankNTypes #-}+             ExistentialQuantification, RankNTypes, DeriveDataTypeable #-} module Test.Tasty.Core where  import Control.Applicative+import Control.Exception import Test.Tasty.Options import Test.Tasty.Patterns import Data.Foldable@@ -11,6 +12,7 @@ import Data.Typeable import qualified Data.Map as Map import Data.Tagged+import Text.Printf  -- | A test result data Result = Result@@ -62,11 +64,22 @@  -- | 'ResourceSpec' describes how to acquire a resource (the first field) -- and how to release it (the second field).-data ResourceSpec =-  forall a . ResourceSpec-    (IO a)-    (a -> IO ())+data ResourceSpec a = ResourceSpec (IO a) (a -> IO ()) +data ResourceError+  = NotRunningTests+  | UnexpectedState String+  deriving Typeable++instance Show ResourceError where+  show NotRunningTests =+    "Unhandled resource. Probably a bug in the runner you're using."+  show (UnexpectedState state) =+    printf "Unexpected state of the resource (%s). Report as a tasty bug."+      state++instance Exception ResourceError+ -- | The main data structure defining a test suite. -- -- It consists of individual test cases and properties, organized in named@@ -84,15 +97,52 @@     -- ^ Assemble a number of tests into a cohesive group   | PlusTestOptions (OptionSet -> OptionSet) TestTree     -- ^ Add some options to child tests-  | WithResource ResourceSpec TestTree+  | forall a . WithResource (ResourceSpec a) (IO a -> TestTree)+    -- ^ Acquire the resource before the tests in the inner tree start and+    -- release it after they finish. The tree gets an `IO` action which+    -- yields the resource, although the resource is shared across all the+    -- tests.   | AskOptions (OptionSet -> TestTree)+    -- ^ Ask for the options and customize the tests based on them  -- | Create a named group of test cases or other groups testGroup :: TestName -> [TestTree] -> TestTree testGroup = TestGroup +-- | An algebra for folding a `TestTree`.+--+-- Instead of constructing fresh records, build upon `trivialFold`+-- instead. This way your code won't break when new nodes/fields are+-- indroduced.+data TreeFold b = TreeFold+  { foldSingle :: forall t . IsTest t => OptionSet -> TestName -> t -> b+  , foldGroup :: TestName -> b -> b+  , foldResource :: forall a . ResourceSpec a -> (IO a -> b) -> b+  }++-- | 'trivialFold' can serve as the basis for custom folds. Just override+-- the fields you need.+--+-- Here's what it does:+--+-- * single tests are mapped to `mempty` (you probably do want to override that)+--+-- * test groups are returned unmodified+--+-- * for a resource, an IO action that throws an exception is passed (you+-- want to override this for runners/ingredients that execute tests)+trivialFold :: Monoid b => TreeFold b+trivialFold = TreeFold+  { foldSingle = \_ _ _ -> mempty+  , foldGroup = const id+  , foldResource = \_ f -> f $ throwIO NotRunningTests+  }+ -- | Fold a test tree into a single value. --+-- The fold result type should be a monoid. This is used to fold multiple+-- results in a test group. In particular, empty groups get folded into 'mempty'.+-- -- Apart from pure convenience, this function also does the following -- useful things: --@@ -108,16 +158,14 @@ -- in practice; OTOH, this behaviour may be changed later. foldTestTree   :: Monoid b-  => (forall t . IsTest t => OptionSet -> TestName -> t -> b)-     -- ^ interpret a single test-  -> (TestName -> b -> b)-     -- ^ interpret a test group-  -> (ResourceSpec -> b -> b)-     -- ^ deal with the resource+  => TreeFold b+     -- ^ the algebra (i.e. how to fold a tree)   -> OptionSet      -- ^ initial options-  -> TestTree -> b-foldTestTree fTest fGroup fResource opts tree =+  -> TestTree+     -- ^ the tree to fold+  -> b+foldTestTree (TreeFold fTest fGroup fResource) opts tree =   let pat = lookupOption opts   in go pat [] opts tree   where@@ -130,7 +178,7 @@         TestGroup name trees ->           fGroup name $ foldMap (go pat (path ++ [name]) opts) trees         PlusTestOptions f tree -> go pat path (f opts) tree-        WithResource res tree -> fResource res (go pat path opts tree)+        WithResource res tree -> fResource res $ \res -> go pat path opts (tree res)         AskOptions f -> go pat path opts (f opts)  -- | Useful wrapper for use with foldTestTree@@ -147,9 +195,7 @@   Map.elems .    foldTestTree-    (\_ _ -> getTestOptions)-    (const id)-    (const id)+    trivialFold { foldSingle = \_ _ -> getTestOptions }     mempty    where
Test/Tasty/Ingredients/ConsoleReporter.hs view
@@ -78,9 +78,10 @@ computeAlignment opts =   fromMonoid .   foldTestTree-    (\_ name _ level -> Maximum (length name + level))-    (\_ m -> m . (+ indentSize))-    (const id)+    trivialFold+      { foldSingle = \_ name _ level -> Maximum (length name + level)+      , foldGroup = \_ m -> m . (+ indentSize)+      }     opts   where     fromMonoid m =@@ -159,9 +160,10 @@   st <-     flip execStateT initialState $ getApp $ fst $       foldTestTree-        (runSingleTest smap)-        runGroup-        (const id)+        trivialFold+          { foldSingle = runSingleTest smap+          , foldGroup = runGroup+          }         opts         tree
Test/Tasty/Ingredients/ListTests.hs view
@@ -35,9 +35,10 @@ testsNames :: OptionSet -> TestTree -> [TestName] testsNames {- opts -} {- tree -} =   foldTestTree-    (\_opts name _test -> [name])-    (\groupName names -> map ((groupName ++ "/") ++) names)-    (const id)+    trivialFold+      { foldSingle = \_opts name _test -> [name]+      , foldGroup = \groupName names -> map ((groupName ++ "/") ++) names+      }  -- | The ingredient that provides the test listing functionality listingTests :: Ingredient
Test/Tasty/Patterns.hs view
@@ -39,8 +39,8 @@  import Test.Tasty.Options -import Text.Regex.Posix.Wrap-import Text.Regex.Posix.String()+import Text.Regex.TDFA+import Text.Regex.TDFA.String()  import Data.List import Data.Typeable
Test/Tasty/Run.hs view
@@ -138,9 +138,10 @@   liftM (map (first ($ (Seq.empty, Seq.empty)))) $   execWriterT $ getApp $   (foldTestTree-    runSingleTest-    (const id)-    addInitAndRelease+    trivialFold+      { foldSingle = runSingleTest+      , foldResource = addInitAndRelease+      }     opts     tree     :: AppMonoid (WriterT [(InitFinPair -> IO (), TVar Status)] IO))@@ -153,14 +154,23 @@       tell [(act, statusVar)]     addInitAndRelease (ResourceSpec doInit doRelease) a =       AppMonoid . WriterT . fmap ((,) ()) $ do-        tests <- execWriterT $ getApp a-        let ntests = length tests         initVar <- newMVar NotCreated+        tests <- execWriterT $ getApp $ a (getResource initVar)+        let ntests = length tests         finishVar <- newMVar ntests         let           ini = Initializer doInit initVar           fin = Finalizer doRelease initVar finishVar         return $ map (first $ local $ (Seq.|> ini) *** (fin Seq.<|)) tests++-- | Used to create the IO action which is passed in a WithResource node+getResource :: MVar (Resource r) -> IO r+getResource var =+  readMVar var >>= \rState ->+    case rState of+      Created r -> return r+      NotCreated -> throwIO $ UnexpectedState "not created"+      FailedToCreate {} -> throwIO $ UnexpectedState "failed to create"  -- | Start running all the tests in a test tree in parallel. The number of -- threads is determined by the 'NumThreads' option.
Test/Tasty/Runners.hs view
@@ -4,6 +4,8 @@     -- * Working with the test tree     TestTree(..)   , foldTestTree+  , TreeFold(..)+  , trivialFold   , AppMonoid(..)   , ResourceSpec(..)     -- * Ingredients
tasty.cabal view
@@ -2,7 +2,7 @@ --  see http://haskell.org/cabal/users-guide/  name:                tasty-version:             0.6+version:             0.7 synopsis:            Modern and extensible testing framework description:         See <http://documentup.com/feuerbach/tasty> license:             MIT@@ -46,7 +46,7 @@     containers,     mtl,     tagged >= 0.5,-    regex-posix,+    regex-tdfa >= 1.1.8,     optparse-applicative >= 0.6,     deepseq >= 1.3,     either >= 4.0