testsuite: Make listThreads more robust

Previously it was sensitive to the labels of threads which it did not
create (e.g. the IO manager event loop threads). Fix this.

2 files changed, 10 insertions, 6 deletions

diff --git a/libraries/base/tests/listThreads.hs b/libraries/base/tests/listThreads.hs
index 398afd0cc7..5037ea2e32 100644
--- a/libraries/base/tests/listThreads.hs
+++ b/libraries/base/tests/listThreads.hs
@@ -1,3 +1,6 @@
+import Data.Maybe
+import Control.Monad
+import qualified Data.Set as S
 import Control.Concurrent
 import Data.List (sort)
 import GHC.Conc.Sync
@@ -13,11 +16,14 @@ main = do
   mvar <- newEmptyMVar
   let mkThread n = do
         tid <- forkIO $ readMVar mvar
-        labelThread tid ("thread-"++show n)
+        let lbl = "thread-"++show n
+        labelThread tid lbl
+        return lbl
 
-  mapM_ mkThread [0..100]
+  expectedLabels <- S.fromList <$> mapM mkThread [0..100]
   threads <- listThreads
-  print $ length threads
-  print . sort =<< mapM threadLabel threads
+  labels <- S.fromList . catMaybes <$> mapM threadLabel threads
+  unless (S.null $ expectedLabels `S.difference` labels) $
+      putStrLn $ unlines [ "thread labels don't match", show expectedLabels, show labels ]
   putMVar mvar ()
 
diff --git a/libraries/base/tests/listThreads.stdout b/libraries/base/tests/listThreads.stdout
deleted file mode 100644
index e7ed0d1d6c..0000000000
--- a/libraries/base/tests/listThreads.stdout
+++ /dev/null
@@ -1,2 +0,0 @@
-102
-[Nothing,Just "thread-0",Just "thread-1",Just "thread-10",Just "thread-100",Just "thread-11",Just "thread-12",Just "thread-13",Just "thread-14",Just "thread-15",Just "thread-16",Just "thread-17",Just "thread-18",Just "thread-19",Just "thread-2",Just "thread-20",Just "thread-21",Just "thread-22",Just "thread-23",Just "thread-24",Just "thread-25",Just "thread-26",Just "thread-27",Just "thread-28",Just "thread-29",Just "thread-3",Just "thread-30",Just "thread-31",Just "thread-32",Just "thread-33",Just "thread-34",Just "thread-35",Just "thread-36",Just "thread-37",Just "thread-38",Just "thread-39",Just "thread-4",Just "thread-40",Just "thread-41",Just "thread-42",Just "thread-43",Just "thread-44",Just "thread-45",Just "thread-46",Just "thread-47",Just "thread-48",Just "thread-49",Just "thread-5",Just "thread-50",Just "thread-51",Just "thread-52",Just "thread-53",Just "thread-54",Just "thread-55",Just "thread-56",Just "thread-57",Just "thread-58",Just "thread-59",Just "thread-6",Just "thread-60",Just "thread-61",Just "thread-62",Just "thread-63",Just "thread-64",Just "thread-65",Just "thread-66",Just "thread-67",Just "thread-68",Just "thread-69",Just "thread-7",Just "thread-70",Just "thread-71",Just "thread-72",Just "thread-73",Just "thread-74",Just "thread-75",Just "thread-76",Just "thread-77",Just "thread-78",Just "thread-79",Just "thread-8",Just "thread-80",Just "thread-81",Just "thread-82",Just "thread-83",Just "thread-84",Just "thread-85",Just "thread-86",Just "thread-87",Just "thread-88",Just "thread-89",Just "thread-9",Just "thread-90",Just "thread-91",Just "thread-92",Just "thread-93",Just "thread-94",Just "thread-95",Just "thread-96",Just "thread-97",Just "thread-98",Just "thread-99"]