diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,20 @@ +Copyright (c) 2015, Michael Walker + +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. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/Test/HUnit/DejaFu.hs b/Test/HUnit/DejaFu.hs new file mode 100644 --- /dev/null +++ b/Test/HUnit/DejaFu.hs @@ -0,0 +1,189 @@ +{-# LANGUAGE RankNTypes #-} + +-- | This module allows using Deja Fu predicates with HUnit to test +-- the behaviour of concurrent systems. +module Test.HUnit.DejaFu + ( -- * Testing + testAuto + , testDejafu + , testDejafus + , testAutoIO + , testDejafuIO + , testDejafusIO + + -- * Testing under Alternative Memory Models + , MemType(..) + , testAuto' + , testAutoIO' + , testDejafu' + , testDejafus' + , testDejafuIO' + , testDejafusIO' + ) where + +import Test.DejaFu +import Test.DejaFu.Deterministic (ConcST, ConcIO, showFail, showTrace) +import Test.DejaFu.SCT (sctBound, sctBoundIO) +import Test.HUnit (Test(..), assertString) + +-------------------------------------------------------------------------------- +-- 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 + -> Test +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 + -> Test +testAuto' memtype conc = testDejafus' memtype defaultBounds conc autocheckCases + +-- | Variant of 'testAuto' for computations which do 'IO'. +testAutoIO :: (Eq a, Show a) => ConcIO a -> Test +testAutoIO = testAutoIO' defaultMemType + +-- | Variant of 'testAuto'' for computations which do 'IO'. +testAutoIO' :: (Eq a, Show a) => MemType -> ConcIO a -> Test +testAutoIO' memtype concio = testDejafusIO' memtype defaultBounds concio autocheckCases + +-- | Predicates for the various autocheck functions. +autocheckCases :: Eq a => [(String, 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 + -> String + -- ^ The name of the test. + -> Predicate a + -- ^ The predicate to check + -> Test +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 bound. + -> (forall t. ConcST t a) + -- ^ The computation to test + -> String + -- ^ The name of the test. + -> Predicate a + -- ^ The predicate to check + -> Test +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 + -> [(String, Predicate a)] + -- ^ The list of predicates (with names) to check + -> Test +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 + -> [(String, Predicate a)] + -- ^ The list of predicates (with names) to check + -> Test +testDejafus' = test + +-- | Variant of 'testDejafu' for computations which do 'IO'. +testDejafuIO :: Show a => ConcIO a -> String -> Predicate a -> Test +testDejafuIO = testDejafuIO' defaultMemType defaultBounds + +-- | Variant of 'testDejafu'' for computations which do 'IO'. +testDejafuIO' :: Show a => MemType -> Bounds -> ConcIO a -> String -> Predicate a -> Test +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 -> [(String, Predicate a)] -> Test +testDejafusIO = testDejafusIO' defaultMemType defaultBounds + +-- | Variant of 'dejafus'' for computations which do 'IO'. +testDejafusIO' :: Show a => MemType -> Bounds -> ConcIO a -> [(String, Predicate a)] -> Test +testDejafusIO' = testio + +-------------------------------------------------------------------------------- +-- HUnit integration + +-- | Produce a HUnit 'Test' from a Deja Fu test. +test :: Show a => MemType -> Bounds -> (forall t. ConcST t a) -> [(String, Predicate a)] -> Test +test memtype cb conc tests = case map toTest tests of + [t] -> t + ts -> TestList ts + + where + toTest (name, p) = TestLabel name . TestCase $ + assertString . showErr $ p traces + + traces = sctBound memtype cb conc + +-- | Produce a HUnit 'Test' from an IO-using Deja Fu test. +testio :: Show a => MemType -> Bounds -> ConcIO a -> [(String, Predicate a)] -> Test +testio memtype cb concio tests = case map toTest tests of + [t] -> t + ts -> TestList ts + + where + toTest (name, p) = TestLabel name . TestCase $ do + -- Sharing of traces probably not possible (without something + -- really unsafe) here, as 'test' doesn't allow side-effects + -- (eg, constructing an 'MVar' to share the traces after one + -- test computed them). + traces <- sctBoundIO memtype cb concio + assertString . showErr $ p traces + +-- | 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) + diff --git a/hunit-dejafu.cabal b/hunit-dejafu.cabal new file mode 100644 --- /dev/null +++ b/hunit-dejafu.cabal @@ -0,0 +1,41 @@ +-- Initial hunit-dejafu.cabal generated by cabal init. For further +-- documentation, see http://haskell.org/cabal/users-guide/ + +name: hunit-dejafu +version: 0.2.0.0 +synopsis: Deja Fu support for the HUnit test framework. + +description: + Integration between the + library for concurrency testing and + . This lets you + easily incorporate concurrency testing into your existing test + suites. + . + See the 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.HUnit.DejaFu + -- other-modules: + -- other-extensions: + build-depends: base >=4.5 && <5 + , dejafu == 0.2.* + , HUnit + -- hs-source-dirs: + default-language: Haskell2010