test-framework-sandbox 0.0.1.2 → 0.0.2.0

raw patch · 3 files changed

+29/−24 lines, 3 filesdep ~test-framework

Dependency ranges changed: test-framework

Files

• src/Test/Framework/Providers/Sandbox.hs +17/−21
• src/Test/Framework/Providers/Sandbox/Internals.hs +9/−0
• test-framework-sandbox.cabal +3/−3

@@ -1,16 +1,11 @@ {- |    Module    : Test.Framework.Providers.Sandbox-   Copyright : Copyright (C) 2013 GREE, Benjamin Surma-   License   : GNU LGPL, version 2.1 or above    Maintainer: Benjamin Surma <benjamin.surma@gree.net>  test-framework interface for test-sandbox--Copyright (C) 2013 GREE, Benjamin Surma, benjamin.surma@gree.net -}  {-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE DeriveDataTypeable #-}  module Test.Framework.Providers.Sandbox (   -- * Introduction@@ -52,24 +47,25 @@ import Test.Framework.Providers.Sandbox.Internals  -- | Executes tests in the Sandbox monad.-sandboxTests :: String       -- ^ Name of the sandbox environment-             -> Sandbox Test -- ^ Test to perform+sandboxTests :: String         -- ^ Name of the sandbox environment+             -> [Sandbox Test] -- ^ Tests to perform              -> Test-sandboxTests name test = buildTest $ do+sandboxTests name tests = testGroup name [ buildTest $ do   options <- interpretArgs =<< getArgs-  mvar <- newEmptyMVar :: IO (MVar Int)-  return $ mutuallyExclusive $ testGroup name [-      buildTestBracketed $-        withSystemTempDirectory (name ++ "_") $ \dir -> do-          env <- newSandboxState name dir-          (result, env') <- (runStateT . runErrorT . runSandbox) (putOptions options >> test) env-          let cleanup = (evalStateT . runErrorT . runSandbox) (silently stopAll) env'-                          >>= either putStrLn return-                          >> putMVar mvar 0-          case result of-            Left error -> return (Test name (SandboxTest (Failure error)), cleanup)-            Right x -> return (x, cleanup)-    , Test "cleaning" (SandboxCleaning mvar) ]+  if isExcluded options name then return (Test name (SandboxTest Skipped))+    else do mvar <- newEmptyMVar :: IO (MVar Int)+            return $ mutuallyExclusive $ testGroup name [+                buildTestBracketed $+                  withSystemTempDirectory (name ++ "_") $ \dir -> do+                    env <- newSandboxState name dir+                    (result, env') <- (runStateT . runErrorT . runSandbox) (putOptions options >> sandboxTestGroup name tests) env+                    let cleanup = (evalStateT . runErrorT . runSandbox) (silently stopAll) env'+                                    >>= either putStrLn return+                                    >> putMVar mvar 0+                    case result of+                      Left error -> return (Test name (SandboxTest (Failure error)), cleanup)+                      Right x -> return (x, cleanup)+              , Test "cleaning" (SandboxCleaning mvar) ] ]  -- | Groups tests in the Sandbox monad. sandboxTestGroup :: String         -- ^ Test group name

@@ -20,6 +20,7 @@ import Test.Framework import Test.Framework.Providers.API (Testlike (..), TestResultlike (..), runImprovingIO) import qualified Test.Framework.Providers.API as TF (liftIO)+import Test.Framework.Runners.TestPattern  import Test.Sandbox import Test.Sandbox.Internals@@ -111,3 +112,11 @@ putOptions =   either (const $ return ())          (\r -> maybe (return ()) (void . Test.Sandbox.Internals.putOptions . sandboxTestOptions) (ropt_test_options $ fst r))++isExcluded :: Either String (RunnerOptions, [String]) -> String -> Bool+isExcluded input name =+  case input of+    Left _ -> False+    Right (options, _) -> case ropt_test_patterns options of+                            Nothing -> False+                            Just patterns -> not $ any (`testPatternMatches` [name]) patterns

@@ -1,5 +1,5 @@ Name:           test-framework-sandbox-Version:        0.0.1.2+Version:        0.0.2.0 Cabal-Version:  >= 1.14 Category:       Testing Synopsis:       test-sandbox support for the test-framework package@@ -29,14 +29,14 @@ Source-Repository this     Type:       git     Location:   https://github.com/gree/haskell-test-sandbox-    Tag:        0.0.1.2+    Tag:        test-framework-sandbox_0.0.2.0  Library     Exposed-modules:    Test.Framework.Providers.Sandbox                         Test.Framework.Providers.Sandbox.Internals      Build-Depends:      base >=4 && <5, ansi-terminal, lifted-base, mtl,-                        temporary, test-framework, test-sandbox == 0.0.1.*,+                        temporary, test-framework >= 0.8.0.3, test-sandbox == 0.0.1.*,                         transformers      Hs-source-dirs:     src