test-simple (empty) → 0.1
raw patch · 5 files changed
+350/−0 lines, 5 filesdep +basedep +executable-pathdep +mtlsetup-changed
Dependencies added: base, executable-path, mtl, process, state-plus, template-haskell, test-simple
Files
- COPYING +25/−0
- Setup.hs +5/−0
- src/Test/Simple.hs +179/−0
- test-simple.cabal +28/−0
- tests/Main.hs +113/−0
+ COPYING view
@@ -0,0 +1,25 @@+Copyright (c) 2012 Boris Sukholitko+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:+1. Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.+2. Redistributions in binary form must reproduce the above copyright+ notice, this list of conditions and the following disclaimer in the+ documentation and/or other materials provided with the distribution.+3. The names of the authors may not be used to endorse or promote products+ derived from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR+IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES+OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.+IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY DIRECT, INDIRECT,+INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT+NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF+THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.+
+ Setup.hs view
@@ -0,0 +1,5 @@+module Main where++import Distribution.Simple++main = defaultMain
+ src/Test/Simple.hs view
@@ -0,0 +1,179 @@+{-# LANGUAGE GeneralizedNewtypeDeriving, MultiParamTypeClasses, TemplateHaskell #-}+----------------------------------------------------------------------+-- |+-- Module : Test.Simple+-- Copyright : (c) Boris Sukholitko 2012+-- License : BSD3+-- +-- Maintainer : boriss@gmail.com+-- Stability : experimental+-- +-- 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+-- usage is optional and is needed for test failure locations only.+--+-- @+--{-\# LANGUAGE TemplateHaskell \#-}+--+--import Test.Simple+--import Control.Monad+--+--main :: IO ()+--main = testSimpleMain $ do+-- plan 7+-- ok True+-- is 1 1+-- isnt \"a\" \"b\"+-- like \"abcd\" \"bc\"+-- unlike \"a\" \"b\"+-- diag \"Successful so far, failures follow ...\"+-- $loc >> ok False \-\- location will be recorded+-- is \"a\" \"b\" >>= guard+-- diag \"I am not being called\" \-\- not reached because of the guard: MonadPlus FTW!+-- @+--+----------------------------------------------------------------------++module Test.Simple (+ -- * Types+ TestSimpleT, Likeable(isLike),+ + -- * Main+ testSimpleMain,+ + -- * Plan+ plan,++ -- * Test functions+ ok, isnt, is, like, unlike,++ -- * Diagnostics+ loc, diag) where++import Control.Monad.Trans.State.Plus+import Control.Monad.State+import System.Exit (exitFailure)+import Data.List (isInfixOf)+import System.IO (hPutStrLn, stderr)+import qualified Language.Haskell.TH as TH++-- | Is used in 'like', 'unlike' tests.+class Likeable a b where+ -- | Returns 'True' if @a@ is like @b@+ isLike :: a -> b -> Bool++instance Eq a => Likeable [a] [a] where+ isLike = flip isInfixOf++data TSOutput = StdOut String | StdErr String+data TSState = TSS { tsCounter :: Int, tsFailed :: Int, tsPlanned :: Int, tsLoc :: Maybe TH.Loc+ , tsOutput :: [TSOutput] }++-- | Test.Simple is implemented as monad transformer.+newtype TestSimpleT m a = MkTST { unTST :: StatePlusT TSState m a }+ deriving (Functor, MonadTrans, Monad, MonadPlus+ , MonadState TSState, MonadIO)++emptyState :: TSState+emptyState = TSS 0 0 0 Nothing []++-- | 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+ 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+ where printLine (StdOut s) = putStrLn s+ printLine (StdErr s) = hPutStrLn stderr s++-- | Is @Bool@ ok?+ok :: Monad m => Bool -> TestSimpleT m Bool+ok b = do+ s <- get+ let oks = "ok " ++ show (tsCounter s + 1)+ put $ s { tsCounter = (tsCounter s) + 1+ , 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)+ 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."++(>>?) :: 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 ]+ diag $ concat [ bs, " ", b ]+ where spaces = take (length bs - length as) $ cycle " "++-- | 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"++-- | 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@ 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)++-- | 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)++-- | Outputs diagnostics message.+diag :: Monad m => String -> TestSimpleT m ()+diag s = modify (\st -> st { tsOutput = (StdErr $ "# " ++ s):(tsOutput st) })++-- | Sets expected number of tests. Running more or less tests is considered failure.+-- Note, that plans are composable, e.g:+--+-- @+-- (plan 1 >> ok True) >> (plan 1 >> ok True)+-- @+--+-- will expect 2 tests.+plan :: Monad m => Int -> TestSimpleT m ()+plan i = modify (\st -> st { tsPlanned = tsPlanned st + i })++-- | Records current location to output in case of failures.+-- Necessary caveat: failing later without updating location produces the last location recorded.+loc :: TH.Q TH.Exp+loc = do+ l <- TH.location+ let ql = liftLoc l+ [| modify (\s -> s { tsLoc = Just $ql }) |]++liftLoc :: TH.Loc -> TH.Q TH.Exp+liftLoc l = [| TH.Loc f p m s e |] where+ f = TH.loc_filename l+ p = TH.loc_package l+ m = TH.loc_module l+ s = TH.loc_start l+ e = TH.loc_end l
+ test-simple.cabal view
@@ -0,0 +1,28 @@+Name: test-simple+Version: 0.1+License: BSD3+License-File: COPYING+Copyright: Boris Sukholitko, 2012+Author: Boris Sukholitko+Maintainer: boriss@gmail.com+Cabal-version: >= 1.8+Build-type: Simple+Category: Testing+Synopsis: Simple Perl inspired testing +Description:+ Test.Simple provides simple, Perl inspired primitives for easy testing. It outputs test+ results in TAP format.++library + build-depends: base < 5, mtl, template-haskell, state-plus+ 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+ ghc-options: -Wall+ hs-source-dirs: tests+ main-is: Main.hs+
+ tests/Main.hs view
@@ -0,0 +1,113 @@+{-# LANGUAGE TemplateHaskell #-}+{-# OPTIONS_GHC -fno-warn-unused-do-bind #-}+import Test.Simple+import System.Environment (getArgs)+import System.Environment.Executable (getExecutablePath)+import System.Process (readProcessWithExitCode)+import Control.Monad.Trans (liftIO)+import System.Exit (ExitCode(ExitSuccess))+import Control.Monad (guard)++locTest :: TestSimpleT IO Bool+locTest = $loc >> ok False++testOk1 :: ExitCode -> String -> String -> TestSimpleT IO Bool+testOk1 ec out err = do+ is ec ExitSuccess+ is out "1..1\nok 1\n"+ is err ""++testUnknown :: ExitCode -> String -> String -> TestSimpleT IO Bool+testUnknown ec out err = do+ isnt ec ExitSuccess+ is out ""+ like err "Unknown"++testNOk1 :: ExitCode -> String -> String -> TestSimpleT IO Bool+testNOk1 ec out err = do+ isnt ec ExitSuccess+ like out "not ok 1"+ like err "# Hello\n"++testMismatch :: ExitCode -> String -> String -> TestSimpleT IO Bool+testMismatch ec _ err = do+ isnt ec ExitSuccess+ is err "# Looks like you planned 2 tests but ran 1.\n"++testIsFailure :: ExitCode -> String -> String -> TestSimpleT IO Bool+testIsFailure ec _ err = do+ isnt ec ExitSuccess+ 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"++testUnlikeFailure :: ExitCode -> String -> String -> TestSimpleT IO Bool+testUnlikeFailure ec _ err = do+ isnt ec ExitSuccess+ like err "# '\"abc\"'"+ like err "# matches '\"b\"'\n"++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 "# Looks like you failed 1 test of 1.\n"++testMPlus :: ExitCode -> String -> String -> TestSimpleT IO Bool+testMPlus ec out err = do+ is ec ExitSuccess+ is err ""+ like out "1..2"++testMPlusFail :: ExitCode -> String -> String -> TestSimpleT IO Bool+testMPlusFail ec out err = do+ isnt ec ExitSuccess+ like err "failed 1 test of 2"+ like out "1..2"++testGuard :: ExitCode -> String -> String -> TestSimpleT IO Bool+testGuard ec out err = do+ isnt ec ExitSuccess+ like out "1..1"+ unlike err "DIAG"+ like err "# got: '1'\n"+ like err "# expected: anything else\n"++testAll :: IO ()+testAll = testSimpleMain $ do+ plan 40+ 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) ]+ where runMyself pn (arg, act) = do+ (ec, out, err) <- liftIO $ readProcessWithExitCode pn [ arg ] ""+ act ec out err++main :: IO ()+main = do+ as <- getArgs+ case as of+ [] -> testAll+ [ "ok1" ] -> testSimpleMain $ plan 1 >> ok True+ [ "nok1" ] -> testSimpleMain $ plan 1 >> diag "Hello" >> ok False+ [ "mism" ] -> testSimpleMain $ ok True >> plan 2+ [ "isf" ] -> testSimpleMain $ is 1 (2::Int) >> plan 1+ [ "likef" ] -> testSimpleMain $ plan 1 >> like "a" "b"+ [ "qloc" ] -> testSimpleMain $ plan 1 >> locTest+ [ "unlike" ] -> testSimpleMain $ plan 1 >> unlike "abc" "d"+ [ "fail_unlike" ] -> testSimpleMain $ unlike "abc" "b"+ [ "guard" ] -> testSimpleMain $ plan 1 >> ok True >> guard False >> ok False+ [ "mplus" ] -> testSimpleMain $ (plan 1 >> ok True) >> (plan 1 >> ok True)+ [ "fail_mplus" ] -> testSimpleMain $ (plan 1 >> ok False) >> (plan 1 >> ok True)+ [ "guardisnt" ] -> testSimpleMain $ plan 1 >> (isnt (1::Int) 1 >>= guard) >> diag "DIAG"+ _ -> error $ "Unknown: " ++ show as+