From 049cdc50ff440876e1fc42eb92f6400673ad634c Mon Sep 17 00:00:00 2001
From: Michael Walker <mike@barrucadu.co.uk>
Date: Mon, 25 Sep 2017 18:57:34 +0100
Subject: [PATCH] Correctly identify named threads which are started by
 pre-emption

Fixes #101
---
 dejafu/CHANGELOG.markdown    |  5 +++++
 dejafu/Test/DejaFu/Common.hs | 17 +++++++++++------
 2 files changed, 16 insertions(+), 6 deletions(-)

diff --git a/dejafu/CHANGELOG.markdown b/dejafu/CHANGELOG.markdown
index 31c4c1b..a9ac0cf 100644
--- a/dejafu/CHANGELOG.markdown
+++ b/dejafu/CHANGELOG.markdown
@@ -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).
 
 
 ---------------------------------------------------------------------------------------------------
diff --git a/dejafu/Test/DejaFu/Common.hs b/dejafu/Test/DejaFu/Common.hs
index 4809be3..012f0d5 100644
--- a/dejafu/Test/DejaFu/Common.hs
+++ b/dejafu/Test/DejaFu/Common.hs
@@ -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.
 --