dejafu 0.8.0.0 → 0.9.0.0

raw patch · 9 files changed

+141/−29 lines, 9 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.markdown +26/−0
• Test/DejaFu.hs +14/−6
• Test/DejaFu/Common.hs +82/−13
• Test/DejaFu/Conc.hs +1/−0
• Test/DejaFu/Conc/Internal.hs +9/−5
• Test/DejaFu/Conc/Internal/Common.hs +2/−0
• Test/DejaFu/SCT.hs +3/−3
• Test/DejaFu/SCT/Internal.hs +2/−0
• dejafu.cabal +2/−2

@@ -7,6 +7,32 @@ *de facto* standard Haskell versioning scheme.  +0.9.0.0+-------++- **Date**    2017-10-11+- **Git tag** [dejafu-0.9.0.0][]+- **Hackage** https://hackage.haskell.org/package/dejafu-0.9.0.0++### Test.DejaFu.Common++- New `isInternalError`, `isAbort`, `isDeadlock`, `isUncaughtException`, and+  `isIllegalSubconcurrency` functions for matching failure types.  Also exported from Test.DejaFu.++- The `UncaughtException` `Failure` constructor now includes the exception.++    The `Read`, `Enum`, and `Bounded` instances are gone.  The `Eq`, `Ord`, and `NFData` instances+    use the `show` of the exception.  Pretty-printed failures include the exception text.++- New `ThreadDelay` and `WillThreadDelay` constructors in `ThreadAction` and `Lookahead`.  Uses of+  `threadDelay` are no longer reported as a use of `yield`.++[dejafu-0.9.0.0]: https://github.com/barrucadu/dejafu/releases/tag/dejafu-0.9.0.0+++---------------------------------------------------------------------------------------------------++ 0.8.0.0 ------- 

@@ -251,6 +251,14 @@   , gives   , gives' +  -- ** Failures++  , isInternalError+  , isAbort+  , isDeadlock+  , isUncaughtException+  , isIllegalSubconcurrency+   -- * Refinement property testing    -- | Consider this statement about @MVar@s: \"using @readMVar@ is@@ -614,37 +622,37 @@ -- -- @since 0.1.0.0 deadlocksNever :: Predicate a-deadlocksNever = alwaysTrue (not . either (`elem` [Deadlock, STMDeadlock]) (const False))+deadlocksNever = alwaysTrue (not . either isDeadlock (const False))  -- | Check that a computation always deadlocks. -- -- @since 0.1.0.0 deadlocksAlways :: Predicate a-deadlocksAlways = alwaysTrue $ either (`elem` [Deadlock, STMDeadlock]) (const False)+deadlocksAlways = alwaysTrue $ either isDeadlock (const False)  -- | Check that a computation deadlocks at least once. -- -- @since 0.1.0.0 deadlocksSometimes :: Predicate a-deadlocksSometimes = somewhereTrue $ either (`elem` [Deadlock, STMDeadlock]) (const False)+deadlocksSometimes = somewhereTrue $ either isDeadlock (const False)  -- | Check that a computation never fails with an uncaught exception. -- -- @since 0.1.0.0 exceptionsNever :: Predicate a-exceptionsNever = alwaysTrue (not . either (==UncaughtException) (const False))+exceptionsNever = alwaysTrue (not . either isUncaughtException (const False))  -- | Check that a computation always fails with an uncaught exception. -- -- @since 0.1.0.0 exceptionsAlways :: Predicate a-exceptionsAlways = alwaysTrue $ either (==UncaughtException) (const False)+exceptionsAlways = alwaysTrue $ either isUncaughtException (const False)  -- | Check that a computation fails with an uncaught exception at least once. -- -- @since 0.1.0.0 exceptionsSometimes :: Predicate a-exceptionsSometimes = somewhereTrue $ either (==UncaughtException) (const False)+exceptionsSometimes = somewhereTrue $ either isUncaughtException (const False)  -- | Check that the result of a computation is always the same. In -- particular this means either: (a) it always fails in the same way,

@@ -53,6 +53,11 @@    -- * Failures   , Failure(..)+  , isInternalError+  , isAbort+  , isDeadlock+  , isUncaughtException+  , isIllegalSubconcurrency   , showFail    -- * Memory models@@ -64,8 +69,10 @@   ) where  import           Control.DeepSeq   (NFData(..))-import           Control.Exception (Exception(..), MaskingState(..))+import           Control.Exception (Exception(..), MaskingState(..),+                                    SomeException, displayException) import           Control.Monad.Ref (MonadRef(..))+import           Data.Function     (on) import           Data.List         (intercalate) import           Data.Maybe        (fromMaybe, mapMaybe) import           Data.Set          (Set)@@ -260,7 +267,7 @@  -- | All the actions that a thread can perform. ----- @since 0.5.0.2+-- @since 0.9.0.0 data ThreadAction =     Fork ThreadId   -- ^ Start a new thread.@@ -272,6 +279,8 @@   -- ^ Set the number of Haskell threads that can run simultaneously.   | Yield   -- ^ Yield the current thread.+  | ThreadDelay Int+  -- ^ Yield/delay the current thread.   | NewMVar MVarId   -- ^ Create a new 'MVar'.   | PutMVar MVarId [ThreadId]@@ -348,9 +357,9 @@   -- ^ Stop executing an action with @subconcurrency@.   deriving (Eq, Show) --- | @since 0.5.1.0 instance NFData ThreadAction where   rnf (Fork t) = rnf t+  rnf (ThreadDelay n) = rnf n   rnf (GetNumCapabilities c) = rnf c   rnf (SetNumCapabilities c) = rnf c   rnf (NewMVar m) = rnf m@@ -411,7 +420,7 @@  -- | A one-step look-ahead at what a thread will do next. ----- @since 0.5.0.2+-- @since 0.9.0.0 data Lookahead =     WillFork   -- ^ Will start a new thread.@@ -425,6 +434,8 @@   -- simultaneously.   | WillYield   -- ^ Will yield the current thread.+  | WillThreadDelay Int+  -- ^ Will yield/delay the current thread.   | WillNewMVar   -- ^ Will create a new 'MVar'.   | WillPutMVar MVarId@@ -488,8 +499,8 @@   -- ^ Will stop executing an extion with @subconcurrency@.   deriving (Eq, Show) --- | @since 0.5.1.0 instance NFData Lookahead where+  rnf (WillThreadDelay n) = rnf n   rnf (WillSetNumCapabilities c) = rnf c   rnf (WillPutMVar m) = rnf m   rnf (WillTryPutMVar m) = rnf m@@ -519,6 +530,7 @@ rewind (GetNumCapabilities _) = Just WillGetNumCapabilities rewind (SetNumCapabilities i) = Just (WillSetNumCapabilities i) rewind Yield = Just WillYield+rewind (ThreadDelay n) = Just (WillThreadDelay n) rewind (NewMVar _) = Just WillNewMVar rewind (PutMVar c _) = Just (WillPutMVar c) rewind (BlockedPutMVar c) = Just (WillPutMVar c)@@ -559,6 +571,7 @@ willRelease :: Lookahead -> Bool willRelease WillFork = True willRelease WillYield = True+willRelease (WillThreadDelay _) = True willRelease (WillPutMVar _) = True willRelease (WillTryPutMVar _) = True willRelease (WillReadMVar _) = True@@ -806,6 +819,7 @@             -> Int preEmpCount (x:xs) (d, _) = go initialThread x xs where   go _ (_, Yield) (r@(SwitchTo t, _):rest) = go t r rest+  go _ (_, ThreadDelay _) (r@(SwitchTo t, _):rest) = go t r rest   go tid prior (r@(SwitchTo t, _):rest)     | isCommitThread t = go tid prior (skip rest)     | otherwise = 1 + go t r rest@@ -813,6 +827,7 @@   go tid _ (r@(Continue, _):rest) = go tid r rest   go _ prior [] = case (prior, d) of     ((_, Yield), SwitchTo _) -> 0+    ((_, ThreadDelay _), SwitchTo _) -> 0     (_, SwitchTo _) -> 1     _ -> 0 @@ -831,9 +846,12 @@  -- | An indication of how a concurrent computation failed. ----- @since 0.5.0.0-data Failure =-    InternalError+-- The @Eq@, @Ord@, and @NFData@ instances compare/evaluate the+-- exception with @show@ in the @UncaughtException@ case.+--+-- @since 0.9.0.0+data Failure+  = InternalError   -- ^ Will be raised if the scheduler does something bad. This should   -- never arise unless you write your own, faulty, scheduler! If it   -- does, please file a bug report.@@ -846,17 +864,32 @@   -- ^ The computation became blocked indefinitely on @MVar@s.   | STMDeadlock   -- ^ The computation became blocked indefinitely on @TVar@s.-  | UncaughtException+  | UncaughtException SomeException   -- ^ An uncaught exception bubbled to the top of the computation.   | IllegalSubconcurrency   -- ^ Calls to @subconcurrency@ were nested, or attempted when   -- multiple threads existed.-  deriving (Eq, Show, Read, Ord, Enum, Bounded)+  deriving Show --- | @since 0.5.1.0+instance Eq Failure where+  (==) = (==) `on` _other++instance Ord Failure where+  compare = compare `on` _other+ instance NFData Failure where-  rnf f = f `seq` ()+  rnf = rnf . _other +-- | Convert failures into a different representation we can Eq / Ord+-- / NFData.+_other :: Failure -> (Int, Maybe String)+_other InternalError = (0, Nothing)+_other Abort = (1, Nothing)+_other Deadlock = (2, Nothing)+_other STMDeadlock = (3, Nothing)+_other (UncaughtException e) = (4, Just (show e))+_other IllegalSubconcurrency = (5, Nothing)+ -- | Pretty-print a failure -- -- @since 0.4.0.0@@ -865,8 +898,44 @@ showFail Deadlock = "[deadlock]" showFail STMDeadlock = "[stm-deadlock]" showFail InternalError = "[internal-error]"-showFail UncaughtException = "[exception]"+showFail (UncaughtException exc) = "[" ++ displayException exc ++ "]" showFail IllegalSubconcurrency = "[illegal-subconcurrency]"++-- | Check if a failure is an @InternalError@.+--+-- @since undefined+isInternalError :: Failure -> Bool+isInternalError InternalError = True+isInternalError _ = False++-- | Check if a failure is an @Abort@.+--+-- @since undefined+isAbort :: Failure -> Bool+isAbort Abort = True+isAbort _ = False++-- | Check if a failure is a @Deadlock@ or an @STMDeadlock@.+--+-- @since undefined+isDeadlock :: Failure -> Bool+isDeadlock Deadlock = True+isDeadlock STMDeadlock = True+isDeadlock _ = False++-- | Check if a failure is an @UncaughtException@+--+-- @since undefined+isUncaughtException :: Failure -> Bool+isUncaughtException (UncaughtException _) = True+isUncaughtException _ = False++-- | Check if a failure is an @IllegalSubconcurrency@+--+-- @since undefined+isIllegalSubconcurrency :: Failure -> Bool+isIllegalSubconcurrency IllegalSubconcurrency = True+isIllegalSubconcurrency _ = False  ------------------------------------------------------------------------------- -- Memory Models

@@ -137,6 +137,7 @@   myThreadId = toConc AMyTId    yield = toConc (\c -> AYield (c ()))+  threadDelay n = toConc (\c -> ADelay n (c ()))    -- ---------- 

@@ -192,6 +192,9 @@     -- yield the current thread     AYield c -> simple (goto c tid (cThreads ctx)) Yield +    -- yield the current thread (delay is ignored)+    ADelay n c -> simple (goto c tid (cThreads ctx)) (ThreadDelay n)+     -- create a new @MVar@, using the next 'MVarId'.     ANewMVar n c -> do       let (idSource', newmvid) = nextMVId n (cIdSource ctx)@@ -387,11 +390,12 @@     -- this is not inline in the long @case@ above as it's needed by     -- @AAtom@, @AThrow@, and @AThrowTo@.     stepThrow t ts act e =-      case propagate (toException e) t ts of-        Just ts' -> simple ts' act-        Nothing-          | t == initialThread -> pure (Left UncaughtException, Single act)-          | otherwise -> simple (kill t ts) act+      let some = toException e+      in case propagate some t ts of+           Just ts' -> simple ts' act+           Nothing+             | t == initialThread -> pure (Left (UncaughtException some), Single act)+             | otherwise -> simple (kill t ts) act      -- helper for actions which only change the threads.     simple threads' act = pure (Right ctx { cThreads = threads' }, Single act)

@@ -141,6 +141,7 @@   | forall a. AAtom (STMLike n r a) (a -> Action n r)   | ALift (n (Action n r))   | AYield  (Action n r)+  | ADelay Int (Action n r)   | AReturn (Action n r)   | ACommit ThreadId CRefId   | AStop (n ())@@ -181,6 +182,7 @@ lookahead (AResetMask b1 b2 ms _) = (if b1 then WillSetMasking else WillResetMasking) b2 ms lookahead (ALift _) = WillLiftIO lookahead (AYield _) = WillYield+lookahead (ADelay n _) = WillThreadDelay n lookahead (AReturn _) = WillReturn lookahead (AStop _) = WillStop lookahead (ASub _ _) = WillSubconcurrency

@@ -661,9 +661,9 @@     Just (tid, _) -> ycount (tidOf tid d)     Nothing       -> ycount initialThread   where-    ycount tnext = case lnext of-      WillYield -> M.alter (Just . maybe 1 (+1)) tnext sofar-      _ -> M.alter (Just . fromMaybe 0) tnext sofar+    ycount tnext+      | willYield lnext = M.alter (Just . maybe 1 (+1)) tnext sofar+      | otherwise       = M.alter (Just . fromMaybe 0)  tnext sofar  -- | Determine if an action is a commit or not. isCommitRef :: ThreadAction -> Bool

@@ -799,11 +799,13 @@ -- | Check if a thread yielded. didYield :: ThreadAction -> Bool didYield Yield = True+didYield (ThreadDelay _) = True didYield _ = False  -- | Check if a thread will yield. willYield :: Lookahead -> Bool willYield WillYield = True+willYield (WillThreadDelay _) = True willYield _ = False  -- | Check if an action will kill daemon threads.

@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/  name:                dejafu-version:             0.8.0.0+version:             0.9.0.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.8.0.0+  tag:      dejafu-0.9.0.0  library   exposed-modules:     Test.DejaFu