packages feed

test-simple 0.1.3 → 0.1.4

raw patch · 3 files changed

+39/−29 lines, 3 files

Files

src/Test/Simple.hs view
@@ -57,7 +57,7 @@             ok, isnt, is, like, unlike, isRight,              -- * Diagnostics-            loc, diag) where+            loc, diag, diagen) where  import Control.Monad.Trans.State.Plus import Control.Monad.State@@ -141,21 +141,20 @@                 , tsFailed = (tsFailed s) + if b then 0 else 1                 , tsOutput = (StdOut $ if b then oks else "not " ++ oks):(tsOutput s)             }-    unless b $ diagFailed (tsLoc s)+    unless b $ diag $ concat [ "  Failed test", showLoc s ]     return b-    where diagFailed (Just l) = diag $ concat [-            "  Failed test at ", TH.loc_filename l, " line ", show $ fst $ TH.loc_start l ]-          diagFailed _ = diag $ "  Failed test at unknown location." +showLoc :: TSState -> String+showLoc s = " at " ++ go (tsLoc s) ++ "." where+    go Nothing = "unknown location"+    go (Just l) = concat [ TH.loc_filename l, " line ", show $ fst $ TH.loc_start l ]+ (>>?) :: Monad m => m Bool -> m () -> m Bool m >>? d = do     b <- m     unless b d     return b -quote :: Show a => a -> String-quote a = "'" ++ show a ++ "'"- diagVals :: Monad m => String -> String -> String -> String-> TestSimpleT m () diagVals as a bs b = do     diag $ concat [ spaces, as, " ", a ]@@ -164,24 +163,24 @@  -- | Are values different? isnt :: (Eq a, Show a, Monad m) => a -> a -> TestSimpleT m Bool-isnt a b = ok (a /= b) >>? diagVals "got:" (quote a) "expected:" "anything else"+isnt a b = ok (a /= b) >>? diagVals "got:" (show a) "expected:" "anything else"  -- | Are values equal? is :: (Eq a, Show a, Monad m) => a -> a -> TestSimpleT m Bool-is a b = ok (a == b) >>? diagVals "got:" (quote a) "expected:" (quote b)+is a b = ok (a == b) >>? diagVals "got:" (show a) "expected:" (show b)  -- | Is @a@ like @b@? like :: (Show a, Show b, Likeable a b, Monad m) => a -> b -> TestSimpleT m Bool-like a b = ok (isLike a b) >>? diagVals "" (quote a) "doesn't match" (quote b)+like a b = ok (isLike a b) >>? diagVals "" (show a) "doesn't match" (show b)  -- | Is @a@ unlike @b@? unlike :: (Show a, Show b, Likeable a b, Monad m) => a -> b -> TestSimpleT m Bool-unlike a b = ok (not $ isLike a b) >>? diagVals "" (quote a) "matches" (quote b)+unlike a b = ok (not $ isLike a b) >>? diagVals "" (show a) "matches" (show b)  -- | Is 'Either' right? isRight :: (Monad m, Show a) => Either a b -> TestSimpleT m Bool isRight (Right _) = ok True-isRight (Left a) = ok False >>? diagVals "got Left:" (quote a) "expected:" "Right"+isRight (Left a) = ok False >>? diagVals "got Left:" (show a) "expected:" "Right"  -- | Outputs diagnostics message. diag :: Monad m => String -> TestSimpleT m ()@@ -224,3 +223,11 @@ qcTestSimpleMain m = do     res <- quickCheckResult m     unless (isSuccess res) exitFailure++-- | Generates and logs (through 'diag') arbitrary value. Also outputs current location.+diagen :: Show a => String -> Gen a -> TestSimpleT Gen a+diagen msg gen = do+    a <- lift gen+    s <- get+    diag $ concat [ msg, ": ", show a, showLoc s ]+    return a
test-simple.cabal view
@@ -1,5 +1,5 @@ Name:                test-simple-Version:             0.1.3+Version:             0.1.4 License:             BSD3 License-File:        COPYING Copyright:           Boris Sukholitko, 2012
tests/Main.hs view
@@ -7,7 +7,7 @@ import Control.Monad.Trans (liftIO, lift) import System.Exit (ExitCode(ExitSuccess)) import Control.Monad (guard)-import Test.QuickCheck (Gen, arbitrary)+import Test.QuickCheck (Gen, arbitrary, choose)  locTest :: TestSimpleT IO Bool locTest = $loc >> ok False@@ -38,20 +38,20 @@ testIsFailure :: ExitCode -> String -> String -> TestSimpleT IO Bool testIsFailure ec _ err = do     isnt ec ExitSuccess-    like err "     got: '1'\n"-    like err "expected: '2'\n"+    like err "     got: 1\n"+    like err "expected: 2\n"  testLikeFailure :: ExitCode -> String -> String -> TestSimpleT IO Bool testLikeFailure ec _ err = do     isnt ec ExitSuccess-    like err "#               '\"a\"'\n"-    like err "# doesn't match '\"b\"'\n"+    like err "#               \"a\"\n"+    like err "# doesn't match \"b\"\n"  testUnlikeFailure :: ExitCode -> String -> String -> TestSimpleT IO Bool testUnlikeFailure ec _ err = do     isnt ec ExitSuccess-    like err "#         '\"abc\"'"-    like err "# matches '\"b\"'\n"+    like err "#         \"abc\""+    like err "# matches \"b\"\n"  testLocationPrint :: ExitCode -> String -> String -> TestSimpleT IO Bool testLocationPrint ec _ err = do@@ -76,7 +76,7 @@     isnt ec ExitSuccess     like out "1..1"     unlike err "DIAG"-    like err "#      got: '1'\n"+    like err "#      got: 1\n"     like err "# expected: anything else\n"  testEither :: ExitCode -> String -> String -> TestSimpleT IO Bool@@ -84,7 +84,7 @@     isnt ec ExitSuccess     like out "1..2"     like out "ok 1"-    like err "got Left: '\"badleft\"'"+    like err "got Left: \"badleft\""  testRunTS :: ExitCode -> String -> String -> TestSimpleT IO Bool testRunTS ec out err = do@@ -98,14 +98,15 @@     is out "+++ OK, passed 100 tests.\n"  testQCFail :: ExitCode -> String -> String -> TestSimpleT IO Bool-testQCFail ec out err = do+testQCFail ec out _ = do     isnt ec ExitSuccess-    like err "not ok 1"-    like out "Failed! 1..1"+    like out "not ok 2"+    like out "Failed! 1..2"+    like out "# Foo: False at unknown location."  testAll :: IO () testAll = testSimpleMain $ do-    plan 52+    plan 53     pn <- liftIO getExecutablePath     mapM_ (runMyself pn) [ ("bbbf", testUnknown), ("ok1", testOk1), ("nok1", testNOk1)                 , ("mism", testMismatch), ("isf", testIsFailure)@@ -123,8 +124,10 @@  failQC :: TestSimpleT Gen Bool failQC = do-    plan 1-    b <- lift arbitrary+    plan 2+    i <- lift $ choose (1 :: Int, 5)+    ok (i > 0)+    b <- diagen "Foo" arbitrary     ok b  main :: IO ()