tdd-util 0.2.0.3 → 0.3.0.0
raw patch · 3 files changed
+91/−10 lines, 3 filesdep +bytestringdep +system-posix-redirect
Dependencies added: bytestring, system-posix-redirect
Files
- src/Test/Util.hs +56/−7
- tdd-util.cabal +6/−2
- testsrc/Test/Test/Util.hs +29/−1
src/Test/Util.hs view
@@ -19,6 +19,10 @@ , timeoutProcessMicroseconds , assertProcessMicroseconds + -- * Catching stdout/stderr+ , catchStdout+ , catchStderr+ -- * Exceptions , TestUtilException(..) , testUtilExceptionToException@@ -33,18 +37,21 @@ import Control.Monad.CatchIO as M import Control.Monad.IO.Class import Control.Lens.TH+import qualified Data.ByteString as L import Data.Dynamic import Data.Maybe import Data.Proxy import Data.Time.Clock import System.Exit+import System.Posix.Redirect import System.Process import System.Timeout (timeout) import Text.Printf import Test.Util.Framework ---- Throwing and catching exceptions ---+----------------------------------------------------------------+-- Throwing and catching exceptions --- -- | Determine whether an exception was caught, and return it if so. isExceptionThrown :: (Functor m, MonadCatchIO m, Exception e) => m a -> m (Either e a)@@ -57,7 +64,11 @@ -- default string, is output. -- -- For more control, see the more fundamental 'isExceptionThrown'.-assertThrown :: (Functor m, MonadCatchIO m, Exception e, Show e) => Maybe String -> Proxy e -> m () -> m ()+assertThrown :: (Functor m, MonadCatchIO m, Exception e, Show e) =>+ Maybe String -- ^ Optional error message.+ -> Proxy e -- ^ Type of exception to test for.+ -> m ()+ -> m () assertThrown ms ep m = do either (\e -> flip const (e `asProxyTypeOf` ep) $ return ()) (const . liftIO $ assertString s) =<< isExceptionThrown m where s = fromMaybe "exception NOT thrown" ms@@ -73,11 +84,11 @@ either (liftIO . assertString . sf) (const $ return ()) =<< isExceptionThrown m where sf = fromMaybe (\e -> printf "exception thrown: %s" (show e)) msf ----- Concurrent TDD ----+----------------------------------------------------------------+-- Concurrent TDD ---- Process timing ---+----------------------------------------------------------------+-- Process timing -- | Time a computation. timeMicroseconds :: (Monad m, MonadIO m) => m a -> m (a, Integer)@@ -135,7 +146,45 @@ assertProcessMicroseconds us ph = do maybe (throwIO $ TimeLimitExceeded Nothing "assertProcessMicroseconds" us) (const $ return ()) =<< timeoutProcessMicroseconds us ph ---- Exceptions ---+----------------------------------------------------------------+-- Catching stdout/stderr++-- | A wrapper around @system-posix-riderct@'s redirectStdout to redirect+-- stdout during the execution of a+-- computation and capture the output, restoring the handle upon completion.+-- This may be useful for writing unit tests against some parts of a program+-- that interface with the outside world, such as logging and the CLI frontend.+--+-- NB: Since the standard file streams are redirected into a 'Knob', all tests+-- that invoke 'catchHandle' must be run in isolation from each other, since+-- only one test can read the handle's output at a time. The author recommends+-- structuring tests such that all such tests under a test tree that uses+-- test-framework's 'mutuallyExclusive' function and whose child nodes all do+-- the same. Both 'stdout' and 'stderr' can be captured at the same time,+-- however.+catchStdout :: IO a -> IO (a, L.ByteString)+catchStdout m = swp <$> redirectStdout m+ where swp (a, b) = (b, a)++-- | A wrapper around @system-posix-riderct@'s redirectStderr to redirect+-- stdout during the execution of a+-- computation and capture the output, restoring the handle upon completion.+-- This may be useful for writing unit tests against some parts of a program+-- that interface with the outside world, such as logging and the CLI frontend.+--+-- NB: Since the standard file streams are redirected into a 'Knob', all tests+-- that invoke 'catchHandle' must be run in isolation from each other, since+-- only one test can read the handle's output at a time. The author recommends+-- structuring tests such that all such tests under a test tree that uses+-- test-framework's 'mutuallyExclusive' function and whose child nodes all do+-- the same. Both 'stdout' and 'stderr' can be captured at the same time,+-- however.+catchStderr :: IO a -> IO (a, L.ByteString)+catchStderr m = swp <$> redirectStderr m+ where swp (a, b) = (b, a)++----------------------------------------------------------------+-- Exceptions -- | A class of exceptions for "Tests.Util". data TestUtilException where
tdd-util.cabal view
@@ -1,5 +1,5 @@ name: tdd-util-version: 0.2.0.3+version: 0.3.0.0 cabal-version: >= 1.10 build-type: Simple license: BSD3@@ -260,6 +260,8 @@ ,time ,parallel-io ,MonadCatchIO-transformers+ ,bytestring+ ,system-posix-redirect ,HUnit ,test-framework ,test-framework-hunit@@ -295,6 +297,8 @@ ,time ,parallel-io ,MonadCatchIO-transformers+ ,bytestring+ ,system-posix-redirect ,HUnit ,test-framework ,test-framework-hunit@@ -314,4 +318,4 @@ source-repository head type: git location: git://github.com/bairyn/tdd-util.git- tag: 0.2.0.3+ tag: 0.3.0.0
testsrc/Test/Test/Util.hs view
@@ -8,11 +8,13 @@ import Control.Monad import Data.Maybe import Data.Proxy+import Data.String+import System.IO import System.Process import Text.Printf import Test.Util-import Test.Util.Framework+import Test.Util.Framework hiding (output) newtype ShowableIO a = ShowableIO (IO a) @@ -134,6 +136,7 @@ assertNotThrown (Nothing :: Maybe (TimeLimitExceeded -> String)) $ do assertProcessMicroseconds cap =<< sleepM ]+ , mutuallyExclusive . testGroup "catching output" $ redirectTests ] where cushion :: Integer cushion = 20000@@ -156,3 +159,28 @@ , create_group = False } return ph++-- | Group with 'mutuallyExclusive'.+redirectTests :: [TTest]+redirectTests =+ [ testCase "catchStdout catches the output of Hello World" $ do+ output <- snd <$> catchStdout helloWorld+ fromString "Hello, World!\n" @=? output+ , testCase "catchStderr catches the output of a program that prints to stderr" $ do+ output <- snd <$> catchStderr helloWorldErr+ fromString "Hello, World!\n" @=? output+ , testCase "catchStdout behaves correctly with exceptions, a test in the middle of other redirectHandle tests" $ do+ assertThrown Nothing (Proxy :: Proxy IOError) $ do+ output <- snd <$> catchStdout (throwIO . userError $ "User error!")+ fromString "This is not the output." @=? output+ , testCase "no stderr is received from hellowWorld" $ do+ output <- snd <$> catchStderr helloWorld+ fromString "" @=? output+ , testCase "no stdout is received from hellowWorldErr" $ do+ output <- snd <$> catchStdout helloWorldErr+ fromString "" @=? output+ ]+ where helloWorld :: IO ()+ helloWorld = putStrLn "Hello, World!"+ helloWorldErr :: IO ()+ helloWorldErr = hPutStrLn stderr "Hello, World!"