diff --git a/CHANGELOG.markdown b/CHANGELOG.markdown --- a/CHANGELOG.markdown +++ b/CHANGELOG.markdown @@ -7,6 +7,33 @@ *de facto* standard Haskell versioning scheme. +0.6.0.0 [2017-04-08] (git tag: [tasty-dejafu-0.6.0.0][]) +------- + +https://hackage.haskell.org/package/tasty-dejafu-0.6.0.0 + +### Test.Tasty.DejaFu + +- The refinement property testing functionality of dejafu is exposed in the new `testProperty` + function, and re-exported values. +- Due to changes in dejafu, the `Way` type is now abstract and exposes smart constructor functions: + - `systematically`, corresponding to the old `Systematically`. + - `randomly`, corresponding to the old `Randomly`. + - `uniformly`, a new uniform random (as opposed to weighted random) scheduler. + - `swarmy`, corresponding to the old `Randomly` and specifying how many executions to use the + same weights for. +- The `defaultWay`, `defaultMemType`, and `defaultBounds` values are all now re-exported. + +### Miscellaneous + +- Only dejafu 0.7 is supported. + +[tasty-dejafu-0.6.0.0]: https://github.com/barrucadu/dejafu/releases/tag/tasty-dejafu-0.6.0.0 + + +--------------------------------------------------------------------------------------------------- + + 0.5.0.0 [2017-04-08] (git tag: [tasty-dejafu-0.5.0.0][]) ------- diff --git a/Test/Tasty/DejaFu.hs b/Test/Tasty/DejaFu.hs --- a/Test/Tasty/DejaFu.hs +++ b/Test/Tasty/DejaFu.hs @@ -1,4 +1,5 @@ {-# LANGUAGE CPP #-} +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE RankNTypes #-} @@ -16,7 +17,7 @@ -- License : MIT -- Maintainer : Michael Walker -- Stability : stable --- Portability : CPP, FlexibleInstances, GADTs, ImpredicativeTypes, RankNTypes, TypeSynonymInstances +-- Portability : CPP, FlexibleContexts, FlexibleInstances, GADTs, ImpredicativeTypes, RankNTypes, TypeSynonymInstances -- -- This module allows using Deja Fu predicates with Tasty to test the -- behaviour of concurrent systems. @@ -50,31 +51,53 @@ , testDejafuWayIO , testDejafusWayIO - -- * Re-exports - , Way(..) + -- ** Re-exports + , Way + , defaultWay + , systematically + , randomly + , uniformly + , swarmy , Bounds(..) + , defaultBounds , MemType(..) + , defaultMemType + + -- * Refinement property testing + , testProperty + + -- ** Re-exports + , R.Sig(..) + , R.RefinementProperty + , R.Testable(..) + , R.Listable(..) + , R.expectFailure + , R.refines, (R.=>=) + , R.strictlyRefines, (R.->-) + , R.equivalentTo, (R.===) ) 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 System.Random (StdGen, mkStdGen) -import Test.DejaFu -import qualified Test.DejaFu.Conc as Conc -import qualified Test.DejaFu.SCT as SCT -import Test.Tasty (TestName, TestTree, testGroup) -import Test.Tasty.Options (IsOption(..), OptionDescription(..), - lookupOption) -import Test.Tasty.Providers (IsTest(..), singleTest, testFailed, - testPassed) +import Control.Monad.ST (runST) +import Data.Char (toUpper) +import qualified Data.Foldable as F +import Data.List (intercalate, intersperse) +import Data.Proxy (Proxy(..)) +import Data.Tagged (Tagged(..)) +import Data.Typeable (Typeable) +import System.Random (mkStdGen) +import Test.DejaFu hiding (Testable(..)) +import qualified Test.DejaFu.Conc as Conc +import qualified Test.DejaFu.Refinement as R +import qualified Test.DejaFu.SCT as SCT +import Test.Tasty (TestName, TestTree, testGroup) +import Test.Tasty.Options (IsOption(..), OptionDescription(..), + lookupOption) +import Test.Tasty.Providers (IsTest(..), singleTest, testFailed, + testPassed) -- Can't put the necessary forall in the @IsTest ConcST t@ -- instance :( -import Unsafe.Coerce (unsafeCoerce) +import Unsafe.Coerce (unsafeCoerce) runSCTst :: Way -> MemType -> (forall t. Conc.ConcST t a) -> [(Either Failure a, Conc.Trace)] runSCTst way memtype conc = runST (SCT.runSCT way memtype conc) @@ -83,7 +106,7 @@ runSCTio = SCT.runSCT -------------------------------------------------------------------------------- --- Unit testing +-- Tasty-style unit testing -- | @since 0.3.0.0 instance Typeable t => IsTest (Conc.ConcST t (Maybe String)) where @@ -133,14 +156,15 @@ instance IsOption Way where defaultValue = defaultWay parseValue = shortName . map toUpper where - shortName "SYSTEMATICALLY" = Just (Systematically defaultBounds) - shortName "RANDOMLY" = Just (Randomly (mkStdGen 42) 100) + shortName "SYSTEMATICALLY" = Just (systematically defaultBounds) + shortName "RANDOMLY" = Just (randomly (mkStdGen 42) 100) shortName _ = Nothing optionName = Tagged "way" optionHelp = Tagged "The execution method to use. This should be one of \"systematically\" or \"randomly\"." + -------------------------------------------------------------------------------- --- Property testing +-- DejaFu-style unit testing -- | Automatically test a computation. In particular, look for -- deadlocks, uncaught exceptions, and multiple return values. @@ -280,6 +304,23 @@ => Way -> MemType -> Conc.ConcIO a -> [(TestName, Predicate a)] -> TestTree testDejafusWayIO = testio + +------------------------------------------------------------------------------- +-- Refinement property testing + +-- | Check a refinement property with a variety of seed values and +-- variable assignments. +-- +-- @since 0.6.0.0 +testProperty :: (R.Testable p, R.Listable (R.X p), Eq (R.X p), Show (R.X p), Show (R.O p)) + => TestName + -- ^ The name of the test. + -> p + -- ^ The property to check. + -> TestTree +testProperty = testprop + + -------------------------------------------------------------------------------- -- Tasty integration @@ -291,6 +332,10 @@ ConcIOTest :: Show a => IO [(Either Failure a, Conc.Trace)] -> Predicate a -> ConcIOTest deriving Typeable +data PropTest where + PropTest :: (R.Testable p, R.Listable (R.X p), Eq (R.X p), Show (R.X p), Show (R.O p)) => p -> PropTest + deriving Typeable + instance IsTest ConcTest where testOptions = pure [] @@ -306,6 +351,21 @@ let err = showErr $ p traces pure (if null err then testPassed "" else testFailed err) +instance IsTest PropTest where + testOptions = pure [] + + run _ (PropTest p) _ = do + ce <- R.check' p + pure $ case ce of + Just c -> testFailed . init $ unlines + [ "*** Failure: " ++ + (if null (R.failingArgs c) then "" else unwords (R.failingArgs c) ++ " ") ++ + "(seed " ++ show (R.failingSeed c) ++ ")" + , " left: " ++ show (F.toList $ R.leftResults c) + , " right: " ++ show (F.toList $ R.rightResults c) + ] + Nothing -> testPassed "" + -- | Produce a Tasty 'TestTree' from a Deja Fu test. testst :: Show a => Way -> MemType -> (forall t. Conc.ConcST t a) -> [(TestName, Predicate a)] -> TestTree @@ -331,6 +391,11 @@ -- As with HUnit, constructing a test is side-effect free, so -- sharing of traces can't happen here. traces = runSCTio way memtype concio + +-- | Produce a Tasty 'TestTree' from a Deja Fu refinement property test. +testprop :: (R.Testable p, R.Listable (R.X p), Eq (R.X p), Show (R.X p), Show (R.O p)) + => TestName -> p -> TestTree +testprop name = singleTest name . PropTest -- | Convert a test result into an error message on failure (empty -- string on success). diff --git a/tasty-dejafu.cabal b/tasty-dejafu.cabal --- a/tasty-dejafu.cabal +++ b/tasty-dejafu.cabal @@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: tasty-dejafu -version: 0.5.0.0 +version: 0.6.0.0 synopsis: Deja Fu support for the Tasty test framework. description: @@ -30,14 +30,14 @@ source-repository this type: git location: https://github.com/barrucadu/dejafu.git - tag: tasty-dejafu-0.5.0.0 + tag: tasty-dejafu-0.6.0.0 library exposed-modules: Test.Tasty.DejaFu -- other-modules: -- other-extensions: build-depends: base >=4.8 && <5 - , dejafu >=0.6 && <0.7 + , dejafu >=0.7 && <0.8 , random >=1.0 && <1.2 , tagged >=0.8 && <0.9 , tasty >=0.10 && <0.12