quickcheck-simple 0.1.0.4 → 0.1.1.0
raw patch · 4 files changed
+163/−67 lines, 4 files
Files
- example/e0.hs +56/−20
- quickcheck-simple.cabal +10/−4
- src/Test/QuickCheck/CompatIO.hs +24/−0
- src/Test/QuickCheck/Simple.hs +73/−43
example/e0.hs view
@@ -1,32 +1,68 @@ import Test.QuickCheck.Simple+import System.IO.Error -int1 :: Int-int1 = 1+boolTQ :: Test+boolTQ = boolTest "true" True -stringHello :: String-stringHello = "Hello"+boolTV :: Test+boolTV = boolTest' "true-verbose" "verbose true" True -prop_int1 :: Bool-prop_int1 = int1 == 1+boolFQ :: Test+boolFQ = boolTest "false" False -prop_stringHelloBad :: Bool-prop_stringHelloBad = stringHello == "Hellox"+boolFV :: Test+boolFV = boolTest' "false-verbose" "verbose false error message" False -prop_intComBad :: Int -> Int -> Bool-prop_intComBad i j = i + j == j + i + 1+eqTQ :: Test+eqTQ = eqTest "eq" 1 (1 :: Int) -prop_intCom2Bad :: Int -> Int -> Bool-prop_intCom2Bad i j = i + j == j + i + 2+eqTV :: Test+eqTV = eqTest' (==) show "eq-verbose" 1 (1 :: Int) -tests :: [Test]-tests =- [ boolTest "int1" prop_int1- , boolTest' "stringHelloBad" "Hello =/= Hellox" prop_stringHelloBad- , eqTest "stringHelloBad" stringHello "Hellox"- , qcTest "intComBad" prop_intComBad- , qcTest "intCom2Bad" prop_intCom2Bad+eqFQ :: Test+eqFQ = eqTest "neq" 2 (1 :: Int)++eqFV :: Test+eqFV = eqTest' (==) show "neq-verbose" 2 (1 :: Int)++qcT :: Test+qcT = qcTest "qc-true" (\x -> (x :: Int) == x)++qcF :: Test+qcF = qcTest "qc-false" (\x -> (x :: Int) == x + 1)++successTests :: [Test]+successTests =+ [ boolTQ+ , boolTV+ , eqTQ+ , eqTV+ , qcT ] +allTests :: [Test]+allTests =+ [ boolTQ+ , boolTV+ , boolFQ+ , boolFV+ , eqTQ+ , eqTV+ , eqFQ+ , eqFV+ , qcT+ , qcF+ ]++putLine :: IO ()+putLine = putStrLn "\n------------------------------\n"+ main :: IO ()-main = defaultMain' True tests+main = do+ verboseMain successTests+ putLine+ _ <- tryIOError $ defaultMain allTests+ putLine+ _ <- tryIOError $ verboseMain allTests+ return ()
quickcheck-simple.cabal view
@@ -1,5 +1,5 @@ name: quickcheck-simple-version: 0.1.0.4+version: 0.1.1.0 synopsis: Test properties and default-mains for QuickCheck description: This package contains definitions of test properties and default-mains using QuickCheck library.@@ -7,12 +7,13 @@ license-file: LICENSE author: Kei Hibino maintainer: ex8k.hibino@gmail.com-copyright: Copyright (c) 2015-2018 Kei Hibino+copyright: Copyright (c) 2015-2019 Kei Hibino category: Testing build-type: Simple extra-source-files: example/e0.hs cabal-version: >=1.10-tested-with: GHC == 8.4.1, GHC == 8.4.2, GHC == 8.4.3+tested-with: GHC == 8.6.1, GHC == 8.6.2, GHC == 8.6.3, GHC == 8.6.4, GHC == 8.6.5+ , GHC == 8.4.1, GHC == 8.4.2, GHC == 8.4.3, GHC == 8.4.4 , GHC == 8.2.1, GHC == 8.2.2 , GHC == 8.0.1, GHC == 8.0.2 , GHC == 7.10.1, GHC == 7.10.2, GHC == 7.10.3@@ -21,10 +22,15 @@ , GHC == 7.4.1, GHC == 7.4.2 library- exposed-modules: Test.QuickCheck.Simple+ exposed-modules:+ Test.QuickCheck.Simple+ Test.QuickCheck.CompatIO+ build-depends: base <5, QuickCheck >=2 hs-source-dirs: src ghc-options: -Wall+ if impl(ghc >= 8)+ ghc-options: -Wcompat -Wnoncanonical-monadfail-instances default-language: Haskell2010 source-repository head
+ src/Test/QuickCheck/CompatIO.hs view
@@ -0,0 +1,24 @@+{-# LANGUAGE CPP #-}++-- |+-- Module : Test.QuickCheck.CompatIO+-- Copyright : 2019 Kei Hibino+-- License : BSD3+--+-- Maintainer : ex8k.hibino@gmail.com+-- Stability : experimental+-- Portability : unknown+--+-- This module provides a compatible ioProperty definition.+module Test.QuickCheck.CompatIO (+ ioProperty,+ ) where++#if MIN_VERSION_QuickCheck(2,7,0)+import Test.QuickCheck (ioProperty)+#else+import Test.QuickCheck.Property (Testable, Property, morallyDubiousIOProperty)++ioProperty :: Testable prop => IO prop -> Property+ioProperty = morallyDubiousIOProperty+#endif
src/Test/QuickCheck/Simple.hs view
@@ -1,6 +1,6 @@ -- | -- Module : Test.QuickCheck.Simple--- Copyright : 2015 Kei Hibino+-- Copyright : 2015-2019 Kei Hibino -- License : BSD3 -- -- Maintainer : ex8k.hibino@gmail.com@@ -14,14 +14,17 @@ , boolTest', boolTest , eqTest', eqTest , qcTest+ , Test, TestError (..)- , runTest- , defaultMain', defaultMain+ , runTest_, runTest+ , defaultMain_, defaultMain, verboseMain++ , defaultMain' ) where import Control.Applicative ((<$>))-import Control.Monad (when, unless)-import Data.Maybe (fromMaybe, catMaybes)+import Control.Monad (unless)+import Data.Maybe (catMaybes) import Data.Monoid ((<>)) import Test.QuickCheck (Testable, Result (..), quickCheckResult, label)@@ -30,17 +33,11 @@ -- | Property type. 'Bool' or 'Testable' of QuickCheck. data Property- = Bool (Maybe String) Bool+ = Bool (Maybe String {- verbose error message -}) Bool | QuickCheck QC.Property -- | Property with label string-type Test = (String, Property)---- | Test error result.-data TestError- = BFalse (Maybe String)- | QCError Result- deriving Show+type Test = (String {- label -}, Property) mkBoolTest :: String -> Maybe String -> Bool -> Test mkBoolTest n m = ((,) n) . Bool m@@ -74,54 +71,87 @@ -> Test qcTest n = ((,) n) . QuickCheck . label n +--------------------------------------------------------------------------------++-- | Test failure result.+data TestError+ = BFalse (Maybe String {- verbose error message -})+ | QCError Result+ deriving Show+ putErrorLn :: String -> IO () putErrorLn = putStrLn . ("*** " <>) -runBool :: String -> Maybe String -> Bool -> IO (Maybe TestError)-runBool n m = d where+printVerbose :: String -> TestError -> IO ()+printVerbose lb te = case te of+ BFalse m -> maybe (return ()) format m+ QCError r -> format $ show r+ where+ format s =+ mapM_ putErrorLn+ $ ("label: " <> lb <> ":") : (map (" " <>) $ lines s)++runBool :: String+ -> Maybe String -- ^ verbose error message. Nothing corresponds to not verbose.+ -> Bool+ -> IO (Maybe TestError)+runBool lb vmsg = d where d True = do- putStrLn $ "+++ OK, success (" <> n <> ")"+ putStrLn $ "+++ OK, success (" <> lb <> ")" return Nothing d False = do- putErrorLn $ "Failed! (" <> n <> ")"- return . Just $ BFalse m+ putErrorLn $ "Failed! (" <> lb <> ")"+ let r = BFalse vmsg+ printVerbose lb r+ return $ Just r -runQcProp :: String -> QC.Property -> IO (Maybe TestError)-runQcProp n p = err =<< quickCheckResult p where+runQcProp :: Bool -- ^ verbose flag+ -> String+ -> QC.Property+ -> IO (Maybe TestError)+runQcProp verbose lb p = err =<< quickCheckResult p where err (Success {}) = return Nothing err x = do- putErrorLn $ " label: " <> n- return . Just $ QCError x+ let r = QCError x+ if verbose+ then printVerbose lb r -- this action show label+ else putErrorLn $ "label: " <> lb -- quickcheck does not show label+ return $ Just r -runProp :: String -> Property -> IO (Maybe TestError)-runProp n = d where- d (Bool m b) = runBool n m b- d (QuickCheck p) = runQcProp n p+runProp :: Bool+ -> String+ -> Property+ -> IO (Maybe TestError)+runProp verbose lb prop = case prop of+ Bool m b -> runBool lb (if verbose then m else Nothing) b+ QuickCheck p -> runQcProp verbose lb p -- | Run a single test suite.-runTest :: Test- -> IO (Maybe TestError)-runTest = uncurry runProp--runPropL :: String -> Property -> IO (Maybe (String, TestError))-runPropL n p = do- me <- runProp n p- return $ fmap ((,) n) me+runTest_ :: Bool -- ^ verbose flag+ -> Test -- ^ property to test+ -> IO (Maybe TestError) -- ^ result action, and may be failure result+runTest_ verbose = uncurry $ runProp verbose -showTestError :: TestError -> String-showTestError = d where- d (BFalse m) = fromMaybe "" m- d (QCError r) = show r+-- | Not verbose version of runTest_+runTest :: Test -- ^ property to test+ -> IO (Maybe TestError) -- ^ result action, and may be failure result+runTest = runTest_ False -- | Default main to run test suites.-defaultMain' :: Bool -> [Test] -> IO ()-defaultMain' verbose xs = do- es <- catMaybes <$> mapM (uncurry runPropL) xs- let rlines m r = (m <> ":") : [ " " <> x | x <- lines $ showTestError r ]- when verbose $ mapM_ (\(m, r) -> mapM_ putStrLn $ rlines m r) es+defaultMain_ :: Bool -> [Test] -> IO ()+defaultMain_ verbose xs = do+ es <- catMaybes <$> mapM (runTest_ verbose) xs unless (null es) $ fail "Some failures are found." +defaultMain' :: Bool -> [Test] -> IO ()+defaultMain' = defaultMain_+{-# DEPRECATED defaultMain' "Use defaultMain_ instead of this." #-}+ -- | Not verbose version of 'defaultMain''. defaultMain :: [Test] -> IO () defaultMain = defaultMain' False++-- | Verbose verison of defaultMain+verboseMain :: [Test] -> IO ()+verboseMain = defaultMain' True