test-simple 0.1.1 → 0.1.2
raw patch · 3 files changed
+50/−18 lines, 3 files
Files
- src/Test/Simple.hs +36/−15
- test-simple.cabal +1/−1
- tests/Main.hs +13/−2
src/Test/Simple.hs view
@@ -41,7 +41,7 @@ TestSimpleT, Likeable(isLike), -- * Main- testSimpleMain,+ testSimpleMain, runTestSimple, -- * Plan plan,@@ -79,25 +79,46 @@ emptyState :: TSState emptyState = TSS 0 0 0 Nothing [] +finishTS :: Monad m => TestSimpleT m a -> m (Bool, TSState)+finishTS m = do+ ms <- execStatePlusT (unTST m) emptyState+ finState <- execStatePlusT (unTST finish) ms+ return (not $ isFailed finState, finState)+ where+ finish = do+ s <- get+ let failed = tsFailed s > 0+ let mismatch = (tsPlanned s /= tsCounter s)+ if failed+ then diag $ "Looks like you failed " ++ show (tsFailed s)+ ++ " test of " ++ show (tsPlanned s) ++ "."+ else if mismatch+ then diag $ "Looks like you planned " ++ show (tsPlanned s)+ ++ " tests but ran " ++ show (tsCounter s) ++ "."+ else return ()+ modify finOutput+ return $ not (failed || mismatch)+ finOutput s = s { tsOutput = (StdOut $ "1.." ++ show (tsPlanned s)):(reverse $ tsOutput s) }+ isFailed s = tsFailed s > 0 || (tsPlanned s /= tsCounter s)++-- | Runs 'TestSimpleT' transformer. Returns whether the tests where successful and resulting+-- output.+runTestSimple :: Monad m => TestSimpleT m a -> m (Bool, [String])+runTestSimple m = do+ (b, s) <- finishTS m+ return (b, map toStr $ tsOutput s)+ where toStr (StdOut str) = str+ toStr (StdErr str) = str+ -- | Runs 'TestSimpleT' transformer in 'IO'. Outputs results in TAP format. -- Exits with error on test failure. ----- Note, that it was meant for easy integration with exitcode-stdio-1.0 cabal testing.--- Future versions of this library will probably include other, 'IO' independent, test running--- functions. testSimpleMain :: MonadIO m => TestSimpleT m a -> m ()-testSimpleMain (MkTST sm) = do- s <- execStatePlusT sm emptyState+testSimpleMain m = do+ (b, s) <- finishTS m liftIO $ do- putStrLn $ "1.." ++ show (tsPlanned s)- mapM_ printLine $ reverse (tsOutput s)- let mismatch = (tsPlanned s /= tsCounter s)- let failed = tsFailed s > 0;- when mismatch $ hPutStrLn stderr $ "# Looks like you planned " ++ show (tsPlanned s)- ++ " tests but ran " ++ show (tsCounter s) ++ "."- when failed $ hPutStrLn stderr $ "# Looks like you failed " ++ show (tsFailed s)- ++ " test of " ++ show (tsPlanned s) ++ "."- when (failed || mismatch) exitFailure+ mapM_ printLine $ tsOutput s+ unless b exitFailure where printLine (StdOut s) = putStrLn s printLine (StdErr s) = hPutStrLn stderr s
test-simple.cabal view
@@ -1,5 +1,5 @@ Name: test-simple-Version: 0.1.1+Version: 0.1.2 License: BSD3 License-File: COPYING Copyright: Boris Sukholitko, 2012
tests/Main.hs view
@@ -85,16 +85,23 @@ like out "ok 1" like err "got Left: '\"badleft\"'" +testRunTS :: ExitCode -> String -> String -> TestSimpleT IO Bool+testRunTS ec out err = do+ is ec ExitSuccess+ is err ""+ is out "True\n1..1\n# Bar\nok 1\n"+ testAll :: IO () testAll = testSimpleMain $ do- plan 44+ plan 47 pn <- liftIO getExecutablePath mapM_ (runMyself pn) [ ("bbbf", testUnknown), ("ok1", testOk1), ("nok1", testNOk1) , ("mism", testMismatch), ("isf", testIsFailure) , ("likef", testLikeFailure), ("qloc", testLocationPrint) , ("unlike", testOk1), ("fail_unlike", testUnlikeFailure) , ("guard", testOk1), ("mplus", testMPlus), ("fail_mplus", testMPlusFail)- , ("guardisnt", testGuard), ("either", testEither) ]+ , ("guardisnt", testGuard), ("either", testEither)+ , ("runts", testRunTS) ] where runMyself pn (arg, act) = do (ec, out, err) <- liftIO $ readProcessWithExitCode pn [ arg ] "" act ec out err@@ -120,5 +127,9 @@ plan 2 isRight (Right "hhh" :: Either Int String) isRight (Left "badleft" :: Either String Int)+ [ "runts" ] -> do+ (b, lg) <- runTestSimple $ plan 1 >> diag "Bar" >> ok True+ putStrLn $ show b+ mapM_ putStrLn lg _ -> error $ "Unknown: " ++ show as