packages feed

tasty-dejafu (empty) → 0.2.0.0

raw patch · 4 files changed

+276/−0 lines, 4 filesdep +basedep +dejafudep +tastysetup-changed

Dependencies added: base, dejafu, tasty

Files

+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2015, Michael Walker <mike@barrucadu.co.uk>++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be+included in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE+LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION+OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION+WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ Test/Tasty/DejaFu.hs view
@@ -0,0 +1,213 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE GADTs              #-}+{-# LANGUAGE RankNTypes         #-}++-- | This module allows using Deja Fu predicates with Tasty to test+-- the behaviour of concurrent systems.+module Test.Tasty.DejaFu+  ( -- * Testing+    testAuto+  , testDejafu+  , testDejafus+  , testAutoIO+  , testDejafuIO+  , testDejafusIO++  -- * Testing under Alternative Memory Models+  , MemType(..)+  , testAuto'+  , testAutoIO'+  , testDejafu'+  , testDejafus'+  , testDejafuIO'+  , testDejafusIO'+  ) where++import Data.Typeable (Typeable)+import Test.DejaFu+import Test.DejaFu.Deterministic (ConcST, ConcIO, Trace, showFail, showTrace)+import Test.DejaFu.SCT (sctBound, sctBoundIO)+import Test.Tasty (TestName, TestTree, testGroup)+import Test.Tasty.Providers (IsTest(..), singleTest, testPassed, testFailed)++--------------------------------------------------------------------------------+-- Automated testing++-- | Automatically test a computation. In particular, look for+-- deadlocks, uncaught exceptions, and multiple return values.+-- +-- This uses the 'Conc' monad for testing, which is an instance of+-- 'MonadConc'. If you need to test something which also uses+-- 'MonadIO', use 'testAutoIO'.+testAuto :: (Eq a, Show a)+  => (forall t. ConcST t a)+  -- ^ The computation to test+  -> TestTree+testAuto = testAuto' defaultMemType++-- | Variant of 'testAuto' which tests a computation under a given+-- memory model.+testAuto' :: (Eq a, Show a)+  => MemType+  -- ^ The memory model to use for non-synchronised @CRef@ operations.+  -> (forall t. ConcST t a)+  -- ^ The computation to test+  -> TestTree+testAuto' memtype conc = testDejafus' memtype defaultBounds conc autocheckCases++-- | Variant of 'testAuto' for computations which do 'IO'.+testAutoIO :: (Eq a, Show a) => ConcIO a -> TestTree+testAutoIO = testAutoIO' defaultMemType++-- | Variant of 'testAuto'' for computations which do 'IO'.+testAutoIO' :: (Eq a, Show a) => MemType -> ConcIO a -> TestTree+testAutoIO' memtype concio = testDejafusIO' memtype defaultBounds  concio autocheckCases++-- | Predicates for the various autocheck functions.+autocheckCases :: Eq a => [(TestName, Predicate a)]+autocheckCases =+  [("Never Deadlocks", representative deadlocksNever)+  , ("No Exceptions", representative exceptionsNever)+  , ("Consistent Result", alwaysSame)+  ]++--------------------------------------------------------------------------------+-- Manual testing++-- | Check that a predicate holds.+testDejafu :: Show a+  => (forall t. ConcST t a)+  -- ^ The computation to test+  -> TestName+  -- ^ The name of the test.+  -> Predicate a+  -- ^ The predicate to check+  -> TestTree+testDejafu = testDejafu' defaultMemType defaultBounds++-- | Variant of 'testDejafu' which takes a memory model and+-- pre-emption bound.+testDejafu' :: Show a+  => MemType+  -- ^ The memory model to use for non-synchronised @CRef@ operations.+  -> Bounds+  -- ^ The schedule bounds.+  -> (forall t. ConcST t a)+  -- ^ The computation to test+  -> TestName+  -- ^ The name of the test.+  -> Predicate a+  -- ^ The predicate to check+  -> TestTree+testDejafu' memtype cb conc name p = testDejafus' memtype cb conc [(name, p)]++-- | Variant of 'testDejafu' which takes a collection of predicates to+-- test. This will share work between the predicates, rather than+-- running the concurrent computation many times for each predicate.+testDejafus :: Show a+  => (forall t. ConcST t a)+  -- ^ The computation to test+  -> [(TestName, Predicate a)]+  -- ^ The list of predicates (with names) to check+  -> TestTree+testDejafus = testDejafus' defaultMemType defaultBounds++-- | Variant of 'testDejafus' which takes a memory model and pre-emption+-- bound.+testDejafus' :: Show a+  => MemType+  -- ^ The memory model to use for non-synchronised @CRef@ operations.+  -> Bounds+  -- ^ The schedule bounds.+  -> (forall t. ConcST t a)+  -- ^ The computation to test+  -> [(TestName, Predicate a)]+  -- ^ The list of predicates (with names) to check+  -> TestTree+testDejafus' = test++-- | Variant of 'testDejafu' for computations which do 'IO'.+testDejafuIO :: Show a => ConcIO a -> TestName -> Predicate a -> TestTree+testDejafuIO = testDejafuIO' defaultMemType defaultBounds++-- | Variant of 'testDejafu'' for computations which do 'IO'.+testDejafuIO' :: Show a => MemType -> Bounds -> ConcIO a -> TestName -> Predicate a -> TestTree+testDejafuIO' memtype cb concio name p = testDejafusIO' memtype cb concio [(name, p)]++-- | Variant of 'testDejafus' for computations which do 'IO'.+testDejafusIO :: Show a => ConcIO a -> [(TestName, Predicate a)] -> TestTree+testDejafusIO = testDejafusIO' defaultMemType defaultBounds++-- | Variant of 'dejafus'' for computations which do 'IO'.+testDejafusIO' :: Show a => MemType -> Bounds -> ConcIO a -> [(TestName, Predicate a)] -> TestTree+testDejafusIO' = testio++--------------------------------------------------------------------------------+-- Tasty integration++data ConcTest where+  ConcTest   :: Show a => [(Either Failure a, Trace)] -> Predicate a -> ConcTest+  deriving Typeable++data ConcIOTest where+  ConcIOTest :: Show a => IO [(Either Failure a, Trace)] -> Predicate a -> ConcIOTest+  deriving Typeable++instance IsTest ConcTest where+  testOptions = return []++  run _ (ConcTest traces p) _ =+    let err = showErr $ p traces+     in return $ if null err then testPassed "" else testFailed err++instance IsTest ConcIOTest where+  testOptions = return []++  run _ (ConcIOTest iotraces p) _ = do+    traces <- iotraces+    let err = showErr $ p traces+    return $ if null err then testPassed "" else testFailed err++-- | Produce a Tasty 'TestTree' from a Deja Fu test.+test :: Show a => MemType -> Bounds -> (forall t. ConcST t a) -> [(TestName, Predicate a)] -> TestTree+test memtype cb conc tests = case map toTest tests of+  [t] -> t+  ts  -> testGroup "Deja Fu Tests" ts++  where+    toTest (name, p) = singleTest name $ ConcTest traces p++    traces = sctBound memtype cb conc++-- | Produce a Tasty 'Test' from an IO-using Deja Fu test.+testio :: Show a => MemType -> Bounds -> ConcIO a -> [(TestName, Predicate a)] -> TestTree+testio memtype cb concio tests = case map toTest tests of+  [t] -> t+  ts  -> testGroup "Deja Fu Tests" ts++  where+    toTest (name, p) = singleTest name $ ConcIOTest traces p++    -- As with HUnit, constructing a test is side-effect free, so+    -- sharing of traces can't happen here.+    traces = sctBoundIO memtype cb concio++-- | Convert a test result into an error message on failure (empty+-- string on success).+showErr :: Show a => Result a -> String+showErr res+  | _pass res = ""+  | otherwise = "Failed after " ++ show (_casesChecked res) ++ " cases:\n" ++ msg ++ unlines failures ++ rest where++  msg = if null (_failureMsg res) then "" else _failureMsg res ++ "\n"++  failures = map (\(r, t) -> "\t" ++ either showFail show r ++ " " ++ showTrace t) . take 5 $ _failures res++  rest = if moreThan (_failures res) 5 then "\n\t..." else ""++-- | Check if a list has more than some number of elements.+moreThan :: [a] -> Int -> Bool+moreThan [] n = n < 0+moreThan _ 0  = True+moreThan (_:xs) n = moreThan xs (n-1)+
+ tasty-dejafu.cabal view
@@ -0,0 +1,41 @@+-- Initial tasty-dejafu.cabal generated by cabal init.  For further +-- documentation, see http://haskell.org/cabal/users-guide/++name:                tasty-dejafu+version:             0.2.0.0+synopsis:            Deja Fu support for the Tasty test framework.++description:+  Integration between the <https://hackage.haskell.org/package/dejafu dejafu>+  library for concurrency testing and+  <https://hackage.haskell.org/package/tasty tasty>. This lets you+  easily incorporate concurrency testing into your existing test+  suites.+  .+  See the <https://github.com/barrucadu/dejafu README> for more+  details.++homepage:            https://github.com/barrucadu/dejafu+license:             MIT+license-file:        LICENSE+author:              Michael Walker+maintainer:          mike@barrucadu.co.uk+-- copyright:           +category:            Testing+build-type:          Simple+-- extra-source-files:  +cabal-version:       >=1.10++source-repository head+  type:     git+  location: https://github.com/barrucadu/dejafu.git++library+  exposed-modules:     Test.Tasty.DejaFu+  -- other-modules:       +  -- other-extensions:    +  build-depends:       base >=4.5 && <5+                     , dejafu == 0.2.*+                     , tasty+  -- hs-source-dirs:      +  default-language:    Haskell2010