barrucadu/dejafu
1
1
Fork 0
mirror of https://github.com/barrucadu/dejafu.git synced 2024-12-24 05:55:18 +03:00
Code Issues Projects Releases Wiki Activity

Avoid re-running tests in dejafus. Closes #12.

Browse Source
This commit is contained in:
Michael Walker 2015-02-26 21:57:55 +00:00
parent 9aea975304
commit 6c4015c314
1 changed files with 13 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
Test/DejaFu.hs
View File

@ -85,7 +85,6 @@ module Test.DejaFu
, somewhereTrue2 , somewhereTrue2
) where ) where
import Control.Applicative ((<$>))
import Control.Arrow (first) import Control.Arrow (first)
import Control.DeepSeq (NFData(..)) import Control.DeepSeq (NFData(..))
import Control.Monad (when) import Control.Monad (when)
@ -113,13 +112,15 @@ dejafuIO concio test = dejafusIO concio [test]
-- | Run a collection of tests, returning 'True' if all pass. -- | Run a collection of tests, returning 'True' if all pass.
dejafus :: (Eq a, Show a) => (forall t. Conc t a) -> [(String, Predicate a)] -> IO Bool dejafus :: (Eq a, Show a) => (forall t. Conc t a) -> [(String, Predicate a)] -> IO Bool
dejafus conc tests = do dejafus conc tests = do
results <- mapM (\(name, test) -> doTest name $ runTest test conc) tests let traces = sctPreBound 2 conc
results <- mapM (\(name, test) -> doTest name $ runTest'' test traces) tests
return $ and results return $ and results
-- | Variant of 'dejafus' for computations which do 'IO'. -- | Variant of 'dejafus' for computations which do 'IO'.
dejafusIO :: (Eq a, Show a) => (forall t. ConcIO t a) -> [(String, Predicate a)] -> IO Bool dejafusIO :: (Eq a, Show a) => (forall t. ConcIO t a) -> [(String, Predicate a)] -> IO Bool
dejafusIO concio tests = do dejafusIO concio tests = do
results <- mapM (\(name, test) -> doTest name =<< runTestIO test concio) tests traces <- sctPreBoundIO 2 concio
results <- mapM (\(name, test) -> doTest name $ runTest'' test traces) tests
return $ and results return $ and results
-- | Automatically test a computation. In particular, look for -- | Automatically test a computation. In particular, look for
@ -178,14 +179,18 @@ runTestIO = runTestIO' 2
-- | Variant of 'runTest' which takes a pre-emption bound. -- | Variant of 'runTest' which takes a pre-emption bound.
runTest' :: Eq a => Int -> Predicate a -> (forall t. Conc t a) -> Result a runTest' :: Eq a => Int -> Predicate a -> (forall t. Conc t a) -> Result a
runTest' pb predicate conc = r { _failures = uniques $ _failures r } where runTest' pb predicate conc = runTest'' predicate $ sctPreBound pb conc
r = predicate $ sctPreBound pb conc
-- | Variant of 'runTest'' which takes a list of results.
runTest'' :: Eq a => Predicate a -> [(Either Failure a, Trace)] -> Result a
runTest'' predicate results = r { _failures = uniques $ _failures r } where
r = predicate results
-- | Variant of 'runTest'' for computations which do 'IO'. -- | Variant of 'runTest'' for computations which do 'IO'.
runTestIO' :: Eq a => Int -> Predicate a -> (forall t. ConcIO t a) -> IO (Result a) runTestIO' :: Eq a => Int -> Predicate a -> (forall t. ConcIO t a) -> IO (Result a)
runTestIO' pb predicate conc = do runTestIO' pb predicate conc = do
r <- predicate <$> sctPreBoundIO pb conc results <- sctPreBoundIO pb conc
return $ r { _failures = uniques $ _failures r } return $ runTest'' predicate results
-- | Strip out duplicates -- | Strip out duplicates
uniques :: Eq a => [(a, Trace)] -> [(a, Trace)] uniques :: Eq a => [(a, Trace)] -> [(a, Trace)]