Don't consider TVar reads dependent

This commit is contained in:
Michael Walker 2017-11-01 14:46:18 +00:00
parent eb73600b39
commit 30ab912210
3 changed files with 46 additions and 6 deletions

View File

@ -7,6 +7,17 @@ This project is versioned according to the [Package Versioning Policy](https://p
*de facto* standard Haskell versioning scheme. *de facto* standard Haskell versioning scheme.
unreleased
----------
### Miscellaneous
- Small improvement to dependency detection of STM transactions.
---------------------------------------------------------------------------------------------------
0.9.0.1 0.9.0.1
------- -------

View File

@ -27,6 +27,8 @@ module Test.DejaFu.Common
, ThreadAction(..) , ThreadAction(..)
, isBlock , isBlock
, tvarsOf , tvarsOf
, tvarsWritten
, tvarsRead
-- ** Lookahead -- ** Lookahead
, Lookahead(..) , Lookahead(..)
, rewind , rewind
@ -410,18 +412,39 @@ isBlock _ = False
-- --
-- @since 0.4.0.0 -- @since 0.4.0.0
tvarsOf :: ThreadAction -> Set TVarId tvarsOf :: ThreadAction -> Set TVarId
tvarsOf act = S.fromList $ case act of tvarsOf act = tvarsRead act `S.union` tvarsWritten act
-- | Get the @TVar@s a transaction wrote to (or would have, if it
-- didn't @retry@).
--
-- @since unreleased
tvarsWritten :: ThreadAction -> Set TVarId
tvarsWritten act = S.fromList $ case act of
STM trc _ -> concatMap tvarsOf' trc STM trc _ -> concatMap tvarsOf' trc
BlockedSTM trc -> concatMap tvarsOf' trc BlockedSTM trc -> concatMap tvarsOf' trc
_ -> [] _ -> []
where where
tvarsOf' (TRead tv) = [tv]
tvarsOf' (TWrite tv) = [tv] tvarsOf' (TWrite tv) = [tv]
tvarsOf' (TOrElse ta tb) = concatMap tvarsOf' (ta ++ fromMaybe [] tb) tvarsOf' (TOrElse ta tb) = concatMap tvarsOf' (ta ++ fromMaybe [] tb)
tvarsOf' (TCatch ta tb) = concatMap tvarsOf' (ta ++ fromMaybe [] tb) tvarsOf' (TCatch ta tb) = concatMap tvarsOf' (ta ++ fromMaybe [] tb)
tvarsOf' _ = [] tvarsOf' _ = []
-- | Get the @TVar@s a transaction read from.
--
-- @since unreleased
tvarsRead :: ThreadAction -> Set TVarId
tvarsRead act = S.fromList $ case act of
STM trc _ -> concatMap tvarsOf' trc
BlockedSTM trc -> concatMap tvarsOf' trc
_ -> []
where
tvarsOf' (TRead tv) = [tv]
tvarsOf' (TOrElse ta tb) = concatMap tvarsOf' (ta ++ fromMaybe [] tb)
tvarsOf' (TCatch ta tb) = concatMap tvarsOf' (ta ++ fromMaybe [] tb)
tvarsOf' _ = []
--------------------------------------- ---------------------------------------
-- Lookahead -- Lookahead

View File

@ -605,15 +605,21 @@ dependent memtype ds t1 a1 t2 a2 = case (a1, a2) of
-- Dependency of STM transactions can be /greatly/ improved here, as -- Dependency of STM transactions can be /greatly/ improved here, as
-- the 'Lookahead' does not know which @TVar@s will be touched, and -- the 'Lookahead' does not know which @TVar@s will be touched, and
-- so has to assume all transactions are dependent. -- so has to assume all transactions are dependent.
(STM _ _, STM _ _) -> not . S.null $ tvarsOf a1 `S.intersection` tvarsOf a2 (STM _ _, STM _ _) -> checkSTM
(STM _ _, BlockedSTM _) -> not . S.null $ tvarsOf a1 `S.intersection` tvarsOf a2 (STM _ _, BlockedSTM _) -> checkSTM
(BlockedSTM _, STM _ _) -> not . S.null $ tvarsOf a1 `S.intersection` tvarsOf a2 (BlockedSTM _, STM _ _) -> checkSTM
(BlockedSTM _, BlockedSTM _) -> not . S.null $ tvarsOf a1 `S.intersection` tvarsOf a2 (BlockedSTM _, BlockedSTM _) -> checkSTM
_ -> case (,) <$> rewind a1 <*> rewind a2 of _ -> case (,) <$> rewind a1 <*> rewind a2 of
Just (l1, l2) -> dependent' memtype ds t1 a1 t2 l2 && dependent' memtype ds t2 a2 t1 l1 Just (l1, l2) -> dependent' memtype ds t1 a1 t2 l2 && dependent' memtype ds t2 a2 t1 l1
_ -> dependentActions memtype ds (simplifyAction a1) (simplifyAction a2) _ -> dependentActions memtype ds (simplifyAction a1) (simplifyAction a2)
where
-- STM actions A and B are dependent if A wrote to anything B
-- touched, or vice versa.
checkSTM = checkSTM' a1 a2 || checkSTM' a2 a1
checkSTM' a b = not . S.null $ tvarsWritten a `S.intersection` tvarsOf b
-- | Variant of 'dependent' to handle 'Lookahead'. -- | Variant of 'dependent' to handle 'Lookahead'.
-- --
-- Termination of the initial thread is handled specially in the DPOR -- Termination of the initial thread is handled specially in the DPOR