dejafu 2.4.0.0 → 2.4.0.1

raw patch · 4 files changed

+50/−37 lines, 4 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• CHANGELOG.rst +14/−0
• Test/DejaFu/Conc/Internal.hs +3/−5
• Test/DejaFu/Conc/Internal/STM.hs +31/−30
• dejafu.cabal +2/−2

@@ -6,6 +6,20 @@  .. _PVP: https://pvp.haskell.org/ ++2.4.0.1 (2020-12-28)+--------------------++* Git: :tag:`dejafu-2.4.0.1`+* Hackage: :hackage:`dejafu-2.4.0.1`++Fixed+~~~~~++* (:issue:`331`) Initial TVar values from setup actions are now+  restored for subsequent executions.++ 2.4.0.0 (2020-07-01) -------------------- 

@@ -506,21 +506,19 @@  -- run a STM transaction atomically. stepThread _ _ _ _ tid (AAtom stm c) = synchronised $ \ctx@Context{..} -> do-  let transaction = runTransaction stm cIdSource-  let effect = const (void transaction)-  (res, idSource', trace) <- transaction+  (res, effect, idSource', trace) <- runTransaction stm cIdSource   case res of     Success _ written val -> do       let (threads', woken) = wake (OnTVar written) cThreads       pure ( Succeeded ctx { cThreads = goto (c val) tid threads', cIdSource = idSource' }            , STM trace woken-           , effect+           , const effect            )     Retry touched -> do       let threads' = block (OnTVar touched) tid cThreads       pure ( Succeeded ctx { cThreads = threads', cIdSource = idSource'}            , BlockedSTM trace-           , effect+           , const effect            )     Exception e -> do       res' <- stepThrow (ThrownSTM trace) tid e ctx

@@ -132,10 +132,10 @@ runTransaction :: MonadDejaFu n   => ModelSTM n a   -> IdSource-  -> n (Result a, IdSource, [TAction])+  -> n (Result a, n (), IdSource, [TAction]) runTransaction ma tvid = do-  (res, _, tvid', trace) <- doTransaction ma tvid-  pure (res, tvid', trace)+  (res, effect, _, tvid', trace) <- doTransaction ma tvid+  pure (res, effect, tvid', trace)  -- | Run a STM transaction, returning an action to undo its effects. --@@ -144,43 +144,44 @@ doTransaction :: MonadDejaFu n   => ModelSTM n a   -> IdSource-  -> n (Result a, n (), IdSource, [TAction])+  -> n (Result a, n (), n (), IdSource, [TAction]) doTransaction ma idsource = do   (c, ref) <- runRefCont SStop (Just . Right) (runModelSTM ma)-  (idsource', undo, readen, written, trace) <- go ref c (pure ()) idsource [] [] []+  (idsource', effect, undo, readen, written, trace) <- go ref c (pure ()) (pure ()) idsource [] [] []   res <- readRef ref    case res of-    Just (Right val) -> pure (Success (nub readen) (nub written) val, undo, idsource', reverse trace)-    Just (Left  exc) -> undo >> pure (Exception exc,      pure (), idsource, reverse trace)-    Nothing          -> undo >> pure (Retry $ nub readen, pure (), idsource, reverse trace)+    Just (Right val) -> pure (Success (nub readen) (nub written) val, effect, undo, idsource', reverse trace)+    Just (Left  exc) -> undo >> pure (Exception exc,      pure (), pure (), idsource, reverse trace)+    Nothing          -> undo >> pure (Retry $ nub readen, pure (), pure (), idsource, reverse trace)    where-    go ref act undo nidsrc readen written sofar = do-      (act', undo', nidsrc', readen', written', tact) <- stepTrans act nidsrc+    go ref act effect undo nidsrc readen written sofar = do+      (act', effect', undo', nidsrc', readen', written', tact) <- stepTrans act nidsrc        let newIDSource = nidsrc'           newAct = act'+          newEffect = effect >> effect'           newUndo = undo' >> undo           newReaden = readen' ++ readen           newWritten = written' ++ written           newSofar = tact : sofar        case tact of-        TStop  -> pure (newIDSource, newUndo, newReaden, newWritten, TStop:newSofar)+        TStop  -> pure (newIDSource, newEffect, newUndo, newReaden, newWritten, TStop:newSofar)         TRetry -> do           writeRef ref Nothing-          pure (newIDSource, newUndo, newReaden, newWritten, TRetry:newSofar)+          pure (newIDSource, newEffect, newUndo, newReaden, newWritten, TRetry:newSofar)         TThrow -> do           writeRef ref (Just . Left $ case act of SThrow e -> toException e; _ -> undefined)-          pure (newIDSource, newUndo, newReaden, newWritten, TThrow:newSofar)-        _ -> go ref newAct newUndo newIDSource newReaden newWritten newSofar+          pure (newIDSource, newEffect, newUndo, newReaden, newWritten, TThrow:newSofar)+        _ -> go ref newAct newEffect newUndo newIDSource newReaden newWritten newSofar  -- | Run a transaction for one step. stepTrans :: MonadDejaFu n   => STMAction n   -> IdSource-  -> n (STMAction n, n (), IdSource, [TVarId], [TVarId], TAction)+  -> n (STMAction n, n (), n (), IdSource, [TVarId], [TVarId], TAction) stepTrans act idsource = case act of   SCatch  h stm c -> stepCatch h stm c   SRead   ref c   -> stepRead ref c@@ -189,50 +190,50 @@   SOrElse a b c   -> stepOrElse a b c   SStop   na      -> stepStop na -  SThrow e -> pure (SThrow e, nothing, idsource, [], [], TThrow)-  SRetry   -> pure (SRetry,   nothing, idsource, [], [], TRetry)+  SThrow e -> pure (SThrow e, nothing, nothing, idsource, [], [], TThrow)+  SRetry   -> pure (SRetry,   nothing, nothing, idsource, [], [], TRetry)    where     nothing = pure ()      stepCatch h stm c = cases TCatch stm c-      (\trace -> pure (SRetry, nothing, idsource, [], [], TCatch trace Nothing))+      (\trace -> pure (SRetry, nothing, nothing, idsource, [], [], TCatch trace Nothing))       (\trace exc    -> case fromException exc of         Just exc' -> transaction (TCatch trace . Just) (h exc') c-        Nothing   -> pure (SThrow exc, nothing, idsource, [], [], TCatch trace Nothing))+        Nothing   -> pure (SThrow exc, nothing, nothing, idsource, [], [], TCatch trace Nothing))      stepRead ModelTVar{..} c = do       val <- readRef tvarRef-      pure (c val, nothing, idsource, [tvarId], [], TRead tvarId)+      pure (c val, nothing, nothing, idsource, [tvarId], [], TRead tvarId)      stepWrite ModelTVar{..} a c = do       old <- readRef tvarRef       writeRef tvarRef a-      pure (c, writeRef tvarRef old, idsource, [], [tvarId], TWrite tvarId)+      pure (c, writeRef tvarRef a, writeRef tvarRef old, idsource, [], [tvarId], TWrite tvarId)      stepNew n a c = do       let (idsource', tvid) = nextTVId n idsource       ref <- newRef a       let tvar = ModelTVar tvid ref-      pure (c tvar, nothing, idsource', [], [tvid], TNew tvid)+      pure (c tvar, writeRef ref a, nothing, idsource', [], [tvid], TNew tvid)      stepOrElse a b c = cases TOrElse a c       (\trace   -> transaction (TOrElse trace . Just) b c)-      (\trace exc -> pure (SThrow exc, nothing, idsource, [], [], TOrElse trace Nothing))+      (\trace exc -> pure (SThrow exc, nothing, nothing, idsource, [], [], TOrElse trace Nothing))      stepStop na = do       na-      pure (SStop na, nothing, idsource, [], [], TStop)+      pure (SStop na, nothing, nothing, idsource, [], [], TStop)      cases tact stm onSuccess onRetry onException = do-      (res, undo, idsource', trace) <- doTransaction stm idsource+      (res, effect, undo, idsource', trace) <- doTransaction stm idsource       case res of-        Success readen written val -> pure (onSuccess val, undo, idsource', readen, written, tact trace Nothing)+        Success readen written val -> pure (onSuccess val, effect, undo, idsource', readen, written, tact trace Nothing)         Retry readen -> do-          (res', undo', idsource'', readen', written', trace') <- onRetry trace-          pure (res', undo', idsource'', readen ++ readen', written', trace')+          (res', effect', undo', idsource'', readen', written', trace') <- onRetry trace+          pure (res', effect', undo', idsource'', readen ++ readen', written', trace')         Exception exc -> onException trace exc      transaction tact stm onSuccess = cases (\t _ -> tact t) stm onSuccess-      (\trace     -> pure (SRetry, nothing, idsource, [], [], tact trace))-      (\trace exc -> pure (SThrow exc, nothing, idsource, [], [], tact trace))+      (\trace     -> pure (SRetry, nothing, nothing, idsource, [], [], tact trace))+      (\trace exc -> pure (SThrow exc, nothing, nothing, idsource, [], [], tact trace))

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