libraries/base/tests/listThreads.hs

+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 ()
 

libraries/base/tests/listThreads.stdout

-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"]

rts/Messages.h

@@ -10,6 +10,7 @@
 
 #include "Capability.h"
 #include "Updates.h" // for DEBUG_FILL_SLOP
+#include "Schedule.h" // for SCHED_INTERRUPTING
 #include "SMPClosureOps.h"
 
 #include "BeginPrivate.h"
@@ -26,8 +27,9 @@ INLINE_HEADER void
 doneWithMsgThrowTo (Capability *cap, MessageThrowTo *m)
 {
     // The message better be locked (unless we are running single-threaded,
-    // where we are a bit more lenient (#19075).
-    ASSERT(getNumCapabilities() == 1 || m->header.info == &stg_WHITEHOLE_info);
+    // where we are a bit more lenient (#19075) or we got here from
+    // deleteAllThreads() due to RTS shutdown).
+    ASSERT(getNumCapabilities() == 1 || m->header.info == &stg_WHITEHOLE_info || getSchedState() == SCHED_INTERRUPTING);
     IF_NONMOVING_WRITE_BARRIER_ENABLED {
       updateRemembSetPushMessageThrowTo(cap, m);
     }

rts/Schedule.c

@@ -2322,7 +2322,7 @@ setNumCapabilities (uint32_t new_n_capabilities USED_IF_THREADS)
             // must be done before calling moreCapabilities(), because that
             // will emit events about creating the new capabilities and adding
             // them to existing capsets.
-            tracingAddCapapilities(n_capabilities, new_n_capabilities);
+            tracingAddCapabilities(n_capabilities, new_n_capabilities);
 #endif
 
             // Resize the capabilities array
@@ -2337,7 +2337,8 @@ setNumCapabilities (uint32_t new_n_capabilities USED_IF_THREADS)
 
     // update n_capabilities before things start running
     if (new_n_capabilities > n_capabilities) {
-        RELAXED_STORE(&n_capabilities, enabled_capabilities = new_n_capabilities);
+        RELAXED_STORE(&n_capabilities, new_n_capabilities);
+        RELAXED_STORE(&enabled_capabilities, new_n_capabilities);
     }
 
     // We're done: release the original Capabilities

rts/Schedule.h

@@ -131,7 +131,7 @@ setRecentActivity(enum RecentActivity new_value)
 INLINE_HEADER enum RecentActivity
 getRecentActivity(void)
 {
-    return RELAXED_LOAD_ALWAYS(&recent_activity);
+    return (enum RecentActivity) RELAXED_LOAD_ALWAYS(&recent_activity);
 }
 
 extern bool heap_overflow;

rts/Trace.c

@@ -143,7 +143,7 @@ void flushTrace ()
     }
 }
 
-void tracingAddCapapilities (uint32_t from, uint32_t to)
+void tracingAddCapabilities (uint32_t from, uint32_t to)
 {
     if (eventlog_enabled) {
         moreCapEventBufs(from,to);

rts/Trace.h

@@ -28,12 +28,14 @@ void initTracing (void);
 void endTracing  (void);
 void freeTracing (void);
 void resetTracing (void);
-void tracingAddCapapilities (uint32_t from, uint32_t to);
+void tracingAddCapabilities (uint32_t from, uint32_t to);
 
 #endif /* TRACING */
 
 typedef StgWord32 CapsetID;
+#if !defined(__cplusplus)
 typedef StgWord16 CapsetType;
+#endif
 enum CapsetType { CapsetTypeCustom = CAPSET_TYPE_CUSTOM,
                   CapsetTypeOsProcess = CAPSET_TYPE_OSPROCESS,
                   CapsetTypeClockdomain = CAPSET_TYPE_CLOCKDOMAIN };

rts/include/Stg.h

@@ -82,27 +82,6 @@
    that depend on config info, such as __USE_FILE_OFFSET64 */
 #include <math.h>
 
-// On Solaris, we don't get the INFINITY and NAN constants unless we
-// #define _STDC_C99, and we can't do that unless we also use -std=c99,
-// because _STDC_C99 causes the headers to use C99 syntax (e.g. restrict).
-// We aren't ready for -std=c99 yet, so define INFINITY/NAN by hand using
-// the gcc builtins.
-#if !defined(INFINITY)
-#if defined(__GNUC__)
-#define INFINITY __builtin_inf()
-#else
-#error No definition for INFINITY
-#endif
-#endif
-
-#if !defined(NAN)
-#if defined(__GNUC__)
-#define NAN __builtin_nan("")
-#else
-#error No definition for NAN
-#endif
-#endif
-
 /* -----------------------------------------------------------------------------
    Useful definitions
    -------------------------------------------------------------------------- */
@@ -242,6 +221,8 @@
 #define STG_PRINTF_ATTR(fmt_arg, rest) GNUC3_ATTRIBUTE(format(printf, fmt_arg, rest))
 #endif
 
+#define STG_RESTRICT __restrict__
+
 #define STG_NORETURN GNU_ATTRIBUTE(__noreturn__)
 
 #define STG_MALLOC GNUC3_ATTRIBUTE(__malloc__)

rts/sm/NonMovingMark.h

@@ -63,7 +63,7 @@ INLINE_HEADER enum EntryType nonmovingMarkQueueEntryType(MarkQueueEnt *ent)
 {
     uintptr_t tag = (uintptr_t) ent->null_entry.p & TAG_MASK;
     ASSERT(tag <= MARK_ARRAY);
-    return tag;
+    return (enum EntryType) tag;
 }
 
 typedef struct {
@@ -155,7 +155,7 @@ void markQueueAddRoot(MarkQueue* q, StgClosure** root);
 
 void initMarkQueue(MarkQueue *queue);
 void freeMarkQueue(MarkQueue *queue);
-void nonmovingMark(struct MarkQueue_ *restrict queue);
+void nonmovingMark(struct MarkQueue_ *STG_RESTRICT queue);
 
 bool nonmovingTidyWeaks(struct MarkQueue_ *queue);
 void nonmovingTidyThreads(void);

testsuite/config/ghc

@@ -22,7 +22,7 @@ config.other_ways         = ['hpc',
                              'prof_hc_hb','prof_hb',
                              'prof_hd','prof_hy','prof_hr',
                              'sanity',
-                             'threaded1_ls', 'threaded2_hT', 'debug_numa',
+                             'threaded1_ls', 'threaded2_hT', 'threaded2_sanity', 'debug_numa',
                              'llvm', 'debugllvm',
                              'profllvm', 'profoptllvm', 'profthreadedllvm',
                              'debug',
@@ -99,6 +99,7 @@ config.way_flags = {
     'threaded1_ls' : ['-threaded', '-debug'],
     'threaded2'    : ['-O', '-threaded'],
     'threaded2_hT' : ['-O', '-threaded'],
+    'threaded2_sanity': ['-O', '-threaded', '-debug'],
     'hpc'          : ['-O', '-fhpc'],
     'prof_hc_hb'   : ['-O', '-prof', '-static', '-fprof-auto'],
     'prof_hb'      : ['-O', '-prof', '-static', '-fprof-auto'],
@@ -144,6 +145,7 @@ config.way_rts_flags = {
     'threaded1_ls' : ['-ls'],
     'threaded2'    : ['-N2', '-ls'],
     'threaded2_hT' : ['-N2', '-hT'],
+    'threaded2_sanity' : ['-N2', '-DS'],
     'hpc'          : [],
     'prof_hc_hb'   : ['-hc', '-hbvoid'],
     'prof_hb'      : ['-hb'],

testsuite/tests/primops/should_run/UnliftedTVar2.hs

@@ -7,6 +7,7 @@
 
 module Main where
 
+import Control.Monad
 import Data.Kind
 import GHC.Exts
 import GHC.IO
@@ -28,7 +29,12 @@ main = do
                     case readTVarIO# tvar s4 of
                       (# s5, U res #) ->
                         (# s5, ( I# r, I# res ) #)
-  print (x == y, x > 100000)
+  unless (x > 100000) $ do
+      print (x,y)
+      fail "not enough iterations"
+  unless (x <= y) $ do
+      print (x,y)
+      fail "mismatch"
 
 increment :: TVar# RealWorld U -> State# RealWorld -> (# State# RealWorld, Int #)
 increment tvar = go

testsuite/tests/primops/should_run/UnliftedTVar2.stdout

-(True,True)