[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 17 commits: Avoid desugaring non-recursive lets into recursive lets
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Tue Jun 20 11:25:30 UTC 2023
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
3e80c2b4 by Arnaud Spiwack at 2023-06-20T03:19:41-04:00
Avoid desugaring non-recursive lets into recursive lets
This prepares for having linear let expressions in the frontend.
When desugaring lets, SPECIALISE statements create more copies of a
let binding. Because of the rewrite rules attached to the bindings,
there are dependencies between the generated binds.
Before this commit, we simply wrapped all these in a mutually
recursive let block, and left it to the simplified to sort it out.
With this commit: we are careful to generate the bindings in
dependency order, so that we can wrap them in consecutive lets (if the
source is non-recursive).
- - - - -
9fad49e0 by Ben Gamari at 2023-06-20T03:20:19-04:00
rts: Do not call exit() from SIGINT handler
Previously `shutdown_handler` would call `stg_exit` if the scheduler was
Oalready found to be in `SCHED_INTERRUPTING` state (or higher). However,
`stg_exit` is not signal-safe as it calls `exit` (which calls `atexit`
handlers). The only safe thing to do in this situation is to call
`_exit`, which terminates with minimal cleanup.
Fixes #23417.
- - - - -
7485f848 by Bodigrim at 2023-06-20T03:20:57-04:00
Bump Cabal submodule
This requires changing the recomp007 test because now cabal passes
`this-unit-id` to executable components, and that unit-id contains a
hash which includes the ABI of the dependencies. Therefore changing the
dependencies means that -this-unit-id changes and recompilation is
triggered.
The spririt of the test is to test GHC's recompilation logic assuming
that `-this-unit-id` is constant, so we explicitly pass `-ipid` to
`./configure` rather than letting `Cabal` work it out.
- - - - -
1464a2a8 by mangoiv at 2023-06-20T03:21:34-04:00
[feat] add a hint to `HasField` error message
- add a hint that indicates that the record that the record dot is used
on might just be missing a field
- as the intention of the programmer is not entirely clear, it is only
shown if the type is known
- This addresses in part issue #22382
- - - - -
09c7c797 by Ben Gamari at 2023-06-20T07:25:11-04:00
rts/ipe: Fix unused lock warning
- - - - -
12f20ae5 by Ben Gamari at 2023-06-20T07:25:11-04:00
rts/ProfilerReportJson: Fix memory leak
- - - - -
3eb8776f by Ben Gamari at 2023-06-20T07:25:11-04:00
rts: Various warnings fixes
- - - - -
5993ec2c by Ben Gamari at 2023-06-20T07:25:11-04:00
rts: Fix printf format mismatch
- - - - -
9f22f8fc by Ben Gamari at 2023-06-20T07:25:11-04:00
rts: Fix incorrect #include <sys/poll.h>
According to Alpine's warnings and poll(2), <poll.h> should be
preferred.
- - - - -
1ce27044 by Ben Gamari at 2023-06-20T07:25:11-04:00
nonmoving: Fix unused definition warrnings
- - - - -
280afc2c by Ben Gamari at 2023-06-20T07:25:11-04:00
Disable futimens on Darwin.
See #22938
- - - - -
9725efe5 by Ben Gamari at 2023-06-20T07:25:11-04:00
rts: Fix incorrect CPP guard
- - - - -
4fa6ffc7 by Ben Gamari at 2023-06-20T07:25:11-04:00
hadrian: Ensure that -Werror is passed when compiling the RTS.
Previously the `+werror` transformer would only pass `-Werror` to GHC,
which does not ensure that the same is passed to the C compiler when
building the RTS. Arguably this is itself a bug but for now we will just
work around this by passing `-optc-Werror` to GHC.
I tried to enable `-Werror` in all C compilations but the boot libraries
are something of a portability nightmare.
- - - - -
5654112e by Ben Gamari at 2023-06-20T07:25:11-04:00
rts: Disable `#pragma GCC`s on clang compilers
Otherwise the build fails due to warnings. See #23530.
- - - - -
7d815f7f by Ben Gamari at 2023-06-20T07:25:11-04:00
rts: Fix capitalization of prototype
- - - - -
d1566139 by Ben Gamari at 2023-06-20T07:25:11-04:00
rts: Fix incorrect format specifier
- - - - -
ab375d31 by Josh Meredith at 2023-06-20T07:25:17-04:00
JS: remove js_broken(22576) in favour of the pre-existing wordsize(32) condition (#22576)
- - - - -
27 changed files:
- .gitlab/gen_ci.hs
- .gitlab/jobs.yaml
- compiler/GHC/HsToCore/Binds.hs
- compiler/GHC/HsToCore/Expr.hs
- compiler/GHC/Tc/Errors.hs
- compiler/GHC/Types/Hint.hs
- compiler/GHC/Types/Hint/Ppr.hs
- hadrian/src/Flavour.hs
- libraries/Cabal
- rts/Hash.c
- rts/IPE.c
- rts/ProfilerReportJson.c
- rts/Threads.c
- rts/adjustor/LibffiAdjustor.c
- rts/eventlog/EventLog.c
- rts/include/rts/storage/ClosureMacros.h
- rts/posix/Signals.c
- rts/posix/Ticker.c
- rts/posix/ticker/Pthread.c
- rts/posix/ticker/TimerFd.c
- rts/sm/NonMovingMark.c
- testsuite/tests/driver/T4437.hs
- testsuite/tests/driver/recomp007/Makefile
- testsuite/tests/driver/recomp007/recomp007.stdout
- testsuite/tests/ghci/should_run/T16096.stdout
- testsuite/tests/parser/should_fail/RecordDotSyntaxFail8.stderr
- testsuite/tests/perf/compiler/all.T
Changes:
=====================================
.gitlab/gen_ci.hs
=====================================
@@ -409,6 +409,8 @@ opsysVariables Amd64 (Darwin {}) =
, "ac_cv_func_clock_gettime" =: "no"
-- # Only newer OS Xs support utimensat. See #17895
, "ac_cv_func_utimensat" =: "no"
+ -- # Only newer OS Xs support futimens. See #22938
+ , "ac_cv_func_futimens" =: "no"
, "LANG" =: "en_US.UTF-8"
, "CONFIGURE_ARGS" =: "--with-intree-gmp --with-system-libffi"
-- Fonts can't be installed on darwin
=====================================
.gitlab/jobs.yaml
=====================================
@@ -480,6 +480,7 @@
"TEST_ENV": "x86_64-darwin-validate",
"XZ_OPT": "-9",
"ac_cv_func_clock_gettime": "no",
+ "ac_cv_func_futimens": "no",
"ac_cv_func_utimensat": "no"
}
},
@@ -2478,6 +2479,7 @@
"TEST_ENV": "x86_64-darwin-release",
"XZ_OPT": "-9",
"ac_cv_func_clock_gettime": "no",
+ "ac_cv_func_futimens": "no",
"ac_cv_func_utimensat": "no"
}
},
@@ -3590,6 +3592,7 @@
"NIX_SYSTEM": "x86_64-darwin",
"TEST_ENV": "x86_64-darwin-validate",
"ac_cv_func_clock_gettime": "no",
+ "ac_cv_func_futimens": "no",
"ac_cv_func_utimensat": "no"
}
},
=====================================
compiler/GHC/HsToCore/Binds.hs
=====================================
@@ -117,10 +117,56 @@ dsTopLHsBinds binds
top_level_err bindsType (L loc bind)
= putSrcSpanDs (locA loc) $
diagnosticDs (DsTopLevelBindsNotAllowed bindsType bind)
+{-
+Note [Return bindings in dependency order]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+The desugarer tries to desugar a non-recursive let-binding to a collection of
+one or more non-recursive let-bindings. The alternative is to generate a letrec
+and wait for the occurrence analyser to sort it out later, but it is pretty easy
+to arrange that the [(Id,CoreExpr)] pairs returned by dsLHsBinds are returned in
+dependency order
+
+It's most important for linear types, where non-recursive lets can be linear
+whereas recursive-let can't. Since we check the output of the desugarer for
+linearity (see also Note [Linting linearity]), desugaring non-recursive lets to
+recursive lets would break linearity checks. An alternative is to refine the
+typing rule for recursive lets so that we don't have to care (see in particular
+#23218 and #18694), but the outcome of this line of work is still unclear. In
+the meantime, being a little precise in the desugarer is cheap. (paragraph
+written on 2023-06-09)
+
+In dsLHSBinds (and dependencies), a single binding can be desugared to multiple
+bindings. For instance because the source binding has the {-# SPECIALIZE #-}
+pragma. In:
+
+f _ = …
+ where
+ {-# SPECIALIZE g :: F Int -> F Int #-}
+ g :: C a => F a -> F a
+ g _ = …
+
+The g binding desugars to
+
+let {
+ $sg = … } in
+
+ g
+ [RULES: "SPEC g" g @Int $dC = $sg]
+ g = …
+In order to avoid generating a letrec that will immediately be reordered, we
+make sure to return the binding in dependency order [$sg, g].
+
+This only matters when the source binding is non-recursive as recursive bindings
+are always desugared to a single mutually recursive block.
+
+-}
-- | Desugar all other kind of bindings, Ids of strict binds are returned to
-- later be forced in the binding group body, see Note [Desugar Strict binds]
+--
+-- Invariant: the desugared bindings are returned in dependency order,
+-- see Note [Return bindings in dependency order]
dsLHsBinds :: LHsBinds GhcTc -> DsM ([Id], [(Id,CoreExpr)])
dsLHsBinds binds
= do { ds_bs <- mapBagM dsLHsBind binds
@@ -134,6 +180,9 @@ dsLHsBind (L loc bind) = do dflags <- getDynFlags
putSrcSpanDs (locA loc) $ dsHsBind dflags bind
-- | Desugar a single binding (or group of recursive binds).
+--
+-- Invariant: the desugared bindings are returned in dependency order,
+-- see Note [Return bindings in dependency order]
dsHsBind :: DynFlags
-> HsBind GhcTc
-> DsM ([Id], [(Id,CoreExpr)])
@@ -263,7 +312,7 @@ dsAbsBinds dflags tyvars dicts exports
(isDefaultMethod prags)
(dictArity dicts) rhs
- ; return (force_vars', main_bind : fromOL spec_binds) } }
+ ; return (force_vars', fromOL spec_binds ++ [main_bind]) } }
-- Another common case: no tyvars, no dicts
-- In this case we can have a much simpler desugaring
@@ -322,7 +371,7 @@ dsAbsBinds dflags tyvars dicts exports
-- Kill the INLINE pragma because it applies to
-- the user written (local) function. The global
-- Id is just the selector. Hmm.
- ; return ((global', rhs) : fromOL spec_binds) } }
+ ; return (fromOL spec_binds ++ [(global', rhs)]) } }
; export_binds_s <- mapM mk_bind (exports ++ extra_exports)
=====================================
compiler/GHC/HsToCore/Expr.hs
=====================================
@@ -160,17 +160,20 @@ ds_val_bind (is_rec, binds) body
-- NB: bindings have a fixed RuntimeRep, so it's OK to call isUnliftedType
case prs of
[] -> return body
- _ -> return (Let (Rec prs) body') }
- -- Use a Rec regardless of is_rec.
- -- Why? Because it allows the binds to be all
- -- mixed up, which is what happens in one rare case
- -- Namely, for an AbsBind with no tyvars and no dicts,
- -- but which does have dictionary bindings.
- -- See notes with GHC.Tc.Solver.inferLoop [NO TYVARS]
- -- It turned out that wrapping a Rec here was the easiest solution
- --
- -- NB The previous case dealt with unlifted bindings, so we
- -- only have to deal with lifted ones now; so Rec is ok
+ _ -> return (mkLets (mk_binds is_rec prs) body') }
+ -- We can make a non-recursive let because we make sure to return
+ -- the bindings in dependency order in dsLHsBinds, see Note [Return bindings in dependency order]
+
+-- | Helper function. You can use the result of 'mk_binds' with 'mkLets' for
+-- instance.
+--
+-- * @'mk_binds' 'Recursive' binds@ makes a single mutually-recursive
+-- bindings with all the rhs/lhs pairs in @binds@
+-- * @'mk_binds' 'NonRecursive' binds@ makes one non-recursive binding
+-- for each rhs/lhs pairs in @binds@
+mk_binds :: RecFlag -> [(b, (Expr b))] -> [Bind b]
+mk_binds Recursive binds = [Rec binds]
+mk_binds NonRecursive binds = map (uncurry NonRec) binds
------------------
dsUnliftedBind :: HsBind GhcTc -> CoreExpr -> DsM CoreExpr
=====================================
compiler/GHC/Tc/Errors.hs
=====================================
@@ -2316,7 +2316,7 @@ mk_dict_err ctxt (item, (matches, unifiers, unsafe_overlapped)) = case (NE.nonEm
(Nothing, _) -> do -- No matches but perhaps several unifiers
{ (_, rel_binds, item) <- relevantBindings True ctxt item
; candidate_insts <- get_candidate_instances
- ; (imp_errs, field_suggestions) <- record_field_suggestions
+ ; (imp_errs, field_suggestions) <- record_field_suggestions item
; return (cannot_resolve_msg item candidate_insts rel_binds imp_errs field_suggestions) }
-- Some matches => overlap errors
@@ -2352,13 +2352,33 @@ mk_dict_err ctxt (item, (matches, unifiers, unsafe_overlapped)) = case (NE.nonEm
| otherwise = False
-- See Note [Out-of-scope fields with -XOverloadedRecordDot]
- record_field_suggestions :: TcM ([ImportError], [GhcHint])
- record_field_suggestions = flip (maybe $ return ([], noHints)) record_field $ \name ->
+ record_field_suggestions :: ErrorItem -> TcM ([ImportError], [GhcHint])
+ record_field_suggestions item = flip (maybe $ return ([], noHints)) record_field $ \name ->
do { glb_env <- getGlobalRdrEnv
; lcl_env <- getLocalRdrEnv
- ; if occ_name_in_scope glb_env lcl_env name
- then return ([], noHints)
- else unknownNameSuggestions emptyLocalRdrEnv WL_RecField (mkRdrUnqual name) }
+ ; let field_name_hints = report_no_fieldnames item
+ ; (errs, hints) <- if occ_name_in_scope glb_env lcl_env name
+ then return ([], noHints)
+ else unknownNameSuggestions emptyLocalRdrEnv WL_RecField (mkRdrUnqual name)
+ ; pure (errs, hints ++ field_name_hints)
+ }
+
+ -- get type names from instance
+ -- resolve the type - if it's in scope is it a record?
+ -- if it's a record, report an error - the record name + the field that could not be found
+ report_no_fieldnames :: ErrorItem -> [GhcHint]
+ report_no_fieldnames item
+ | Just (EvVarDest evvar) <- ei_evdest item
+ -- we can assume that here we have a `HasField @Symbol x r a` instance
+ -- because of HasFieldOrigin in record_field
+ , Just (_, [_symbol, x, r, a]) <- tcSplitTyConApp_maybe (varType evvar)
+ , Just (r_tycon, _) <- tcSplitTyConApp_maybe r
+ , Just x_name <- isStrLitTy x
+ -- we check that this is a record type by checking whether it has any
+ -- fields (in scope)
+ , not . null $ tyConFieldLabels r_tycon
+ = [RemindRecordMissingField x_name r a]
+ | otherwise = []
occ_name_in_scope glb_env lcl_env occ_name = not $
null (lookupGRE_OccName (IncludeFields WantNormal) glb_env occ_name) &&
=====================================
compiler/GHC/Types/Hint.hs
=====================================
@@ -35,7 +35,7 @@ import GHC.Hs.Extension (GhcTc, GhcRn)
import GHC.Core.Coercion
import GHC.Core.FamInstEnv (FamFlavor)
import GHC.Core.TyCon (TyCon)
-import GHC.Core.Type (PredType)
+import GHC.Core.Type (PredType, Type)
import GHC.Types.Fixity (LexicalFixity(..))
import GHC.Types.Name (Name, NameSpace, OccName (occNameFS), isSymOcc, nameOccName)
import GHC.Types.Name.Reader (RdrName (Unqual), ImpDeclSpec)
@@ -44,7 +44,7 @@ import GHC.Types.Basic (Activation, RuleName)
import {-# SOURCE #-} GHC.Tc.Types.Origin ( ClsInstOrQC(..) )
import GHC.Parser.Errors.Basic
import GHC.Utils.Outputable
-import GHC.Data.FastString (fsLit)
+import GHC.Data.FastString (fsLit, FastString)
import Data.Typeable ( Typeable )
@@ -465,6 +465,9 @@ data GhcHint
{-| Suggest eta-reducing a type synonym used in the implementation
of abstract data. -}
| SuggestEtaReduceAbsDataTySyn TyCon
+ {-| Remind the user that there is no field of a type and name in the record,
+ constructors are in the usual order $x$, $r$, $a$ -}
+ | RemindRecordMissingField FastString Type Type
{-| Suggest binding the type variable on the LHS of the type declaration
-}
| SuggestBindTyVarOnLhs RdrName
=====================================
compiler/GHC/Types/Hint/Ppr.hs
=====================================
@@ -14,6 +14,7 @@ import GHC.Types.Hint
import GHC.Core.FamInstEnv (FamFlavor(..))
import GHC.Core.TyCon
+import GHC.Core.TyCo.Rep ( mkVisFunTyMany )
import GHC.Hs.Expr () -- instance Outputable
import GHC.Tc.Types.Origin ( ClsInstOrQC(..) )
import GHC.Types.Id
@@ -251,6 +252,12 @@ instance Outputable GhcHint where
SuggestEtaReduceAbsDataTySyn tc
-> text "If possible, eta-reduce the type synonym" <+> ppr_tc <+> text "so that it is nullary."
where ppr_tc = quotes (ppr $ tyConName tc)
+ RemindRecordMissingField x r a ->
+ text "NB: There is no field selector" <+> ppr_sel
+ <+> text "in scope for record type" <+> ppr_r
+ where ppr_sel = quotes (ftext x <+> dcolon <+> ppr_arr_r_a)
+ ppr_arr_r_a = ppr $ mkVisFunTyMany r a
+ ppr_r = quotes $ ppr r
SuggestBindTyVarOnLhs tv
-> text "Bind" <+> quotes (ppr tv) <+> text "on the LHS of the type declaration"
=====================================
hadrian/src/Flavour.hs
=====================================
@@ -123,16 +123,25 @@ addArgs args' fl = fl { extraArgs = extraArgs fl <> args' }
-- from warnings.
werror :: Flavour -> Flavour
werror =
- addArgs
- ( builder Ghc
+ addArgs $ mconcat
+ [ builder Ghc
? notStage0
? mconcat
- [ arg "-Werror",
- flag CrossCompiling
+ [ arg "-Werror"
+ , flag CrossCompiling
? package unix
? mconcat [arg "-Wwarn=unused-imports", arg "-Wwarn=unused-top-binds"]
]
- )
+ , builder Ghc
+ ? package rts
+ ? mconcat
+ [ arg "-optc-Werror"
+ -- clang complains about #pragma GCC pragmas
+ , arg "-optc-Wno-error=unknown-pragmas"
+ ]
+ -- N.B. We currently don't build the boot libraries' C sources with -Werror
+ -- as this tends to be a portability nightmare.
+ ]
-- | Build C and Haskell objects with debugging information.
enableDebugInfo :: Flavour -> Flavour
=====================================
libraries/Cabal
=====================================
@@ -1 +1 @@
-Subproject commit 4bfd6a0352ecfd71e1ca756a007ca827b68416d5
+Subproject commit e71f6f263aa4d7ce7a145eb5ac417f2f580f2288
=====================================
rts/Hash.c
=====================================
@@ -18,11 +18,13 @@
since we compile these things these days with cabal we can no longer
specify optimization per file. So we have to resort to pragmas. */
#if defined(__GNUC__) || defined(__GNUG__)
+#if !defined(__clang__)
#if !defined(DEBUG)
#pragma GCC push_options
#pragma GCC optimize ("O3")
#endif
#endif
+#endif
#define XXH_NAMESPACE __rts_
#define XXH_STATIC_LINKING_ONLY /* access advanced declarations */
@@ -565,7 +567,9 @@ int keyCountHashTable (HashTable *table)
#if defined(__GNUC__) || defined(__GNUG__)
+#if !defined(__clang__)
#if !defined(DEBUG)
#pragma GCC pop_options
#endif
#endif
+#endif
=====================================
rts/IPE.c
=====================================
@@ -62,7 +62,10 @@ this all IPE lists of all IpeBufferListNode are traversed to insert all IPEs.
After the content of a IpeBufferListNode has been inserted, it's freed.
*/
+#if defined(THREADED_RTS)
static Mutex ipeMapLock;
+#endif
+// Protected by ipeMapLock
static HashTable *ipeMap = NULL;
// Accessed atomically
=====================================
rts/ProfilerReportJson.c
=====================================
@@ -52,11 +52,10 @@ static void escapeString(char const* str, char **buf)
static void
logCostCentres(FILE *prof_file)
{
- char* lbl;
- char* src_loc;
bool needs_comma = false;
fprintf(prof_file, "[\n");
for (CostCentre *cc = CC_LIST; cc != NULL; cc = cc->link) {
+ char *lbl, *src_loc;
escapeString(cc->label, &lbl);
escapeString(cc->srcloc, &src_loc);
fprintf(prof_file,
@@ -70,10 +69,10 @@ logCostCentres(FILE *prof_file)
cc->ccID, lbl, cc->module, src_loc,
cc->is_caf ? "true" : "false");
needs_comma = true;
+ stgFree(lbl);
+ stgFree(src_loc);
}
fprintf(prof_file, "]\n");
- stgFree(lbl);
- stgFree(src_loc);
}
static void
=====================================
rts/Threads.c
=====================================
@@ -1013,10 +1013,10 @@ printGlobalThreads(void)
for (uint32_t g = 0; g < RtsFlags.GcFlags.generations; g++) {
debugBelch("\ngen %d\n", g);
for (StgTSO *t = generations[g].threads; t != END_TSO_QUEUE; t = t->global_link) {
- debugBelch("thread %p (id=%lu)\n", t, t->id);
+ debugBelch("thread %p (id=%lu)\n", t, (unsigned long)t->id);
}
for (StgTSO *t = generations[g].old_threads; t != END_TSO_QUEUE; t = t->global_link) {
- debugBelch("thread %p (id=%lu) (old)\n", t, t->id);
+ debugBelch("thread %p (id=%lu) (old)\n", t, (unsigned long)t->id);
}
}
}
=====================================
rts/adjustor/LibffiAdjustor.c
=====================================
@@ -39,7 +39,7 @@ static AdjustorWritable allocate_adjustor(AdjustorExecutable *exec_ret, ffi_cif
{
AdjustorWritable writ;
- ffi_status r = ffi_alloc_prep_closure(&writ, cif, wptr, hptr, exec_ret);
+ ffi_status r = ffi_alloc_prep_closure((ffi_closure **) &writ, cif, wptr, hptr, exec_ret);
if (r != FFI_OK)
barf("ffi_alloc_prep_closure failed: %d", r);
=====================================
rts/eventlog/EventLog.c
=====================================
@@ -759,8 +759,10 @@ void postCapsetVecEvent (EventTypeNum tag,
// 1 + strlen to account for the trailing \0, used as separator
int increment = 1 + strlen(argv[i]);
if (size + increment > EVENT_PAYLOAD_SIZE_MAX) {
- errorBelch("Event size exceeds EVENT_PAYLOAD_SIZE_MAX, record only "
- "%d out of %d args", i, argc);
+ errorBelch("Event size exceeds EVENT_PAYLOAD_SIZE_MAX, record only %"
+ FMT_Word " out of %" FMT_Word " args",
+ (StgWord) i,
+ (StgWord) argc);
argc = i;
break;
} else {
=====================================
rts/include/rts/storage/ClosureMacros.h
=====================================
@@ -623,7 +623,7 @@ INLINE_HEADER void overwritingMutableClosureOfs (StgClosure *p, uint32_t offset)
}
// Version of 'overwritingClosure' which takes closure size as argument.
-void stg_OverwritingClosureSize (StgClosure *p, uint32_t size /* in words */);
+void stg_overwritingClosureSize (StgClosure *p, uint32_t size /* in words */);
INLINE_HEADER void overwritingClosureSize (StgClosure *p, uint32_t size)
{
// This function is only called from stg_AP_STACK so we can assume it's not
=====================================
rts/posix/Signals.c
=====================================
@@ -522,7 +522,9 @@ shutdown_handler(int sig STG_UNUSED)
// extreme prejudice. So the first ^C tries to exit the program
// cleanly, and the second one just kills it.
if (getSchedState() >= SCHED_INTERRUPTING) {
- stg_exit(EXIT_INTERRUPTED);
+ // N.B. we cannot use stg_exit() here as it calls exit() which is not
+ // signal-safe. See #23417.
+ _exit(EXIT_INTERRUPTED);
} else {
interruptStgRts();
}
=====================================
rts/posix/Ticker.c
=====================================
@@ -71,7 +71,7 @@
* For older version of linux/netbsd without timerfd we fall back to the
* pthread based implementation.
*/
-#if HAVE_SYS_TIMERFD_H
+#if defined(HAVE_SYS_TIMERFD_H)
#define USE_TIMERFD_FOR_ITIMER
#endif
=====================================
rts/posix/ticker/Pthread.c
=====================================
@@ -43,7 +43,7 @@
#include "Proftimer.h"
#include "Schedule.h"
#include "posix/Clock.h"
-#include <sys/poll.h>
+#include <poll.h>
#include <time.h>
#if HAVE_SYS_TIME_H
=====================================
rts/posix/ticker/TimerFd.c
=====================================
@@ -43,7 +43,7 @@
#include "Proftimer.h"
#include "Schedule.h"
#include "posix/Clock.h"
-#include <sys/poll.h>
+#include <poll.h>
#include <time.h>
#if HAVE_SYS_TIME_H
=====================================
rts/sm/NonMovingMark.c
=====================================
@@ -39,7 +39,7 @@ static void trace_PAP_payload (MarkQueue *queue,
StgClosure *fun,
StgClosure **payload,
StgWord size);
-static bool is_nonmoving_weak(StgWeak *weak);
+static bool is_nonmoving_weak(StgWeak *weak) USED_IF_DEBUG;
// How many Array# entries to add to the mark queue at once?
#define MARK_ARRAY_CHUNK_LENGTH 128
@@ -974,7 +974,7 @@ static void nonmovingResetUpdRemSetQueue (MarkQueue *rset)
rset->top->head = 0;
}
-void nonmovingResetUpdRemSet (UpdRemSet *rset)
+static void nonmovingResetUpdRemSet (UpdRemSet *rset)
{
nonmovingResetUpdRemSetQueue(&rset->queue);
}
=====================================
testsuite/tests/driver/T4437.hs
=====================================
@@ -37,8 +37,7 @@ check title expected got
-- See Note [Adding a language extension] in compiler/GHC/Driver/Session.hs.
expectedGhcOnlyExtensions :: [String]
expectedGhcOnlyExtensions =
- [ "TypeAbstractions",
- "ExtendedLiterals"
+ [ "TypeAbstractions"
]
expectedCabalOnlyExtensions :: [String]
=====================================
testsuite/tests/driver/recomp007/Makefile
=====================================
@@ -20,11 +20,11 @@ recomp007:
./b/dist/build/test/test
"$(GHC_PKG)" unregister --package-db=$(LOCAL_PKGCONF) a-1.0
$(MAKE) -s --no-print-directory prep.a2
- cd b && ../Setup configure -v0 --with-compiler="$(TEST_HC)" --with-hc-pkg="$(GHC_PKG)" --package-db=../$(LOCAL_PKGCONF)
+ cd b && ../Setup configure -v0 --with-compiler="$(TEST_HC)" --with-hc-pkg="$(GHC_PKG)" --package-db=../$(LOCAL_PKGCONF) --ipid b
cd b && ../Setup build
./b/dist/build/test/test
prep.%:
- cd $* && ../Setup configure -v0 --with-compiler="$(TEST_HC)" --with-hc-pkg="$(GHC_PKG)" --package-db=../$(LOCAL_PKGCONF)
+ cd $* && ../Setup configure -v0 --with-compiler="$(TEST_HC)" --with-hc-pkg="$(GHC_PKG)" --package-db=../$(LOCAL_PKGCONF) --ipid $*
cd $* && ../Setup build -v0
cd $* && ../Setup register -v0 --inplace
=====================================
testsuite/tests/driver/recomp007/recomp007.stdout
=====================================
@@ -1,6 +1,6 @@
"1.0"
-Preprocessing executable 'test' for b-1.0..
-Building executable 'test' for b-1.0..
+Preprocessing executable 'test' for b-1.0...
+Building executable 'test' for b-1.0...
[1 of 2] Compiling B ( B.hs, dist/build/test/test-tmp/B.o ) [A package changed]
[3 of 3] Linking dist/build/test/test [Objects changed]
"2.0"
=====================================
testsuite/tests/ghci/should_run/T16096.stdout
=====================================
@@ -1,6 +1,6 @@
==================== Desugared ====================
-letrec {
+let {
x :: [GHC.Types.Int]
[LclId]
x = let {
@@ -11,7 +11,7 @@ letrec {
x :: [GHC.Types.Int]
[LclId]
x = GHC.Enum.enumFrom @GHC.Types.Int $dEnum (GHC.Types.I# 1#); } in
- x; } in
+ x } in
GHC.Base.returnIO
@[GHC.Types.Any]
(GHC.Types.:
@@ -27,7 +27,7 @@ GHC.Base.returnIO
==================== Desugared ====================
-letrec {
+let {
x :: [GHC.Types.Int]
[LclId]
x = let {
@@ -38,7 +38,7 @@ letrec {
x :: [GHC.Types.Int]
[LclId]
x = GHC.Enum.enumFrom @GHC.Types.Int $dEnum (GHC.Types.I# 1#); } in
- x; } in
+ x } in
GHC.Base.returnIO
@[GHC.Types.Any]
(GHC.Types.:
=====================================
testsuite/tests/parser/should_fail/RecordDotSyntaxFail8.stderr
=====================================
@@ -18,6 +18,7 @@ RecordDotSyntaxFail8.hs:37:3: error: [GHC-39999]
RecordDotSyntaxFail8.hs:37:11: error: [GHC-39999]
• No instance for ‘HasField "quux" Quux a0’
arising from selecting the field ‘quux’
+ NB: There is no field selector ‘quux :: Quux -> a0’ in scope for record type ‘Quux’
• In the second argument of ‘($)’, namely ‘....baz.quux’
In a stmt of a 'do' block: print $ ....baz.quux
In the expression:
=====================================
testsuite/tests/perf/compiler/all.T
=====================================
@@ -658,7 +658,7 @@ test('T21839c',
['-O'])
test ('InfiniteListFusion',
- [collect_stats('bytes allocated',2), when(wordsize(32), skip), js_broken(22576)],
+ [collect_stats('bytes allocated',2), when(wordsize(32), skip)],
compile_and_run,
['-O2 -package ghc'])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/46f5ae932d6a1aea8ce0bb510314caee5033a922...ab375d314e0c559d7fa3f739ae3bbd14dd141f22
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/46f5ae932d6a1aea8ce0bb510314caee5033a922...ab375d314e0c559d7fa3f739ae3bbd14dd141f22
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/20230620/90191dc1/attachment-0001.html>
More information about the ghc-commits
mailing list