tasty 0.4.2 → 0.5

raw patch · 6 files changed

+105/−32 lines, 6 files

Files

• Test/Tasty.hs +47/−0
• Test/Tasty/Core.hs +11/−1
• Test/Tasty/Ingredients/ConsoleReporter.hs +2/−0
• Test/Tasty/Ingredients/ListTests.hs +1/−0
• Test/Tasty/Run.hs +43/−30
• tasty.cabal +1/−1

@@ -16,6 +16,14 @@   -- using the functions below.   , adjustOption   , localOption+  -- * Resources+  -- | Sometimes several tests need to access the same resource — say,+  -- 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 @@ -41,3 +49,42 @@ -- | Locally set the option value for the given test subtree localOption :: IsOption v => v -> TestTree -> TestTree localOption v = PlusTestOptions (setOption v)++-- | Add resource initialization and finalization to the test tree+withResource+  :: IO a -- ^ initialize the resource+  -> (a -> IO ()) -- ^ free the resource+  -> TestTree+  -> 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+-- >    ]

@@ -60,6 +60,11 @@ -- | The name of a test or a group of tests type TestName = String +data ResourceSpec =+  forall a . ResourceSpec+    (IO a) -- create/initialize the resource+    (a -> IO ()) -- free the resource+ -- | The main data structure defining a test suite. -- -- It consists of individual test cases and properties, organized in named@@ -77,6 +82,7 @@     -- ^ Assemble a number of tests into a cohesive group   | PlusTestOptions (OptionSet -> OptionSet) TestTree     -- ^ Add some options to child tests+  | WithResource ResourceSpec TestTree  -- | Create a named group of test cases or other groups testGroup :: TestName -> [TestTree] -> TestTree@@ -103,10 +109,12 @@      -- ^ interpret a single test   -> (TestName -> b -> b)      -- ^ interpret a test group+  -> (ResourceSpec -> b -> b)+     -- ^ deal with the resource   -> OptionSet      -- ^ initial options   -> TestTree -> b-foldTestTree fTest fGroup opts tree =+foldTestTree fTest fGroup fResource opts tree =   let pat = lookupOption opts   in go pat [] opts tree   where@@ -119,6 +127,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)  -- | Useful wrapper for use with foldTestTree newtype AppMonoid f = AppMonoid { getApp :: f () }@@ -135,6 +144,7 @@    foldTestTree     (\_ _ -> getTestOptions)+    (const id)     (const id)     mempty 

@@ -80,6 +80,7 @@   foldTestTree     (\_ name _ level -> Maximum (length name + level))     (\_ m -> m . (+ indentSize))+    (const id)     opts   where     fromMonoid m =@@ -160,6 +161,7 @@       foldTestTree         (runSingleTest smap)         runGroup+        (const id)         opts         tree 

@@ -37,6 +37,7 @@   foldTestTree     (\_opts name _test -> [name])     (\groupName names -> map ((groupName ++ "/") ++) names)+    (const id)  -- | The ingredient that provides the test listing functionality listingTests :: Ingredient

@@ -7,8 +7,12 @@  import qualified Data.IntMap as IntMap import Control.Monad.State+import Control.Monad.Writer+import Control.Concurrent import Control.Concurrent.STM import Control.Exception+import Control.Applicative+import Control.Arrow  import Test.Tasty.Core import Test.Tasty.Parallel@@ -26,17 +30,6 @@   | Done Result     -- ^ test finished with a given result -data TestMap = TestMap-    !Int-    !(IntMap.IntMap (IO (), TVar Status))-      -- ^ Int is the first free index-      ---      -- IntMap maps test indices to:-      ---      --    * the action to launch the test-      ---      --    * the status variable of the launched test- -- | Mapping from test numbers (starting from 0) to their status variables. -- -- This is what an ingredient uses to analyse and display progress, and to@@ -44,20 +37,26 @@ type StatusMap = IntMap.IntMap (TVar Status)  -- | Start executing a test+--+-- Note: we take the finalizer as an argument because it's important that+-- it's run *before* we write the status var and signal to other threads+-- that we're finished executeTest   :: ((Progress -> IO ()) -> IO Result)     -- ^ the action to execute the test, which takes a progress callback as     -- a parameter   -> TVar Status -- ^ variable to write status to+  -> IO () -- ^ finalizer   -> IO ()-executeTest action statusVar = do+executeTest action statusVar fin = do   result <- handleExceptions $     -- pass our callback (which updates the status variable) to the test     -- action     action yieldProgress -  -- when the test is finished, write its result to the status variable-  atomically $ writeTVar statusVar result+  fin `finally`+    -- when the test is finished, write its result to the status variable+    (atomically $ writeTVar statusVar result)    where     -- the callback@@ -77,12 +76,14 @@         Right result -> return $ Done result  -- | Prepare the test tree to be run-createTestMap :: OptionSet -> TestTree -> IO TestMap-createTestMap opts tree =-  flip execStateT (TestMap 0 IntMap.empty) $ getApp $+createTestActions :: OptionSet -> TestTree -> IO [(IO (), TVar Status)]+createTestActions opts tree =+  liftM (map $ first $ ($ return ())) $ -- no more finalizers will be added+  execWriterT $ getApp $   foldTestTree     runSingleTest     (const id)+    addInitAndRelease     opts     tree   where@@ -91,16 +92,28 @@       let         act =           executeTest (run opts test) statusVar-      TestMap ix tmap <- get-      let-        tmap' = IntMap.insert ix (act, statusVar) tmap-        ix' = ix+1-      put $! TestMap ix' tmap'---- | Start running all the tests in the TestMap in parallel-launchTests :: Int -> TestMap -> IO ()-launchTests threads (TestMap _ tmap) =-  runInParallel threads $ map fst $ IntMap.elems tmap+      tell [(act, statusVar)]+    addInitAndRelease (ResourceSpec doInit doRelease) a =+      AppMonoid . WriterT . fmap ((,) ()) $ do+        tests <- execWriterT $ getApp a+        let ntests = length tests+        initVar <- newMVar Nothing+        finishVar <- newMVar ntests+        let+          init = do+            modifyMVar initVar $ \mbRes  ->+              case mbRes of+                Nothing -> do+                  res <- doInit+                  return (Just res, res)+                Just res -> return (mbRes, res)+          release x = do+            modifyMVar_ finishVar $ \nUsers -> do+              let nUsers' = nUsers - 1+              when (nUsers' == 0) $+                doRelease x+              return nUsers'+        return $ map (first $ \t fin' -> init >>= \r -> t (release r >> fin')) tests  -- | Start running all the tests in a test tree in parallel. The number of -- threads is determined by the 'NumThreads' option.@@ -109,7 +122,7 @@ -- variable. launchTestTree :: OptionSet -> TestTree -> IO StatusMap launchTestTree opts tree = do-  tmap@(TestMap _ smap) <- createTestMap opts tree+  testActions <- createTestActions opts tree   let NumThreads numTheads = lookupOption opts-  launchTests numTheads tmap-  return $ fmap snd smap+  runInParallel numTheads (fst <$> testActions)+  return $ IntMap.fromList $ zip [0..] (snd <$> testActions)

@@ -2,7 +2,7 @@ --  see http://haskell.org/cabal/users-guide/  name:                tasty-version:             0.4.2+version:             0.5 synopsis:            Modern and extensible testing framework description:         See <http://documentup.com/feuerbach/tasty> license:             MIT