test-sandbox-quickcheck (empty) → 0.0.1
raw patch · 4 files changed
+142/−0 lines, 4 filesdep +QuickCheckdep +basedep +mtlsetup-changed
Dependencies added: QuickCheck, base, mtl, random, test-sandbox, transformers
Files
- LICENSE +25/−0
- Setup.lhs +4/−0
- src/Test/Sandbox/QuickCheck.hs +91/−0
- test-sandbox-quickcheck.cabal +22/−0
+ LICENSE view
@@ -0,0 +1,25 @@+The BSD 3-Clause License+========================++Copyright (c) 2013, GREE+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 GREE, 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.
+ Setup.lhs view
@@ -0,0 +1,4 @@+#! /usr/bin/env runhaskell++> import Distribution.Simple+> main = defaultMain
+ src/Test/Sandbox/QuickCheck.hs view
@@ -0,0 +1,91 @@+-- author: Benjamin Surma <benjamin.surma@gree.net>++{-# LANGUAGE CPP #-}++module Test.Sandbox.QuickCheck (+ quickCheck+ , quickCheckWith+ , verboseCheck+ , verboseCheckWith+ ) where++import Control.Monad.Trans (lift, liftIO)+import Control.Monad.Trans.Error (runErrorT)+import Control.Monad.State.Strict (get, evalStateT)+import Control.Monad.Error.Class (throwError)+import Data.Maybe (fromMaybe)+import System.Exit (exitFailure)+import System.Random++#if !MIN_VERSION_QuickCheck(2,6,0)+import Data.List (isInfixOf)+#endif++import Test.Sandbox.Internals++import Test.QuickCheck hiding (quickCheck, quickCheckWith, verboseCheck, verboseCheckWith)+import Test.QuickCheck.Monadic+import Test.QuickCheck.Property hiding (Result, interrupted, reason)++-- | Tests a property and prints the results to stdout.+quickCheck :: PropertyM Sandbox () -> Sandbox ()+quickCheck prop = getQuickCheckOptions+ >>= maybe (quickCheck' quickCheckResult prop) (`quickCheckWith` prop)++-- | Tests a property, using test arguments, and prints the results to stdout.+quickCheckWith :: Args -> PropertyM Sandbox () -> Sandbox ()+quickCheckWith args = quickCheck' (quickCheckWithResult args)++-- | Tests a property and prints the results and all test cases generated to stdout.+verboseCheck :: PropertyM Sandbox () -> Sandbox ()+verboseCheck prop = getQuickCheckOptions+ >>= maybe (quickCheck' verboseCheckResult prop) (`verboseCheckWith` prop)++-- | Tests a property, using test arguments, and prints the results and all test cases generated to stdout.+verboseCheckWith :: Args -> PropertyM Sandbox () -> Sandbox ()+verboseCheckWith args = quickCheck' (verboseCheckWithResult args)++quickCheck' :: (Property -> IO Result) -> PropertyM Sandbox () -> Sandbox ()+quickCheck' tester prop = do+ seed <- getVariable seedVariable Nothing :: Sandbox (Maybe Int)+ Sandbox $ do+ env <- lift get+ res <- liftIO . tester $ monadic (runSandboxProperty env) prop+ case res of+#if MIN_VERSION_QuickCheck(2,6,0)+ Failure { interrupted = i, output = o } -> if i then liftIO exitFailure+ else throwError (o ++ maybe "" (\s -> " (used seed " ++ show s ++ ")") seed)+#else+ Failure { reason = r, output = o } -> if "user interrupt" `isInfixOf` r then liftIO exitFailure+ else throwError (o ++ maybe "" (\s -> " (used seed " ++ show s ++ ")") seed)+#endif+ NoExpectedFailure { output = o } -> throwError o+ _ -> return ()++runSandboxProperty :: SandboxState -> Sandbox Property -> Property+runSandboxProperty env prop = morallyDubiousIOProperty $+ (evalStateT . runErrorT . runSandbox) prop env >>= either error return++getQuickCheckOptions :: Sandbox (Maybe Args)+getQuickCheckOptions = do+ options <- getOptions+ case options of+ Nothing -> do+ (gen, seed) <- randomSeed+ setVariable seedVariable (Just seed)+ return $ Just stdArgs { replay = Just (gen, 0) }+ Just stuff -> do+ (gen, seed) <- case stoSeed stuff of+ Nothing -> randomSeed+ Just SandboxRandomSeed -> randomSeed+ Just (SandboxFixedSeed i) -> fixedSeed i+ setVariable seedVariable (Just seed)+ return $ Just stdArgs { replay = Just (gen, 0)+ , maxSuccess = fromMaybe (maxSuccess stdArgs) (stoMaximumGeneratedTests stuff)+ , maxDiscardRatio = fromMaybe (maxDiscardRatio stdArgs) (stoMaximumUnsuitableGeneratedTests stuff)+ , maxSize = fromMaybe (maxSize stdArgs) (stoMaximumTestSize stuff) }+ where randomSeed = liftIO randomIO >>= fixedSeed+ fixedSeed s = return (mkStdGen s, s)++seedVariable :: String+seedVariable = "__QUICKCHECK_SEED__"
+ test-sandbox-quickcheck.cabal view
@@ -0,0 +1,22 @@+Name: test-sandbox-quickcheck+Version: 0.0.1+Cabal-Version: >= 1.14+Category: Testing+Synopsis: QuickCheck convenience functions for use with test-sandbox+Description: This package provides wrappers around the Test.QuickCheck property testing functions,+ allowing them to be used easily in the Test.Sandbox monad provided by the test-sandbox package.+License: BSD3+License-File: LICENSE+Author: Benjamin Surma <benjamin.surma@gree.net>+Maintainer: Benjamin Surma <benjamin.surma@gree.net>+Build-Type: Simple++Library+ Exposed-modules: Test.Sandbox.QuickCheck++ Build-Depends: base >=4 && <5, mtl, random, transformers,+ test-sandbox == 0.0.1.*, QuickCheck >=2.1++ Hs-source-dirs: src++ Default-Language: Haskell2010