dejafu 0.7.1.3 → 0.7.2.0

raw patch · 7 files changed

+120/−57 lines, 7 filesdep ~concurrencyPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: concurrency

API changes (from Hackage documentation)

Files

• CHANGELOG.markdown +27/−0
• Test/DejaFu/Common.hs +36/−8
• Test/DejaFu/Conc/Internal/Memory.hs +5/−4
• Test/DejaFu/SCT.hs +7/−17
• Test/DejaFu/SCT/Internal.hs +15/−12
• Test/DejaFu/STM.hs +19/−5
• dejafu.cabal +11/−11

@@ -7,6 +7,33 @@ *de facto* standard Haskell versioning scheme.  +0.7.2.0+-------++- **Date**    2017-09-16+- **Git tag** [dejafu-0.7.2.0][]+- **Hackage** https://hackage.haskell.org/package/dejafu-0.7.2.0++### Test.DejaFu.STM++- The `STM n r` monad now has `Alternative` and `MonadPlus` instances, using `orElse` for the binary+  operation and `retry` for the unit.++### Miscellaneous++- The `Eq` instance for `ThreadId`, `CRefId`, `MVarId`, and `TVarId` now only compares the numbers,+  not the names.++    This makes it consistent with the `Ord` instances, and is also a small performance gain.++- Now compatible with concurrency-1.2.0.0.++[dejafu-0.7.2.0]: https://github.com/barrucadu/dejafu/releases/tag/dejafu-0.7.2.0+++---------------------------------------------------------------------------------------------------++ 0.7.1.3 ------- 

@@ -76,10 +76,17 @@  -- | Every live thread has a unique identitifer. --+-- The @Eq@ and @Ord@ instances only consider the int, not the name.+-- -- @since 0.4.0.0-data ThreadId = ThreadId (Maybe String) Int-  deriving Eq+data ThreadId = ThreadId (Maybe String) {-# UNPACK #-} !Int +-- | Previously this was a derived instance.+--+-- @since 0.7.2.0+instance Eq ThreadId where+  (ThreadId _ i) == (ThreadId _ j) = i == j+ instance Ord ThreadId where   compare (ThreadId _ i) (ThreadId _ j) = compare i j @@ -93,10 +100,17 @@  -- | Every @CRef@ has a unique identifier. --+-- The @Eq@ and @Ord@ instances only consider the int, not the name.+-- -- @since 0.4.0.0-data CRefId = CRefId (Maybe String) Int-  deriving Eq+data CRefId = CRefId (Maybe String) {-# UNPACK #-} !Int +-- | Previously this was a derived instance.+--+-- @since 0.7.2.0+instance Eq CRefId where+  (CRefId _ i) == (CRefId _ j) = i == j+ instance Ord CRefId where   compare (CRefId _ i) (CRefId _ j) = compare i j @@ -110,10 +124,17 @@  -- | Every @MVar@ has a unique identifier. --+-- The @Eq@ and @Ord@ instances only consider the int, not the name.+-- -- @since 0.4.0.0-data MVarId = MVarId (Maybe String) Int-  deriving Eq+data MVarId = MVarId (Maybe String) {-# UNPACK #-} !Int +-- | Previously this was a derived instance.+--+-- @since 0.7.2.0+instance Eq MVarId where+  (MVarId _ i) == (MVarId _ j) = i == j+ instance Ord MVarId where   compare (MVarId _ i) (MVarId _ j) = compare i j @@ -127,9 +148,16 @@  -- | Every @TVar@ has a unique identifier. --+-- The @Eq@ and @Ord@ instances only consider the int, not the name.+-- -- @since 0.4.0.0-data TVarId = TVarId (Maybe String) Int-  deriving Eq+data TVarId = TVarId (Maybe String) {-# UNPACK #-} !Int++-- | Previously this was a derived instance.+--+-- @since 0.7.2.0+instance Eq TVarId where+  (TVarId _ i) == (TVarId _ j) = i == j  instance Ord TVarId where   compare (TVarId _ i) (TVarId _ j) = compare i j

@@ -27,7 +27,8 @@ import           Control.Monad.Ref                   (MonadRef, readRef,                                                       writeRef) import           Data.Map.Strict                     (Map)-import           Data.Maybe                          (fromJust, isJust)+import           Data.Maybe                          (fromJust, isJust,+                                                      maybeToList) import           Data.Monoid                         ((<>)) import           Data.Sequence                       (Seq, ViewL(..), singleton,                                                       viewl, (><))@@ -130,10 +131,10 @@ -- | Add phantom threads to the thread list to commit pending writes. addCommitThreads :: WriteBuffer r -> Threads n r -> Threads n r addCommitThreads (WriteBuffer wb) ts = ts <> M.fromList phantoms where-  phantoms = [ (ThreadId Nothing $ negate tid, mkthread $ fromJust c)+  phantoms = [ (ThreadId Nothing $ negate tid, mkthread c)              | ((_, b), tid) <- zip (M.toList wb) [1..]-             , let c = go $ viewl b-             , isJust c]+             , c <- maybeToList (go $ viewl b)+             ]   go (BufferedWrite tid (CRef crid _) _ :< _) = Just $ ACommit tid crid   go EmptyL = Nothing 

@@ -355,11 +355,13 @@   }  -- | Combination bound function-cBound :: Bounds -> IncrementalBoundFunc (((Int, Maybe ThreadId), M.Map ThreadId Int), Int)-cBound (Bounds pb fb lb) =-  maybe (trueBound (0, Nothing)) pBound pb &+&-  maybe (trueBound M.empty)      fBound fb &+&-  maybe (trueBound 0)            lBound lb+cBound :: Bounds -> IncrementalBoundFunc ((Int, Maybe ThreadId), M.Map ThreadId Int, Int)+cBound (Bounds pb fb lb) (Just (k1, k2, k3)) prior lh =+  let k1' = maybe (\k _ _ -> k) pBound pb (Just k1) prior lh+      k2' = maybe (\k _ _ -> k) fBound fb (Just k2) prior lh+      k3' = maybe (\k _ _ -> k) lBound lb (Just k3) prior lh+  in (,,) <$> k1' <*> k2' <*> k3'+cBound _ Nothing _ _ = Just ((0, Nothing), M.empty, 1)  -- | Combination backtracking function. Add all backtracking points -- corresponding to enabled bound functions.@@ -676,18 +678,6 @@     in go m' xs   go m [] = m   go' x0 m x = m `max` abs (x0 - x)---- | The \"true\" bound, which allows everything.-trueBound :: k -> IncrementalBoundFunc k-trueBound k _ _ _ = Just k---- | Combine two bounds into a larger bound, where both must be--- satisfied.-(&+&) :: IncrementalBoundFunc k1 -> IncrementalBoundFunc k2 -> IncrementalBoundFunc (k1, k2)-(&+&) f1 f2 ks prior lhead =-  let k1' = f1 (fst <$> ks) prior lhead-      k2' = f2 (snd <$> ks) prior lhead-  in (,) <$> k1' <*> k2'  -- | Apply the discard function. checkDiscard :: Functor f => (a -> Maybe Discard) -> a -> [b] -> f [(a, [b])] -> f [(a, [b])]

@@ -259,7 +259,7 @@                  , let is = idxs' u n v tagged                  , not $ null is] -        idxs' u n v = catMaybes . go' True where+        idxs' u n v = go' True where           {-# INLINE go' #-}           go' final ((i,b):rest)             -- Don't cross subconcurrency boundaries@@ -267,7 +267,7 @@             -- If this is the final action in the trace and the             -- execution was killed due to nothing being within bounds             -- (@killsEarly == True@) assume worst-case dependency.-            | bcktThreadid b == v && (killsEarly || isDependent b) = Just i : go' False rest+            | bcktThreadid b == v && (killsEarly || isDependent b) = i : go' False rest             | otherwise = go' False rest           go' _ [] = [] @@ -561,11 +561,10 @@   enabled = M.toList $ M.filterWithKey (\tid _ -> tid `elem` tids) weights'    -- The weights, with any new threads added.-  weights' = schedWeights s `M.union` M.fromList newWeights-  (newWeights, g') = foldr assignWeight ([], schedGen s) $ filter (`M.notMember` schedWeights s) tids+  (weights', g') = foldr assignWeight (M.empty, schedGen s) tids   assignWeight tid ~(ws, g0) =-    let (w, g) = weightf g0-    in ((tid, w):ws, g)+    let (w, g) = maybe (weightf g0) (,g0) (M.lookup tid (schedWeights s))+    in (M.insert tid w ws, g)    -- The runnable threads.   tids = map fst (toList threads)@@ -675,17 +674,21 @@   (UnsynchronisedRead r1, _) | isBarrier a2 -> isBuffered ds r1 && memtype /= SequentialConsistency   (_, UnsynchronisedRead r2) | isBarrier a1 -> isBuffered ds r2 && memtype /= SequentialConsistency -  (_, _)+  (_, _) -> case getSame crefOf of     -- Two actions on the same CRef where at least one is synchronised-    | same crefOf && (synchronises a1 (fromJust $ crefOf a1) || synchronises a2 (fromJust $ crefOf a2)) -> True+    Just r -> synchronises a1 r || synchronises a2 r     -- Two actions on the same MVar-    | same mvarOf -> True--  _ -> False+    _ -> same mvarOf    where     same :: Eq a => (ActionType -> Maybe a) -> Bool-    same f = isJust (f a1) && f a1 == f a2+    same = isJust . getSame++    getSame :: Eq a => (ActionType -> Maybe a) -> Maybe a+    getSame f =+      let f1 = f a1+          f2 = f a2+      in if f1 == f2 then f1 else Nothing  ------------------------------------------------------------------------------- -- Dependency function state

@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TypeFamilies #-}@@ -8,7 +9,7 @@ -- License     : MIT -- Maintainer  : Michael Walker <mike@barrucadu.co.uk> -- Stability   : experimental--- Portability : GeneralizedNewtypeDeriving, RankNTypes, TypeFamilies+-- Portability : CPP, GeneralizedNewtypeDeriving, RankNTypes, TypeFamilies -- -- A 'MonadSTM' implementation, which can be run on top of 'IO' or -- 'ST'.@@ -26,7 +27,8 @@   , runTransaction   ) where -import           Control.Monad            (unless)+import           Control.Applicative      (Alternative(..))+import           Control.Monad            (MonadPlus(..), unless) import           Control.Monad.Catch      (MonadCatch(..), MonadThrow(..)) import           Control.Monad.Ref        (MonadRef) import           Control.Monad.ST         (ST)@@ -70,12 +72,24 @@ instance MonadCatch (STMLike n r) where   catch (S stm) handler = toSTM (SCatch (runSTM . handler) stm) +-- | @since 0.7.2.0+instance Alternative (STMLike n r) where+  S a <|> S b = toSTM (SOrElse a b)+  empty = toSTM (const SRetry)++-- | @since 0.7.2.0+instance MonadPlus (STMLike n r)+ instance C.MonadSTM (STMLike n r) where   type TVar (STMLike n r) = TVar r -  retry = toSTM (const SRetry)--  orElse (S a) (S b) = toSTM (SOrElse a b)+#if MIN_VERSION_concurrency(1,2,0)+  -- retry and orElse are top-level definitions in+  -- Control.Monad.STM.Class in 1.2 and up+#else+  retry = empty+  orElse = (<|>)+#endif    newTVarN n = toSTM . SNew n 

@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/  name:                dejafu-version:             0.7.1.3+version:             0.7.2.0 synopsis:            Systematic testing for Haskell concurrency.  description:@@ -37,7 +37,7 @@ source-repository this   type:     git   location: https://github.com/barrucadu/dejafu.git-  tag:      dejafu-0.7.1.3+  tag:      dejafu-0.7.2.0  library   exposed-modules:     Test.DejaFu@@ -58,15 +58,15 @@    -- other-modules:          -- other-extensions:    -  build-depends:       base              >=4.8  && <5-                     , concurrency       ==1.1.*-                     , containers        >=0.5  && <0.6-                     , deepseq           >=1.1  && <2-                     , exceptions        >=0.7  && <0.9-                     , leancheck         >=0.6  && <0.7-                     , mtl               >=2.2  && <2.3-                     , random            >=1.0  && <1.2-                     , ref-fd            >=0.4  && <0.5+  build-depends:       base              >=4.8 && <5+                     , concurrency       >=1.1 && <1.3+                     , containers        >=0.5 && <0.6+                     , deepseq           >=1.1 && <2+                     , exceptions        >=0.7 && <0.9+                     , leancheck         >=0.6 && <0.7+                     , mtl               >=2.2 && <2.3+                     , random            >=1.0 && <1.2+                     , ref-fd            >=0.4 && <0.5                      -- remove semigroups dep when GHC 8.4 is out                      , semigroups        >=0.16 && <0.19                      , transformers      >=0.4  && <0.6