mirror of
https://github.com/barrucadu/dejafu.git
synced 2024-12-19 19:41:31 +03:00
Correctly identify named threads which are started by pre-emption
Fixes #101
This commit is contained in:
parent
0f6dba0190
commit
049cdc50ff
@ -10,9 +10,14 @@ This project is versioned according to the [Package Versioning Policy](https://p
|
||||
unreleased
|
||||
----------
|
||||
|
||||
### Test.DejaFu.Common
|
||||
|
||||
- A new function `threadNames`, to get all named threads from a trace.
|
||||
|
||||
### Miscellaneous
|
||||
|
||||
- Escaping a mask by raising an exception now correctly restores the masking state (#118).
|
||||
- Named threads which are only started by a pre-emption now show up in the trace (#101).
|
||||
|
||||
|
||||
---------------------------------------------------------------------------------------------------
|
||||
|
@ -48,6 +48,7 @@ module Test.DejaFu.Common
|
||||
, Trace
|
||||
, Decision(..)
|
||||
, showTrace
|
||||
, threadNames
|
||||
, preEmpCount
|
||||
|
||||
-- * Failures
|
||||
@ -65,7 +66,7 @@ module Test.DejaFu.Common
|
||||
import Control.DeepSeq (NFData(..))
|
||||
import Control.Exception (Exception(..), MaskingState(..))
|
||||
import Control.Monad.Ref (MonadRef(..))
|
||||
import Data.List (intercalate, nub, sort)
|
||||
import Data.List (intercalate)
|
||||
import Data.List.NonEmpty (NonEmpty)
|
||||
import Data.Maybe (fromMaybe, mapMaybe)
|
||||
import Data.Set (Set)
|
||||
@ -778,12 +779,16 @@ showTrace trc = intercalate "\n" $ concatMap go trc : strkey where
|
||||
go (SwitchTo (ThreadId _ i),_,_) = "P" ++ show i ++ "-"
|
||||
go (Continue,_,_) = "-"
|
||||
|
||||
strkey = [" " ++ show i ++ ": " ++ name | (i, name) <- key]
|
||||
strkey =
|
||||
[" " ++ show i ++ ": " ++ name | (i, name) <- threadNames trc]
|
||||
|
||||
key = sort . nub $ mapMaybe toKey trc where
|
||||
toKey (Start (ThreadId (Just name) i), _, _)
|
||||
| i > 0 = Just (i, name)
|
||||
toKey _ = Nothing
|
||||
-- | Get all named threads in the trace.
|
||||
--
|
||||
-- @since unreleased
|
||||
threadNames :: Trace -> [(Int, String)]
|
||||
threadNames = mapMaybe go where
|
||||
go (_, _, Fork (ThreadId (Just name) i)) = Just (i, name)
|
||||
go _ = Nothing
|
||||
|
||||
-- | Count the number of pre-emptions in a schedule prefix.
|
||||
--
|
||||
|
Loading…
Reference in New Issue
Block a user