diff --git a/CHANGELOG.rst b/CHANGELOG.rst --- a/CHANGELOG.rst +++ b/CHANGELOG.rst @@ -7,6 +7,45 @@ .. _PVP: https://pvp.haskell.org/ +1.3.1.0 (2018-03-11) +-------------------- + +* Git: :tag:`dejafu-1.3.1.0` +* Hackage: :hackage:`dejafu-1.3.1.0` + +Added +~~~~~ + +* (:pull:`246`) ``Generic`` instances for: + + * ``Test.DejaFu.Types.ThreadId`` + * ``Test.DejaFu.Types.CRefId`` + * ``Test.DejaFu.Types.MVarId`` + * ``Test.DejaFu.Types.TVarId`` + * ``Test.DejaFu.Types.Id`` + * ``Test.DejaFu.Types.ThreadAction`` + * ``Test.DejaFu.Types.Lookahead`` + * ``Test.DejaFu.Types.TAction`` + * ``Test.DejaFu.Types.Decision`` + * ``Test.DejaFu.Types.Failure`` + * ``Test.DejaFu.Types.Bounds`` + * ``Test.DejaFu.Types.PreemptionBound`` + * ``Test.DejaFu.Types.FairBound`` + * ``Test.DejaFu.Types.LengthBound`` + * ``Test.DejaFu.Types.Discard`` + * ``Test.DejaFu.Types.MemType`` + * ``Test.DejaFu.Types.MonadFailException`` + +* (:pull:`246`) ``NFData`` instance for + ``Test.DejaFu.Types.MonadFailException`` + +Fixed +~~~~~ + +* (:issue:`199`) Missing cases in the ``NFData`` instances for + ``Test.DejaFu.Types.ThreadAction`` and ``TAction`` + + 1.3.0.3 (2018-03-11) -------------------- diff --git a/Test/DejaFu/Internal.hs b/Test/DejaFu/Internal.hs --- a/Test/DejaFu/Internal.hs +++ b/Test/DejaFu/Internal.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE GADTs #-} -- | @@ -6,20 +8,21 @@ -- License : MIT -- Maintainer : Michael Walker -- Stability : experimental --- Portability : GADTs +-- Portability : DeriveAnyClass, DeriveGeneric, GADTs -- -- Internal types and functions used throughout DejaFu. This module -- is NOT considered to form part of the public interface of this -- library. module Test.DejaFu.Internal where -import Control.DeepSeq (NFData(..)) +import Control.DeepSeq (NFData) import Control.Monad.Ref (MonadRef(..)) import Data.List.NonEmpty (NonEmpty(..)) import qualified Data.Map.Strict as M import Data.Maybe (fromMaybe) import Data.Set (Set) import qualified Data.Set as S +import GHC.Generics (Generic) import System.Random (RandomGen) import Test.DejaFu.Types @@ -62,14 +65,7 @@ , _mvids :: (Int, [String]) , _tvids :: (Int, [String]) , _tids :: (Int, [String]) - } deriving (Eq, Ord, Show) - -instance NFData IdSource where - rnf idsource = rnf ( _crids idsource - , _mvids idsource - , _tvids idsource - , _tids idsource - ) + } deriving (Eq, Ord, Show, Generic, NFData) -- | Get the next free 'CRefId'. nextCRId :: String -> IdSource -> (IdSource, CRefId) @@ -247,18 +243,7 @@ | SynchronisedOther -- ^ Some other action which does require cross-thread -- communication. - deriving (Eq, Show) - -instance NFData ActionType where - rnf (UnsynchronisedRead c) = rnf c - rnf (UnsynchronisedWrite c) = rnf c - rnf (PartiallySynchronisedCommit c) = rnf c - rnf (PartiallySynchronisedWrite c) = rnf c - rnf (PartiallySynchronisedModify c) = rnf c - rnf (SynchronisedModify c) = rnf c - rnf (SynchronisedRead m) = rnf m - rnf (SynchronisedWrite m) = rnf m - rnf a = a `seq` () + deriving (Eq, Show, Generic, NFData) -- | Check if an action imposes a write barrier. isBarrier :: ActionType -> Bool diff --git a/Test/DejaFu/SCT/Internal/DPOR.hs b/Test/DejaFu/SCT/Internal/DPOR.hs --- a/Test/DejaFu/SCT/Internal/DPOR.hs +++ b/Test/DejaFu/SCT/Internal/DPOR.hs @@ -1,12 +1,14 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE ViewPatterns #-} -- | -- Module : Test.DejaFu.SCT.Internal.DPOR --- Copyright : (c) 2015--2017 Michael Walker +-- Copyright : (c) 2015--2018 Michael Walker -- License : MIT -- Maintainer : Michael Walker -- Stability : experimental --- Portability : ViewPatterns +-- Portability : DeriveAnyClass, DeriveGeneric, ViewPatterns -- -- Internal types and functions for SCT via dynamic partial-order -- reduction. This module is NOT considered to form part of the @@ -28,6 +30,7 @@ import qualified Data.Sequence as Sq import Data.Set (Set) import qualified Data.Set as S +import GHC.Generics (Generic) import Test.DejaFu.Internal import Test.DejaFu.Schedule (Scheduler(..)) @@ -59,16 +62,7 @@ -- ^ Transitions which have been taken, excluding -- conservatively-added ones. This is used in implementing sleep -- sets. - } deriving (Eq, Show) - -instance NFData DPOR where - rnf dpor = rnf ( dporRunnable dpor - , dporTodo dpor - , dporNext dpor - , dporDone dpor - , dporSleep dpor - , dporTaken dpor - ) + } deriving (Eq, Show, Generic, NFData) -- | Check the DPOR data invariants and raise an error if any are -- broken. @@ -109,16 +103,7 @@ -- alternatives were added conservatively due to the bound. , bcktState :: DepState -- ^ Some domain-specific state at this point. - } deriving (Eq, Show) - -instance NFData BacktrackStep where - rnf bs = rnf ( bcktThreadid bs - , bcktDecision bs - , bcktAction bs - , bcktRunnable bs - , bcktBacktracks bs - , bcktState bs - ) + } deriving (Eq, Show, Generic, NFData) -- | Initial DPOR state, given an initial thread ID. This initial -- thread should exist and be runnable at the start of execution. @@ -362,17 +347,7 @@ -- remove decisions from the sleep set. , schedBState :: Maybe k -- ^ State used by the incremental bounding function. - } deriving (Eq, Show) - -instance NFData k => NFData (DPORSchedState k) where - rnf s = rnf ( schedSleep s - , schedPrefix s - , schedBPoints s - , schedIgnore s - , schedBoundKill s - , schedDepState s - , schedBState s - ) + } deriving (Eq, Show, Generic, NFData) -- | Initial DPOR scheduler state for a given prefix initialDPORSchedState :: Map ThreadId ThreadAction diff --git a/Test/DejaFu/SCT/Internal/Weighted.hs b/Test/DejaFu/SCT/Internal/Weighted.hs --- a/Test/DejaFu/SCT/Internal/Weighted.hs +++ b/Test/DejaFu/SCT/Internal/Weighted.hs @@ -1,6 +1,9 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} + -- | -- Module : Test.DejaFu.SCT.Internal.Weighted --- Copyright : (c) 2015--2017 Michael Walker +-- Copyright : (c) 2015--2018 Michael Walker -- License : MIT -- Maintainer : Michael Walker -- Stability : experimental @@ -11,11 +14,12 @@ -- public interface of this library. module Test.DejaFu.SCT.Internal.Weighted where -import Control.DeepSeq (NFData(..)) +import Control.DeepSeq (NFData) import Data.List.NonEmpty (toList) import Data.Map.Strict (Map) import qualified Data.Map.Strict as M import Data.Maybe (fromMaybe) +import GHC.Generics (Generic) import System.Random (RandomGen, randomR) import Test.DejaFu.Schedule (Scheduler(..)) @@ -30,12 +34,7 @@ -- ^ The thread weights: used in determining which to run. , schedGen :: g -- ^ The random number generator. - } deriving (Eq, Show) - -instance NFData g => NFData (RandSchedState g) where - rnf s = rnf ( schedWeights s - , schedGen s - ) + } deriving (Eq, Show, Generic, NFData) -- | Initial weighted random scheduler state. initialRandSchedState :: Maybe (Map ThreadId Int) -> g -> RandSchedState g diff --git a/Test/DejaFu/Types.hs b/Test/DejaFu/Types.hs --- a/Test/DejaFu/Types.hs +++ b/Test/DejaFu/Types.hs @@ -1,12 +1,14 @@ +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE StandaloneDeriving #-} -- | -- Module : Test.DejaFu.Types --- Copyright : (c) 2017 Michael Walker +-- Copyright : (c) 2017--2018 Michael Walker -- License : MIT -- Maintainer : Michael Walker -- Stability : experimental --- Portability : GeneralizedNewtypeDeriving +-- Portability : DeriveGeneric, GeneralizedNewtypeDeriving, StandaloneDeriving -- -- Common types and functions used throughout DejaFu. module Test.DejaFu.Types where @@ -15,6 +17,7 @@ import Control.Exception (Exception(..), MaskingState(..), SomeException) import Data.Function (on) +import GHC.Generics (Generic) ------------------------------------------------------------------------------- -- * Identifiers @@ -28,6 +31,9 @@ instance Show ThreadId where show (ThreadId id_) = show id_ +-- | @since 1.3.1.0 +deriving instance Generic ThreadId + -- | Every @CRef@ has a unique identifier. -- -- @since 1.0.0.0 @@ -37,6 +43,9 @@ instance Show CRefId where show (CRefId id_) = show id_ +-- | @since 1.3.1.0 +deriving instance Generic CRefId + -- | Every @MVar@ has a unique identifier. -- -- @since 1.0.0.0 @@ -46,6 +55,9 @@ instance Show MVarId where show (MVarId id_) = show id_ +-- | @since 1.3.1.0 +deriving instance Generic MVarId + -- | Every @TVar@ has a unique identifier. -- -- @since 1.0.0.0 @@ -55,10 +67,15 @@ instance Show TVarId where show (TVarId id_) = show id_ +-- | @since 1.3.1.0 +deriving instance Generic TVarId + -- | An identifier for a thread, @MVar@, @CRef@, or @TVar@. -- -- The number is the important bit. The string is to make execution -- traces easier to read, but is meaningless. +-- +-- @since 1.0.0.0 data Id = Id (Maybe String) {-# UNPACK #-} !Int instance Eq Id where @@ -71,9 +88,11 @@ show (Id (Just n) _) = n show (Id _ i) = show i -instance NFData Id where - rnf (Id n i) = rnf (n, i) +-- | @since 1.3.1.0 +deriving instance Generic Id +instance NFData Id + -- | The ID of the initial thread. -- -- @since 0.4.0.0 @@ -181,12 +200,19 @@ -- ^ Execute an action with @dontCheck@. deriving (Eq, Show) +-- | @since 1.3.1.0 +deriving instance Generic ThreadAction + +-- this makes me sad instance NFData ThreadAction where rnf (Fork t) = rnf t rnf (ForkOS t) = rnf t - rnf (ThreadDelay n) = rnf n - rnf (GetNumCapabilities c) = rnf c - rnf (SetNumCapabilities c) = rnf c + rnf (IsCurrentThreadBound b) = rnf b + rnf MyThreadId = () + rnf (GetNumCapabilities i) = rnf i + rnf (SetNumCapabilities i) = rnf i + rnf Yield = () + rnf (ThreadDelay i) = rnf i rnf (NewMVar m) = rnf m rnf (PutMVar m ts) = rnf (m, ts) rnf (BlockedPutMVar m) = rnf m @@ -205,14 +231,22 @@ rnf (WriteCRef c) = rnf c rnf (CasCRef c b) = rnf (c, b) rnf (CommitCRef t c) = rnf (t, c) - rnf (STM tr ts) = rnf (tr, ts) - rnf (BlockedSTM tr) = rnf tr + rnf (STM as ts) = rnf (as, ts) + rnf (BlockedSTM as) = rnf as + rnf Catching = () + rnf PopCatching = () + rnf Throw = () rnf (ThrowTo t) = rnf t rnf (BlockedThrowTo t) = rnf t - rnf (SetMasking b m) = b `seq` m `seq` () - rnf (ResetMasking b m) = b `seq` m `seq` () - rnf (DontCheck t) = rnf t - rnf a = a `seq` () + rnf Killed = () + rnf (SetMasking b m) = rnf (b, show m) + rnf (ResetMasking b m) = rnf (b, show m) + rnf LiftIO = () + rnf Return = () + rnf Stop = () + rnf Subconcurrency = () + rnf StopSubconcurrency = () + rnf (DontCheck as) = rnf as -- | A one-step look-ahead at what a thread will do next. -- @@ -301,15 +335,27 @@ -- ^ Will execute an action with @dontCheck@. deriving (Eq, Show) +-- | @since 1.3.1.0 +deriving instance Generic Lookahead + +-- this also makes me sad instance NFData Lookahead where - rnf (WillThreadDelay n) = rnf n - rnf (WillSetNumCapabilities c) = rnf c + rnf WillFork = () + rnf WillForkOS = () + rnf WillIsCurrentThreadBound = () + rnf WillMyThreadId = () + rnf WillGetNumCapabilities = () + rnf (WillSetNumCapabilities i) = rnf i + rnf WillYield = () + rnf (WillThreadDelay i) = rnf i + rnf WillNewMVar = () rnf (WillPutMVar m) = rnf m rnf (WillTryPutMVar m) = rnf m rnf (WillReadMVar m) = rnf m rnf (WillTryReadMVar m) = rnf m rnf (WillTakeMVar m) = rnf m rnf (WillTryTakeMVar m) = rnf m + rnf WillNewCRef = () rnf (WillReadCRef c) = rnf c rnf (WillReadCRefCas c) = rnf c rnf (WillModCRef c) = rnf c @@ -317,10 +363,19 @@ rnf (WillWriteCRef c) = rnf c rnf (WillCasCRef c) = rnf c rnf (WillCommitCRef t c) = rnf (t, c) + rnf WillSTM = () + rnf WillCatching = () + rnf WillPopCatching = () + rnf WillThrow = () rnf (WillThrowTo t) = rnf t - rnf (WillSetMasking b m) = b `seq` m `seq` () - rnf (WillResetMasking b m) = b `seq` m `seq` () - rnf l = l `seq` () + rnf (WillSetMasking b m) = rnf (b, show m) + rnf (WillResetMasking b m) = rnf (b, show m) + rnf WillLiftIO = () + rnf WillReturn = () + rnf WillStop = () + rnf WillSubconcurrency = () + rnf WillStopSubconcurrency = () + rnf WillDontCheck = () -- | All the actions that an STM transaction can perform. -- @@ -347,13 +402,11 @@ -- ^ Terminate successfully and commit effects. deriving (Eq, Show) +-- | @since 1.3.1.0 +deriving instance Generic TAction + -- | @since 0.5.1.0 -instance NFData TAction where - rnf (TRead t) = rnf t - rnf (TWrite t) = rnf t - rnf (TOrElse tr mtr) = rnf (tr, mtr) - rnf (TCatch tr mtr) = rnf (tr, mtr) - rnf ta = ta `seq` () +instance NFData TAction ------------------------------------------------------------------------------- -- * Traces @@ -381,11 +434,11 @@ -- ^ Pre-empt the running thread, and switch to another. deriving (Eq, Show) +-- | @since 1.3.1.0 +deriving instance Generic Decision + -- | @since 0.5.1.0 -instance NFData Decision where - rnf (Start t) = rnf t - rnf (SwitchTo t) = rnf t - rnf d = d `seq` () +instance NFData Decision ------------------------------------------------------------------------------- -- * Failures @@ -447,6 +500,9 @@ rnf (UncaughtException e) = rnf (show e) rnf f = f `seq` () +-- | @since 1.3.1.0 +deriving instance Generic Failure + -- | Check if a failure is an @InternalError@. -- -- @since 0.9.0.0 @@ -500,12 +556,11 @@ , boundLength :: Maybe LengthBound } deriving (Eq, Ord, Read, Show) +-- | @since 1.3.1.0 +deriving instance Generic Bounds + -- | @since 0.5.1.0 -instance NFData Bounds where - rnf bs = rnf ( boundPreemp bs - , boundFair bs - , boundLength bs - ) +instance NFData Bounds -- | Restrict the number of pre-emptive context switches allowed in an -- execution. @@ -516,10 +571,11 @@ newtype PreemptionBound = PreemptionBound Int deriving (Enum, Eq, Ord, Num, Real, Integral, Read, Show) +-- | @since 1.3.1.0 +deriving instance Generic PreemptionBound + -- | @since 0.5.1.0 -instance NFData PreemptionBound where - -- not derived, so it can have a separate @since annotation - rnf (PreemptionBound i) = rnf i +instance NFData PreemptionBound -- | Restrict the maximum difference between the number of yield or -- delay operations different threads have performed. @@ -530,10 +586,11 @@ newtype FairBound = FairBound Int deriving (Enum, Eq, Ord, Num, Real, Integral, Read, Show) +-- | @since 1.3.1.0 +deriving instance Generic FairBound + -- | @since 0.5.1.0 -instance NFData FairBound where - -- not derived, so it can have a separate @since annotation - rnf (FairBound i) = rnf i +instance NFData FairBound -- | Restrict the maximum length (in terms of primitive actions) of an -- execution. @@ -544,10 +601,11 @@ newtype LengthBound = LengthBound Int deriving (Enum, Eq, Ord, Num, Real, Integral, Read, Show) +-- | @since 1.3.1.0 +deriving instance Generic LengthBound + -- | @since 0.5.1.0 -instance NFData LengthBound where - -- not derived, so it can have a separate @since annotation - rnf (LengthBound i) = rnf i +instance NFData LengthBound ------------------------------------------------------------------------------- -- * Discarding results and traces @@ -565,9 +623,11 @@ -- reported as a possible behaviour of the program. deriving (Eq, Show, Read, Ord, Enum, Bounded) -instance NFData Discard where - rnf d = d `seq` () +-- | @since 1.3.1.0 +deriving instance Generic Discard +instance NFData Discard + -- | Combine two discard values, keeping the weaker. -- -- @Nothing@ is weaker than @Just DiscardTrace@, which is weaker than @@ -628,9 +688,11 @@ -- created. deriving (Eq, Show, Read, Ord, Enum, Bounded) +-- | @since 1.3.1.0 +deriving instance Generic MemType + -- | @since 0.5.1.0 -instance NFData MemType where - rnf m = m `seq` () +instance NFData MemType ------------------------------------------------------------------------------- -- * @MonadFail@ @@ -640,3 +702,9 @@ deriving Show instance Exception MonadFailException + +-- | @since 1.3.1.0 +deriving instance Generic MonadFailException + +-- | @since 1.3.1.0 +instance NFData MonadFailException diff --git a/dejafu.cabal b/dejafu.cabal --- a/dejafu.cabal +++ b/dejafu.cabal @@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: dejafu -version: 1.3.0.3 +version: 1.3.1.0 synopsis: A library for unit-testing concurrent programs. description: @@ -33,7 +33,7 @@ source-repository this type: git location: https://github.com/barrucadu/dejafu.git - tag: dejafu-1.3.0.3 + tag: dejafu-1.3.1.0 library exposed-modules: Test.DejaFu