test-simple 0.1.2 → 0.1.3
raw patch · 3 files changed
+58/−14 lines, 3 filesdep +QuickCheck
Dependencies added: QuickCheck
Files
- src/Test/Simple.hs +28/−7
- test-simple.cabal +3/−3
- tests/Main.hs +27/−4
src/Test/Simple.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE GeneralizedNewtypeDeriving, MultiParamTypeClasses, TemplateHaskell #-}+{-# LANGUAGE GeneralizedNewtypeDeriving, MultiParamTypeClasses, TemplateHaskell, FlexibleInstances #-} ---------------------------------------------------------------------- -- | -- Module : Test.Simple@@ -11,7 +11,14 @@ -- Test.Simple is yet another testing library for Haskell. It has testing primitives -- familiar to recovering Perl programmers :). -- --- Here is example suitable for cabal test-suite integration. Note that TemplateHaskell+-- Having 'MonadPlus' instance allows to cut tests early e.g using 'guard' function.+--+-- Being monad transformer it includes integration with 'QuickCheck' by declaring 'Testable' instance +-- on @TestSimpleT Gen a@.+-- +-- Test.Simple also has the ability to run in pure context (see 'runTestSimple' function).+--+-- Here is an example suitable for cabal test-suite integration. Note that TemplateHaskell -- usage is optional and is needed for test failure locations only. -- -- @@@ -41,7 +48,7 @@ TestSimpleT, Likeable(isLike), -- * Main- testSimpleMain, runTestSimple,+ testSimpleMain, runTestSimple, qcTestSimpleMain, -- * Plan plan,@@ -55,9 +62,12 @@ import Control.Monad.Trans.State.Plus import Control.Monad.State import System.Exit (exitFailure)-import Data.List (isInfixOf)+import Data.List (isInfixOf, intercalate) import System.IO (hPutStrLn, stderr) import qualified Language.Haskell.TH as TH+import Test.QuickCheck (Testable(property), quickCheckResult, Gen)+import Test.QuickCheck.Test (isSuccess)+import Test.QuickCheck.Property (Result(reason), succeeded, failed) -- | Is used in 'like', 'unlike' tests. class Likeable a b where@@ -87,9 +97,9 @@ where finish = do s <- get- let failed = tsFailed s > 0+ let fld = tsFailed s > 0 let mismatch = (tsPlanned s /= tsCounter s)- if failed+ if fld then diag $ "Looks like you failed " ++ show (tsFailed s) ++ " test of " ++ show (tsPlanned s) ++ "." else if mismatch@@ -97,7 +107,7 @@ ++ " tests but ran " ++ show (tsCounter s) ++ "." else return () modify finOutput- return $ not (failed || mismatch)+ return $ not (fld || mismatch) finOutput s = s { tsOutput = (StdOut $ "1.." ++ show (tsPlanned s)):(reverse $ tsOutput s) } isFailed s = tsFailed s > 0 || (tsPlanned s /= tsCounter s) @@ -203,3 +213,14 @@ m = TH.loc_module l s = TH.loc_start l e = TH.loc_end l++instance Testable (TestSimpleT Gen a) where+ property m = do+ (b, lns) <- runTestSimple m+ property $ if b then succeeded else failed { reason = intercalate "\n" lns }++-- | Run some 'Testable' monad through 'QuickCheck'. Exit with failure on error.+qcTestSimpleMain :: (Testable (m a), Monad m) => m a -> IO ()+qcTestSimpleMain m = do+ res <- quickCheckResult m+ unless (isSuccess res) exitFailure
test-simple.cabal view
@@ -1,5 +1,5 @@ Name: test-simple-Version: 0.1.2+Version: 0.1.3 License: BSD3 License-File: COPYING Copyright: Boris Sukholitko, 2012@@ -14,14 +14,14 @@ results in TAP format. library - build-depends: base < 5, mtl, template-haskell, state-plus+ build-depends: base < 5, mtl, template-haskell, state-plus, QuickCheck > 2.4 hs-source-dirs: src ghc-options: -Wall exposed-modules: Test.Simple test-suite Main type: exitcode-stdio-1.0- build-depends: base < 5, test-simple, process, executable-path, mtl+ build-depends: base < 5, test-simple, process, executable-path, mtl, QuickCheck > 2.4 ghc-options: -Wall hs-source-dirs: tests main-is: Main.hs
tests/Main.hs view
@@ -4,9 +4,10 @@ import System.Environment (getArgs) import System.Environment.Executable (getExecutablePath) import System.Process (readProcessWithExitCode)-import Control.Monad.Trans (liftIO)+import Control.Monad.Trans (liftIO, lift) import System.Exit (ExitCode(ExitSuccess)) import Control.Monad (guard)+import Test.QuickCheck (Gen, arbitrary) locTest :: TestSimpleT IO Bool locTest = $loc >> ok False@@ -55,7 +56,7 @@ testLocationPrint :: ExitCode -> String -> String -> TestSimpleT IO Bool testLocationPrint ec _ err = do isnt ec ExitSuccess- like err " Failed test at tests/Main.hs line 12"+ like err " Failed test at tests/Main.hs line 13" like err "# Looks like you failed 1 test of 1.\n" testMPlus :: ExitCode -> String -> String -> TestSimpleT IO Bool@@ -91,9 +92,20 @@ is err "" is out "True\n1..1\n# Bar\nok 1\n" +testQCOK :: ExitCode -> String -> String -> TestSimpleT IO Bool+testQCOK ec out _ = do+ is ec ExitSuccess+ is out "+++ OK, passed 100 tests.\n"++testQCFail :: ExitCode -> String -> String -> TestSimpleT IO Bool+testQCFail ec out err = do+ isnt ec ExitSuccess+ like err "not ok 1"+ like out "Failed! 1..1"+ testAll :: IO () testAll = testSimpleMain $ do- plan 47+ plan 52 pn <- liftIO getExecutablePath mapM_ (runMyself pn) [ ("bbbf", testUnknown), ("ok1", testOk1), ("nok1", testNOk1) , ("mism", testMismatch), ("isf", testIsFailure)@@ -101,11 +113,20 @@ , ("unlike", testOk1), ("fail_unlike", testUnlikeFailure) , ("guard", testOk1), ("mplus", testMPlus), ("fail_mplus", testMPlusFail) , ("guardisnt", testGuard), ("either", testEither)- , ("runts", testRunTS) ]+ , ("runts", testRunTS), ("qcrunok", testQCOK), ("qcfail", testQCFail) ] where runMyself pn (arg, act) = do (ec, out, err) <- liftIO $ readProcessWithExitCode pn [ arg ] "" act ec out err +identTS :: TestSimpleT Gen ()+identTS = plan 1 >> ok True >> return ()++failQC :: TestSimpleT Gen Bool+failQC = do+ plan 1+ b <- lift arbitrary+ ok b+ main :: IO () main = do as <- getArgs@@ -131,5 +152,7 @@ (b, lg) <- runTestSimple $ plan 1 >> diag "Bar" >> ok True putStrLn $ show b mapM_ putStrLn lg+ [ "qcrunok" ] -> qcTestSimpleMain identTS+ [ "qcfail" ] -> qcTestSimpleMain failQC _ -> error $ "Unknown: " ++ show as