test-simple 0.1.4 → 0.1.5

raw patch · 3 files changed

+44/−12 lines, 3 files

Files

• src/Test/Simple.hs +17/−4
• test-simple.cabal +1/−1
• tests/Main.hs +26/−7

@@ -48,7 +48,7 @@             TestSimpleT, Likeable(isLike),                          -- * Main-            testSimpleMain, runTestSimple, qcTestSimpleMain,+            testSimpleMain, runTestSimple, qcTestSimpleWith, qcTestSimpleMain,                          -- * Plan             plan,@@ -67,7 +67,9 @@ import qualified Language.Haskell.TH as TH import Test.QuickCheck (Testable(property), quickCheckResult, Gen) import Test.QuickCheck.Test (isSuccess)+import qualified Test.QuickCheck.Test as Q import Test.QuickCheck.Property (Result(reason), succeeded, failed)+import Test.QuickCheck.Monadic  -- | Is used in 'like', 'unlike' tests. class Likeable a b where@@ -218,11 +220,22 @@         (b, lns) <- runTestSimple m         property $ if b then succeeded else failed { reason = intercalate "\n" lns } +instance Testable (TestSimpleT (PropertyM IO) a) where+    property m = monadicIO $ do+        (b, lns) <- runTestSimple m+        unless b $ run $ mapM_ putStrLn lns+        assert b++-- | Run some 'Testable' monad through 'QuickCheck' function. Exit with failure on error.+qcTestSimpleWith :: (Testable (m a), Monad m) => (m a -> IO Q.Result) -> m a -> IO ()+qcTestSimpleWith qc m = do+    res <- qc m+    unless (isSuccess res) exitFailure+ -- | Run some 'Testable' monad through 'QuickCheck'. Exit with failure on error.+-- Equivalent to 'qcTestSimpleWith' 'quickCheckResult' qcTestSimpleMain :: (Testable (m a), Monad m) => m a -> IO ()-qcTestSimpleMain m = do-    res <- quickCheckResult m-    unless (isSuccess res) exitFailure+qcTestSimpleMain = qcTestSimpleWith quickCheckResult  -- | Generates and logs (through 'diag') arbitrary value. Also outputs current location. diagen :: Show a => String -> Gen a -> TestSimpleT Gen a

@@ -1,5 +1,5 @@ Name:                test-simple-Version:             0.1.4+Version:             0.1.5 License:             BSD3 License-File:        COPYING Copyright:           Boris Sukholitko, 2012

@@ -7,7 +7,8 @@ import Control.Monad.Trans (liftIO, lift) import System.Exit (ExitCode(ExitSuccess)) import Control.Monad (guard)-import Test.QuickCheck (Gen, arbitrary, choose)+import Test.QuickCheck (Gen, arbitrary, choose, stdArgs, quickCheckWithResult, Args(maxSuccess))+import Test.QuickCheck.Monadic  locTest :: TestSimpleT IO Bool locTest = $loc >> ok False@@ -56,7 +57,7 @@ testLocationPrint :: ExitCode -> String -> String -> TestSimpleT IO Bool testLocationPrint ec _ err = do     isnt ec ExitSuccess-    like err "  Failed test at tests/Main.hs line 13"+    like err "  Failed test at tests/Main.hs line 14"     like err "# Looks like you failed 1 test of 1.\n"  testMPlus :: ExitCode -> String -> String -> TestSimpleT IO Bool@@ -92,10 +93,10 @@     is err ""     is out "True\n1..1\n# Bar\nok 1\n" -testQCOK :: ExitCode -> String -> String -> TestSimpleT IO Bool-testQCOK ec out _ = do+testQCOK :: Int -> ExitCode -> String -> String -> TestSimpleT IO Bool+testQCOK n ec out _ = do     is ec ExitSuccess-    is out "+++ OK, passed 100 tests.\n"+    is out $ "+++ OK, passed " ++ show n ++ " tests.\n"  testQCFail :: ExitCode -> String -> String -> TestSimpleT IO Bool testQCFail ec out _ = do@@ -104,9 +105,15 @@     like out "Failed! 1..2"     like out "# Foo: False at unknown location." +testPropFail :: ExitCode -> String -> String -> TestSimpleT IO Bool+testPropFail ec out _ = do+    isnt ec ExitSuccess+    like out "not ok 1"+    like out "Failed! Assertion"+ testAll :: IO () testAll = testSimpleMain $ do-    plan 53+    plan 58     pn <- liftIO getExecutablePath     mapM_ (runMyself pn) [ ("bbbf", testUnknown), ("ok1", testOk1), ("nok1", testNOk1)                 , ("mism", testMismatch), ("isf", testIsFailure)@@ -114,7 +121,8 @@                 , ("unlike", testOk1), ("fail_unlike", testUnlikeFailure)                 , ("guard", testOk1), ("mplus", testMPlus), ("fail_mplus", testMPlusFail)                 , ("guardisnt", testGuard), ("either", testEither)-                , ("runts", testRunTS), ("qcrunok", testQCOK), ("qcfail", testQCFail) ]+                , ("runts", testRunTS), ("qcrunok", testQCOK 100), ("qcfail", testQCFail)+                , ("qcmonok", testQCOK 5), ("qcmonfail", testPropFail) ]     where runMyself pn (arg, act) = do                 (ec, out, err) <- liftIO $ readProcessWithExitCode pn [ arg ] ""                 act ec out err@@ -122,6 +130,9 @@ identTS :: TestSimpleT Gen () identTS = plan 1 >> ok True >> return () +propMon :: TestSimpleT (PropertyM IO) ()+propMon = plan 1 >> ok True >> return ()+ failQC :: TestSimpleT Gen Bool failQC = do     plan 2@@ -130,6 +141,11 @@     b <- diagen "Foo" arbitrary     ok b +propFail :: TestSimpleT (PropertyM IO) Bool+propFail = do+    plan 1+    ok False+ main :: IO () main = do     as <- getArgs@@ -157,5 +173,8 @@             mapM_ putStrLn lg         [ "qcrunok" ] -> qcTestSimpleMain identTS         [ "qcfail" ] -> qcTestSimpleMain failQC+        [ "qcmonok" ] -> qcTestSimpleWith (quickCheckWithResult $ stdArgs { maxSuccess = 5 })+                                propMon+        [ "qcmonfail" ] -> qcTestSimpleMain propFail         _ -> error $ "Unknown: " ++ show as