tasty-dejafu 0.3.0.1 → 0.3.0.2

raw patch · 2 files changed

+54/−29 lines, 2 filesdep ~dejafuPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: dejafu

API changes (from Hackage documentation)

Files

• Test/Tasty/DejaFu.hs +52/−27
• tasty-dejafu.cabal +2/−2

@@ -10,8 +10,16 @@ {-# LANGUAGE ImpredicativeTypes #-} #endif --- | This module allows using Deja Fu predicates with Tasty to test--- the behaviour of concurrent systems.+-- |+-- Module      : Test.Tasty.DejaFu+-- Copyright   : (c) 2016 Michael Walker+-- License     : MIT+-- Maintainer  : Michael Walker <mike@barrucadu.co.uk>+-- Stability   : stable+-- Portability : CPP, FlexibleInstances, GADTs, ImpredicativeTypes, RankNTypes, TypeSynonymInstances+--+-- This module allows using Deja Fu predicates with Tasty to test the+-- behaviour of concurrent systems. module Test.Tasty.DejaFu   ( -- * Unit testing @@ -47,49 +55,66 @@   , MemType(..)   ) where +import Control.Monad.ST (runST) import Data.Char (toUpper) import Data.List (intercalate, intersperse) import Data.Proxy (Proxy(..)) import Data.Tagged (Tagged(..)) import Data.Typeable (Typeable) import Test.DejaFu-import Test.DejaFu.Deterministic (ConcST, ConcIO, Trace, ThreadId, ThreadAction, Lookahead, showFail, showTrace)-import Test.DejaFu.SCT (sctBound, sctBoundIO)+import qualified Test.DejaFu.SCT as SCT import Test.Tasty (TestName, TestTree, testGroup) import Test.Tasty.Options (OptionDescription(..), IsOption(..), lookupOption) import Test.Tasty.Providers (IsTest(..), singleTest, testPassed, testFailed) +#if MIN_VERSION_dejafu(0,4,0)+import qualified Test.DejaFu.Conc as Conc+#else+import qualified Test.DejaFu.Deterministic as Conc+#endif+ -- Can't put the necessary forall in the @IsTest ConcST t@ -- instance :( import Unsafe.Coerce (unsafeCoerce)  #if MIN_VERSION_dejafu(0,3,0)-type Trc = Trace ThreadId ThreadAction Lookahead+type Trc = Conc.Trace Conc.ThreadId Conc.ThreadAction Conc.Lookahead #else-type Trc = Trace+type Trc = Conc.Trace #endif +sctBoundST :: MemType -> Bounds -> (forall t. Conc.ConcST t a) -> [(Either Failure a, Trc)]+sctBoundIO :: MemType -> Bounds -> Conc.ConcIO a -> IO [(Either Failure a, Trc)]++#if MIN_VERSION_dejafu(0,4,0)+sctBoundST memtype cb conc = runST (SCT.sctBound memtype cb conc)+sctBoundIO = SCT.sctBound+#else+sctBoundST = SCT.sctBound+sctBoundIO = SCT.sctBoundIO+#endif+ -------------------------------------------------------------------------------- -- Unit testing -instance Typeable t => IsTest (ConcST t (Maybe String)) where+instance Typeable t => IsTest (Conc.ConcST t (Maybe String)) where   testOptions = Tagged concOptions    run options conc callback = do     let memtype = lookupOption options :: MemType     let bounds  = lookupOption options :: Bounds-    let sctBound' :: ConcST t (Maybe String) -> [(Either Failure (Maybe String), Trc)]-        sctBound' = unsafeCoerce $ sctBound memtype bounds+    let sctBound' :: Conc.ConcST t (Maybe String) -> [(Either Failure (Maybe String), Trc)]+        sctBound' = unsafeCoerce $ sctBoundST memtype bounds     let traces = sctBound' conc     run options (ConcTest traces assertableP) callback -instance IsTest (ConcIO (Maybe String)) where+instance IsTest (Conc.ConcIO (Maybe String)) where   testOptions = Tagged concOptions    run options conc callback = do     let memtype = lookupOption options     let bounds  = lookupOption options-    let traces = sctBoundIO memtype bounds conc+    let traces  = sctBoundIO memtype bounds conc     run options (ConcIOTest traces assertableP) callback  concOptions :: [OptionDescription]@@ -129,7 +154,7 @@ -- 'MonadConc'. If you need to test something which also uses -- 'MonadIO', use 'testAutoIO'. testAuto :: (Eq a, Show a)-  => (forall t. ConcST t a)+  => (forall t. Conc.ConcST t a)   -- ^ The computation to test   -> TestTree testAuto = testAuto' defaultMemType@@ -139,17 +164,17 @@ testAuto' :: (Eq a, Show a)   => MemType   -- ^ The memory model to use for non-synchronised @CRef@ operations.-  -> (forall t. ConcST t a)+  -> (forall t. Conc.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 :: (Eq a, Show a) => Conc.ConcIO a -> TestTree testAutoIO = testAutoIO' defaultMemType  -- | Variant of 'testAuto'' for computations which do 'IO'.-testAutoIO' :: (Eq a, Show a) => MemType -> ConcIO a -> TestTree+testAutoIO' :: (Eq a, Show a) => MemType -> Conc.ConcIO a -> TestTree testAutoIO' memtype concio = testDejafusIO' memtype defaultBounds  concio autocheckCases  -- | Predicates for the various autocheck functions.@@ -162,7 +187,7 @@  -- | Check that a predicate holds. testDejafu :: Show a-  => (forall t. ConcST t a)+  => (forall t. Conc.ConcST t a)   -- ^ The computation to test   -> TestName   -- ^ The name of the test.@@ -178,7 +203,7 @@   -- ^ The memory model to use for non-synchronised @CRef@ operations.   -> Bounds   -- ^ The schedule bounds.-  -> (forall t. ConcST t a)+  -> (forall t. Conc.ConcST t a)   -- ^ The computation to test   -> TestName   -- ^ The name of the test.@@ -191,7 +216,7 @@ -- 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)+  => (forall t. Conc.ConcST t a)   -- ^ The computation to test   -> [(TestName, Predicate a)]   -- ^ The list of predicates (with names) to check@@ -205,7 +230,7 @@   -- ^ The memory model to use for non-synchronised @CRef@ operations.   -> Bounds   -- ^ The schedule bounds.-  -> (forall t. ConcST t a)+  -> (forall t. Conc.ConcST t a)   -- ^ The computation to test   -> [(TestName, Predicate a)]   -- ^ The list of predicates (with names) to check@@ -213,19 +238,19 @@ testDejafus' = testst  -- | Variant of 'testDejafu' for computations which do 'IO'.-testDejafuIO :: Show a => ConcIO a -> TestName -> Predicate a -> TestTree+testDejafuIO :: Show a => Conc.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' :: Show a => MemType -> Bounds -> Conc.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 :: Show a => Conc.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' :: Show a => MemType -> Bounds -> Conc.ConcIO a -> [(TestName, Predicate a)] -> TestTree testDejafusIO' = testio  --------------------------------------------------------------------------------@@ -255,7 +280,7 @@     return $ if null err then testPassed "" else testFailed err  -- | Produce a Tasty 'TestTree' from a Deja Fu test.-testst :: Show a => MemType -> Bounds -> (forall t. ConcST t a) -> [(TestName, Predicate a)] -> TestTree+testst :: Show a => MemType -> Bounds -> (forall t. Conc.ConcST t a) -> [(TestName, Predicate a)] -> TestTree testst memtype cb conc tests = case map toTest tests of   [t] -> t   ts  -> testGroup "Deja Fu Tests" ts@@ -263,10 +288,10 @@   where     toTest (name, p) = singleTest name $ ConcTest traces p -    traces = sctBound memtype cb conc+    traces = sctBoundST 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 :: Show a => MemType -> Bounds -> Conc.ConcIO a -> [(TestName, Predicate a)] -> TestTree testio memtype cb concio tests = case map toTest tests of   [t] -> t   ts  -> testGroup "Deja Fu Tests" ts@@ -287,7 +312,7 @@    msg = if null (_failureMsg res) then "" else _failureMsg res ++ "\n" -  failures = intersperse "" . map (\(r, t) -> indent $ either showFail show r ++ " " ++ showTrace t) . take 5 $ _failures res+  failures = intersperse "" . map (\(r, t) -> indent $ either Conc.showFail show r ++ " " ++ Conc.showTrace t) . take 5 $ _failures res    rest = if moreThan (_failures res) 5 then "\n\t..." else "" 

@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/  name:                tasty-dejafu-version:             0.3.0.1+version:             0.3.0.2 synopsis:            Deja Fu support for the Tasty test framework.  description:@@ -40,7 +40,7 @@   -- other-modules:          -- other-extensions:       build-depends:       base   >=4.8  && <5-                     , dejafu >=0.2  && <0.4+                     , dejafu >=0.2  && <0.5                      , tagged >=0.8  && <0.9                      , tasty  >=0.10 && <0.12   -- hs-source-dirs: