[Git][ghc/ghc][master] 8 commits: testsuite: Introduce threaded2_sanity way
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Sat Jan 28 04:57:17 UTC 2023
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
d0ddc01b by Ben Gamari at 2023-01-27T23:56:42-05:00
testsuite: Introduce threaded2_sanity way
Incredibly, we previously did not have a single way which would test the
threaded RTS with multiple capabilities and the sanity-checker enabled.
- - - - -
38ad8351 by Ben Gamari at 2023-01-27T23:56:42-05:00
rts: Relax Messages assertion
`doneWithMsgThrowTo` was previously too strict in asserting that the
`Message` is locked. Specifically, it failed to consider that the
`Message` may not be locked if we are deleting all threads during RTS
shutdown.
- - - - -
a9fe81af by Ben Gamari at 2023-01-27T23:56:42-05:00
testsuite: Fix race in UnliftedTVar2
Previously UnliftedTVar2 would fail when run with multiple capabilities
(and possibly even with one capability) as it would assume that
`killThread#` would immediately kill the "increment" thread.
Also, refactor the the executable to now succeed with no output and
fails with an exit code.
- - - - -
8519af60 by Ben Gamari at 2023-01-27T23:56:42-05:00
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.
- - - - -
55a81995 by Ben Gamari at 2023-01-27T23:56:43-05:00
rts: Fix non-atomic mutation of enabled_capabilities
- - - - -
b5c75f1d by Ben Gamari at 2023-01-27T23:56:43-05:00
rts: Fix C++ compilation issues
Make the RTS compilable with a C++ compiler by inserting necessary
casts.
- - - - -
c261b62f by Ben Gamari at 2023-01-27T23:56:43-05:00
rts: Fix typo
"tracingAddCapabilities" was mis-named
- - - - -
77fdbd3f by Ben Gamari at 2023-01-27T23:56:43-05:00
rts: Drop long-dead fallback definitions for INFINITY & NAN
These are no longer necessary since we now compile as C99.
- - - - -
12 changed files:
- libraries/base/tests/listThreads.hs
- − libraries/base/tests/listThreads.stdout
- rts/Messages.h
- rts/Schedule.c
- rts/Schedule.h
- rts/Trace.c
- rts/Trace.h
- rts/include/Stg.h
- rts/sm/NonMovingMark.h
- testsuite/config/ghc
- testsuite/tests/primops/should_run/UnliftedTVar2.hs
- − testsuite/tests/primops/should_run/UnliftedTVar2.stdout
Changes:
=====================================
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 ()
=====================================
libraries/base/tests/listThreads.stdout deleted
=====================================
@@ -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"]
=====================================
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 deleted
=====================================
@@ -1 +0,0 @@
-(True,True)
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ad8cfed4195b1bbfc14b841f010e75e71f63157d...77fdbd3f7798ae7095a6a22c3674c08c86a91c6c
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ad8cfed4195b1bbfc14b841f010e75e71f63157d...77fdbd3f7798ae7095a6a22c3674c08c86a91c6c
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20230127/152b049f/attachment-0001.html>
More information about the ghc-commits
mailing list