tasty-fail-fast (empty) → 0.0.1
raw patch · 8 files changed
+285/−0 lines, 8 filesdep +basedep +containersdep +directorysetup-changed
Dependencies added: base, containers, directory, stm, tagged, tasty, tasty-fail-fast, tasty-golden, tasty-hunit, tasty-tap
Files
- LICENSE +30/−0
- README.md +6/−0
- Setup.hs +2/−0
- changelog.md +2/−0
- src/Test/Tasty/Ingredients/FailFast.hs +90/−0
- tasty-fail-fast.cabal +71/−0
- test/Main.hs +75/−0
- test/golden/simple.tap +9/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Michael Xavier (c) 2015++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Michael Xavier nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,6 @@+# tasty-fail-fast++[](https://travis-ci.org/MichaelXavier/tasty-fail-fast)+++Adds the ability to fail a tasty test suite on first test failure
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ changelog.md view
@@ -0,0 +1,2 @@+0.0.1+* Initial release
+ src/Test/Tasty/Ingredients/FailFast.hs view
@@ -0,0 +1,90 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE TupleSections #-}+module Test.Tasty.Ingredients.FailFast+ ( failFast+ , FailFast(..)+ ) where+++-------------------------------------------------------------------------------+import Control.Applicative+import Control.Concurrent+import Control.Concurrent.STM+import qualified Data.IntMap.Strict as IM+import Data.Monoid+import Data.Proxy+import Data.Typeable+import Test.Tasty.Ingredients+import Test.Tasty.Options+import Test.Tasty.Runners+-------------------------------------------------------------------------------+import Prelude+-------------------------------------------------------------------------------+++-- | Decorate a TestReporter. Will throw an error if you provide a TestManager.+failFast :: Ingredient -> Ingredient+failFast (TestManager _ _) = error "FailFast must be applied to a TestReporter"+failFast (TestReporter opts f) = TestReporter (ffOpt:opts) f'+ where ffOpt = Option (Proxy :: Proxy FailFast)+ f' oset tree = let FailFast ff = lookupOption oset+ in if ff+ then ffHijack <$> f oset tree+ else f oset tree+++-------------------------------------------------------------------------------+ffHijack :: (StatusMap -> IO (Time -> IO Bool)) -> StatusMap -> IO (Time -> IO Bool)+ffHijack f sm = do+ _ <- forkIO (work sm)+ f sm++-------------------------------------------------------------------------------+newtype FailFast = FailFast Bool deriving (Show, Eq, Typeable)++instance IsOption FailFast where+ defaultValue = FailFast False+ parseValue = fmap FailFast . safeRead+ optionName = return "fail-fast"+ optionHelp = return "Fail the whole suite when the first test fails."+ optionCLParser = flagCLParser Nothing (FailFast True)+++-------------------------------------------------------------------------------+work :: StatusMap -> IO ()+work sm = atomically $ do+ check =<< anyFailed sm+ failAll sm+++-------------------------------------------------------------------------------+anyFailed :: StatusMap -> STM Bool+anyFailed = anyM (fmap isFailed . readTVar) . IM.elems+ where isFailed (Done (Result { resultOutcome = Failure _})) = True+ isFailed _ = False+++-------------------------------------------------------------------------------+anyM :: Monad m => (a -> m Bool) -> [a] -> m Bool+anyM _ [] = return False+anyM p (x:xs) = do q <- p x+ if q+ then return True+ else anyM p xs+-------------------------------------------------------------------------------+failAll :: StatusMap -> STM ()+failAll = mapM_ failOne . IM.elems+++-------------------------------------------------------------------------------+failOne :: TVar Status -> STM ()+failOne = flip modifyTVar' go+ where go NotStarted = Done res+ go x = x+ res = Result { resultOutcome = Failure TestFailed+ , resultDescription = mempty+#if MIN_VERSION_tasty(0,11,0)+ , resultShortDescription = mempty+#endif+ , resultTime = 0}
+ tasty-fail-fast.cabal view
@@ -0,0 +1,71 @@+name: tasty-fail-fast+version: 0.0.1+synopsis: Adds the ability to fail a tasty test suite on first test failure+description:+ tasty-fail-fast wraps any ingredient to fail as soon as the first test fails. For example:+ .+ @+ defaultMainWithIngredients (map failFast defaultIngredients) tests+ @+ .+ Your test suite will now get a @--fail-fast@ flag.+homepage: http://github.com/MichaelXavier/tasty-fail-fast#readme+license: MIT+license-file: LICENSE+author: Michael Xavier+maintainer: michael@michaelxavier.net+copyright: 2015 Michael Xavier+category: Web+build-type: Simple+cabal-version: >=1.10+tested-with: GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.2++extra-source-files:+ README.md+ changelog.md+ test/golden/simple.tap++flag lib-Werror+ default: False+ manual: True+++library+ hs-source-dirs: src+ exposed-modules: Test.Tasty.Ingredients.FailFast+ build-depends: base < 5+ , tasty >= 0.10 && < 0.12+ , stm >= 2.1+ , containers >= 0.1.0.0+ , tagged+ default-language: Haskell2010++ if flag(lib-Werror)+ ghc-options: -Werror++ ghc-options: -Wall+++test-suite test+ type: exitcode-stdio-1.0+ main-is: Main.hs+ hs-source-dirs: test+ default-language: Haskell2010++ build-depends: base+ , tasty+ , tasty-fail-fast+ , tasty-hunit+ , tasty-golden+ , tasty-tap+ , directory++ if flag(lib-Werror)+ ghc-options: -Werror++ ghc-options: -Wall+++source-repository head+ type: git+ location: https://github.com/MichaelXavier/tasty-fail-fast
+ test/Main.hs view
@@ -0,0 +1,75 @@+module Main+ ( main+ ) where+++-------------------------------------------------------------------------------+import Control.Exception+import Control.Monad+import Data.Monoid+import System.Directory+import System.Exit+import System.IO+import Test.Tasty+import Test.Tasty.Golden+import Test.Tasty.HUnit+import Test.Tasty.Ingredients+import Test.Tasty.Options+import Test.Tasty.Runners.TAP+-------------------------------------------------------------------------------+import Test.Tasty.Ingredients.FailFast+-------------------------------------------------------------------------------+import Prelude+-------------------------------------------------------------------------------++++main :: IO ()+main = do+ tmpDir <- getTemporaryDirectory+ defaultMain (tests tmpDir)+++-------------------------------------------------------------------------------+tests :: FilePath -> TestTree+tests tmpDir = testGroup "tasty-fail-fast"+ [+ let tmpPath = tmpDir ++ "/simple.tap"+ in goldenVsFileDiff "simple.tap"+ diffCmd+ (goldenPath "simple.tap")+ tmpPath+ (mkSimple tmpPath)+ ]+++-------------------------------------------------------------------------------+diffCmd :: FilePath -> FilePath -> [String]+diffCmd ref new = ["diff", "-u", ref, new]+++-------------------------------------------------------------------------------+mkSimple :: FilePath -> IO ()+mkSimple tmpPath = bracket (openFile tmpPath WriteMode) hClose $ \h -> do+ let Just runner = tryIngredients [failFast (tapRunner' h)] opts exampleTests+ void runner `catch` interceptExit+ where interceptExit :: ExitCode -> IO ()+ interceptExit _ = return ()+ opts = setOption (FailFast True) mempty+++-------------------------------------------------------------------------------+exampleTests :: TestTree+exampleTests = testGroup "some example tests"+ [+ testCase "trivial pass" (True @?= True)+ , testCase "first failure" (True @?= False)+ , testCase "another pass" (True @?= True)+ , testCase "second failure" (True @?= False)+ , testCase "yet another pass" (True @?= True)+ ]+++-------------------------------------------------------------------------------+goldenPath :: FilePath -> FilePath+goldenPath fp = "test/golden/" ++ fp
+ test/golden/simple.tap view
@@ -0,0 +1,9 @@+TAP version 13+1..5+ok 1 - some example tests/trivial pass+not ok 2 - some example tests/first failure+# expected: False+# but got: True+not ok 3 - some example tests/another pass+not ok 4 - some example tests/second failure+not ok 5 - some example tests/yet another pass