[Git][ghc/ghc][wip/mangoiv/ghc-9.12-bp] 2 commits: Deal with 'noSpec' in 'coreExprToPmLit'

Magnus pushed to branch wip/mangoiv/ghc-9.12-bp at Glasgow Haskell Compiler / GHC Commits: 258f3c10 by sheaf at 2026-05-21T12:36:28+02:00 Deal with 'noSpec' in 'coreExprToPmLit' This commit makes two separate changes relating to 'GHC.HsToCore.Pmc.Solver.Types.coreExprAsPmLit': 1. Commit 7124e4ad mistakenly marked deferred errors as non-canonical, which led to the introduction of 'nospec' wrappers in the generated Core. This reverts that accident by declaring deferred errors as being canonical, avoiding spurious 'nospec' wrapping. 2. Look through magic identity-like Ids such as 'nospec', 'inline' and 'lazy' in 'coreExprAsPmLit', just like Core Prep does. There might genuinely be incoherent evidence, but that shouldn't obstruct the pattern match checker. See test T27124a. Fixes #25926 #27124 ------------------------- Metric Decrease: T3294 ------------------------- (cherry picked from commit e8a196c65cee32f06c3d99b74af33457511408c7) - - - - - 7eb7f6ed by Luite Stegeman at 2026-05-21T13:17:47+02:00 CodeOutput: Fix finalizers on multiple platforms - ELF platforms: emit .fini_array section - wasm32/Darwin: emit initializer with __cxa_atexit call - Windows: use -Wl,--whole-archive to prevent dropping finalizer symbols - rts linker: fix crash/assertion failure unloading objects with finalizers fixes #27072 (cherry picked from commit 014087e7a5753687161a24a1b2bc55c7bf7273fd) - - - - - 30 changed files: - + changelog.d/T27124.md - + changelog.d/fix-finalizers-27072 - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/Driver/CodeOutput.hs - compiler/GHC/HsToCore/Pmc/Solver/Types.hs - compiler/GHC/Linker/Static.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Types/ForeignStubs.hs - rts/Linker.c - rts/LinkerInternals.h - + testsuite/tests/codeGen/should_run/T27072d.hs - + testsuite/tests/codeGen/should_run/T27072d.stdout - + testsuite/tests/codeGen/should_run/T27072d_c.c - + testsuite/tests/codeGen/should_run/T27072d_check.c - + testsuite/tests/codeGen/should_run/T27072w.hs - + testsuite/tests/codeGen/should_run/T27072w.stdout - + testsuite/tests/codeGen/should_run/T27072w_c.c - testsuite/tests/codeGen/should_run/all.T - + testsuite/tests/overloadedstrings/should_fail/T25926.hs - + testsuite/tests/overloadedstrings/should_fail/T25926.stderr - + testsuite/tests/overloadedstrings/should_fail/T27124.hs - + testsuite/tests/overloadedstrings/should_fail/T27124.stderr - + testsuite/tests/overloadedstrings/should_fail/all.T - + testsuite/tests/overloadedstrings/should_run/T27124a.hs - testsuite/tests/overloadedstrings/should_run/all.T - + testsuite/tests/rts/linker/T27072/Lib.c - + testsuite/tests/rts/linker/T27072/Makefile - + testsuite/tests/rts/linker/T27072/T27072.stdout - + testsuite/tests/rts/linker/T27072/all.T - + testsuite/tests/rts/linker/T27072/main.c Changes: ===================================== changelog.d/T27124.md ===================================== @@ -0,0 +1,10 @@ +section: compiler +issues: #25926 #27124 +mrs: !15895 +synopsis: + Fix "failed to detect OverLit" panic in the pattern-match checker. +description: + Fixed an issue in which overloaded literals (e.g. numeric literals, overloaded + strings with -XOverloadedStrings, overloaded lists, etc) could cause a GHC + crash when using -fdefer-type-errors, with an error message of the form + "failed to detect OverLit". ===================================== changelog.d/fix-finalizers-27072 ===================================== @@ -0,0 +1,10 @@ +section: codegen +synopsis: Fix module finalizers on multiple platforms +description: { + GHC-generated module finalizers (e.g. ``hs_spt_remove`` for the Static + Pointer Table) now run correctly on ELF platforms, darwin, wasm32 and + Windows. Also fixes running finalizers when unloading objects with the + RTS linker. +} +issues: #27072 +mrs: !15762 ===================================== compiler/GHC/CoreToStg/Prep.hs ===================================== @@ -1125,6 +1125,9 @@ cpeApp top_env expr || f `hasKey` nospecIdKey -- Replace (nospec a) with a -- See Note [nospecId magic] in GHC.Types.Id.Make + -- NB: keep this in sync with GHC.HsToCore.Pmc.Solver.Types.coreExprAsPmLit, + -- as that also needs to see through these magic Ids. + -- Consider the code: -- -- lazy (f x) y ===================================== compiler/GHC/Driver/CodeOutput.hs ===================================== @@ -124,6 +124,7 @@ codeOutput logger tmpfs llvm_config dflags unit_state this_mod filenm location g { a <- linted_cmm_stream ; let stubs = genForeignStubs a ; emitInitializerDecls this_mod stubs + ; emitFinalizerDecls this_mod stubs ; return (stubs, a) } ; let dus1 = newTagDUniqSupply 'n' dus0 @@ -138,19 +139,23 @@ codeOutput logger tmpfs llvm_config dflags unit_state this_mod filenm location g } -- | See Note [Initializers and finalizers in Cmm] in GHC.Cmm.InitFini for details. -emitInitializerDecls :: Module -> ForeignStubs -> CgStream RawCmmGroup () -emitInitializerDecls this_mod (ForeignStubs _ cstub) - | initializers <- getInitializers cstub - , not $ null initializers = - let init_array = CmmData sect statics - lbl = mkInitializerArrayLabel this_mod - sect = Section InitArray lbl +emitInitializerDecls, emitFinalizerDecls :: Module -> ForeignStubs -> CgStream RawCmmGroup () +emitInitializerDecls = emitInitFiniArrayDecls InitArray mkInitializerArrayLabel getInitializers +emitFinalizerDecls = emitInitFiniArrayDecls FiniArray mkFinalizerArrayLabel getFinalizers + +emitInitFiniArrayDecls :: SectionType -> (Module -> CLabel) -> (CStub -> [CLabel]) + -> Module -> ForeignStubs -> CgStream RawCmmGroup () +emitInitFiniArrayDecls sect_type mk_lbl get_labels this_mod (ForeignStubs _ cstub) + | labels <- get_labels cstub + , not $ null labels = + let lbl = mk_lbl this_mod + sect = Section sect_type lbl statics = CmmStaticsRaw lbl [ CmmStaticLit $ CmmLabel fn_name - | fn_name <- initializers + | fn_name <- labels ] - in Stream.yield [init_array] -emitInitializerDecls _ _ = return () + in Stream.yield [CmmData sect statics] +emitInitFiniArrayDecls _ _ _ _ _ = return () doOutput :: String -> (Handle -> IO a) -> IO a doOutput filenm io_action = bracket (openFile filenm WriteMode) hClose io_action ===================================== compiler/GHC/HsToCore/Pmc/Solver/Types.hs ===================================== @@ -626,6 +626,15 @@ coreExprAsPmLit :: CoreExpr -> Maybe PmLit coreExprAsPmLit (Tick _t e) = coreExprAsPmLit e coreExprAsPmLit (Lit l) = literalToPmLit (literalType l) l coreExprAsPmLit e = case collectArgs e of + + -- Look through nospec, noinline and lazy, which are only eliminated by Core Prep. + -- See Note [coreExprAsPmLit and nospec] + (Var x, Type _ : inner : rest_args) + | x `hasKey` nospecIdKey + || x `hasKey` noinlineIdKey + || x `hasKey` lazyIdKey + -> coreExprAsPmLit (mkApps inner rest_args) + (Var x, [Lit l]) | Just dc <- isDataConWorkId_maybe x , dc `elem` [intDataCon, wordDataCon, charDataCon, floatDataCon, doubleDataCon] @@ -768,6 +777,34 @@ with large exponents case. This will return a `PmLitOverRat` literal. Which is then passed to overloadPmLit which simply returns it as-is since it's already overloaded. +Note [coreExprAsPmLit and nospec] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +For coverage checking, we need to analyse overloaded literal patterns to figure +out which literals they correspond to; this is what 'coreExprAsPmLit' does. +For example, the literal pattern "fromString" (with -XOverloadedStrings) +will turn into an equality check against the **expression** + + fromString @T $dFromString "hello"# + +and 'coreExprAsPmLit' recovers the string by taking apart this application. + +However, when $dFromString is non-canonical (e.g. when an INCOHERENT +instance was discarded during resolution of the typeclass constraint, or when +the dictionary comes from 'withDict'), the desugarer wraps 'fromString' in +'nospec' (as per Note [nospecId magic] in GHC.Types.Id.Make and +Note [Desugaring non-canonical evidence] in GHC.HsToCore.Expr): + + nospec @(IsString a => String -> Maybe a) fromString @T $dFromString "hello"# + +(For a full example, see test case T27124a.) + +The 'nospec' mechanism only exists for the specialiser; it should be transparent +to everything else. 'coreExprAsPmLit' must thus look through the 'nospec' +application in order obtain the string "hello". If it doesn't, we can't do +pattern match checking (in fact GHC.HsToCore.Pmc.Desugar.desugarPat is liable +to crash!). + +The same reasoning applies to `noinline` and `lazy`. -} instance Outputable PmLitValue where ===================================== compiler/GHC/Linker/Static.hs ===================================== @@ -241,7 +241,20 @@ linkBinary' staticLink logger tmpfs dflags unit_env o_files dep_units = do then ["-Wl,--gc-sections"] else []) - ++ o_files + -- On Windows, module .o files may be archives (see + -- Note [Object merging] in GHC.Driver.Pipeline.Execute). + -- Use --whole-archive to ensure all archive members are + -- included, especially those containing .ctors/.dtors + -- initializer/finalizer sections. See Note [Initializers and + -- finalizers in Cmm] in GHC.Cmm.InitFini. + ++ (if platformOS platform == OSMinGW32 + then ["-Wl,--whole-archive"] + else []) + ++ o_files + ++ (if platformOS platform == OSMinGW32 + then ["-Wl,--no-whole-archive"] + else []) + ++ lib_path_opts) ++ extra_ld_inputs ++ map GHC.SysTools.Option ( ===================================== compiler/GHC/Tc/Errors.hs ===================================== @@ -1217,11 +1217,11 @@ addDeferredBinding ctxt err (EI { ei_evdest = Just dest, ei_pred = item_ty ; case dest of EvVarDest evar - -> addTcEvBind ev_binds_var $ mkWantedEvBind evar EvNonCanonical err_tm + -> addTcEvBind ev_binds_var $ mkWantedEvBind evar EvCanonical err_tm HoleDest hole -> do { -- See Note [Deferred errors for coercion holes] let co_var = coHoleCoVar hole - ; addTcEvBind ev_binds_var $ mkWantedEvBind co_var EvNonCanonical err_tm + ; addTcEvBind ev_binds_var $ mkWantedEvBind co_var EvCanonical err_tm ; fillCoercionHole hole (mkCoVarCo co_var) } } addDeferredBinding _ _ _ = return () -- Do not set any evidence for Given ===================================== compiler/GHC/Types/ForeignStubs.hs ===================================== @@ -60,11 +60,85 @@ initializerCStub platform clbl declarations body = -- | @finalizerCStub fn_nm decls body@ is a 'CStub' containing C finalizer -- function (e.g. an entry of the @.fini_array@ section) named -- @fn_nm@ with the given body and the given set of declarations. +-- +-- See Note [Finalizers via __cxa_atexit] finalizerCStub :: Platform -> CLabel -> SDoc -> SDoc -> CStub -finalizerCStub platform clbl declarations body = - functionCStub platform clbl declarations body +finalizerCStub platform clbl declarations body + | ArchWasm32 <- platformArch platform + = -- See Note [Finalizers via __cxa_atexit] + cxaAtexitFinalizerCStub platform clbl declarations body +finalizerCStub platform clbl declarations body + | OSDarwin <- platformOS platform + = -- See Note [Finalizers via __cxa_atexit] + cxaAtexitFinalizerCStub platform clbl declarations body +finalizerCStub platform clbl declarations body + = functionCStub platform clbl declarations body `mappend` CStub empty [] [clbl] +-- | Generate a @__cxa_atexit@-based finalizer. +-- See Note [Finalizers via __cxa_atexit] +cxaAtexitFinalizerCStub :: Platform -> CLabel -> SDoc -> SDoc -> CStub +cxaAtexitFinalizerCStub platform clbl declarations body = + let clbl_pretty = pprCLabel platform clbl + fini_name = hcat [clbl_pretty, text "$fini"] + wrapper_name = hcat [clbl_pretty, text "$fini_atexit"] + c_code = vcat + [ declarations + , text "int __cxa_atexit(void (*)(void *), void *, void *);" + , hcat [text "static void ", fini_name, text "(void)"] + , braces body + , hcat [text "static void ", wrapper_name, text "(void *arg __attribute__((unused)))"] + , braces (hcat [fini_name, text "();"]) + , hsep [text "void", clbl_pretty, text "(void)"] + , braces (hcat [text "__cxa_atexit(", wrapper_name, text ", 0, 0);"]) + ] + in CStub c_code [clbl] [] + +{- +Note [Finalizers via __cxa_atexit] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +On some platforms, placing a function pointer in the .fini_array / +__mod_term_func section is not sufficient to have it called on exit. +On these platforms we instead lower finalizers as initializers that register +the actual finalizer function via __cxa_atexit. + +Affected platforms: + + Wasm32: does not support .fini_array sections. + + Darwin: modern macOS dyld no longer processes __DATA,__mod_term_func entries. + Clang now lowers __attribute__((destructor)) as an initializer that calls + __cxa_atexit, placing the initializer in __DATA,__mod_init_func (which the + linker converts to __TEXT,__init_offsets). GHC must follow the same pattern. + +For a finalizer with label `clbl` and body `body`, on these platforms we +generate: + + static void clbl$fini(void) { + <body> + } + static void clbl$fini_atexit(void *arg) { + clbl$fini(); + } + void clbl(void) { + __cxa_atexit(clbl$fini_atexit, 0, 0); + } + +The function `clbl` is placed in the initializers list (getInitializers) +instead of the finalizers list (getFinalizers). During code output, +emitInitializerDecls places it in .init_array / __mod_init_func, so the +registration runs at startup. + +The actual finalizer body is in the static helper `clbl$fini`. A separate +wrapper `clbl$fini_atexit` with the void(*)(void*) signature expected by +__cxa_atexit is needed because some platforms (e.g. wasm32) enforce exact +function signature matching at call sites — a simple cast would trap at +runtime. + +This matches what clang does when lowering __attribute__((destructor)) on +these platforms. +-} + newtype CHeader = CHeader { getCHeader :: SDoc } instance Monoid CHeader where ===================================== rts/Linker.c ===================================== @@ -1107,6 +1107,27 @@ freePreloadObjectFile (ObjectCode *oc) oc->fileSize = 0; } +/* Note [Object unloading and finalizers] + * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + * An ObjectCode may contain .fini_array/.dtors sections with finalizers that + * should run when the object is unloaded. However, we must only run these + * finalizers if the corresponding initializers (.init_array/.ctors) have + * actually been executed. + * + * Archive members start in OBJECT_LOADED state and only progress to + * OBJECT_NEEDED -> OBJECT_RESOLVED -> OBJECT_READY when a symbol from + * them is actually required. An archive member that was never needed never + * has its relocations applied, so its .fini_array section data still + * contains zeros (unresolved relocation targets). Running those finalizers + * would dereference NULL function pointers. + * + * When unloadObj sets an object's status to OBJECT_UNLOADED, it does so + * regardless of the previous state, so we cannot rely on the status alone + * to decide whether finalizers should run. Instead, we track whether + * initializers were executed via the initializersRan flag, which is set in + * ocRunInit after successfully running the initializers. + */ + /* * freeObjectCode() releases all the pieces of an ObjectCode. It is called by * the GC when a previously unloaded ObjectCode has been determined to be @@ -1116,11 +1137,9 @@ void freeObjectCode (ObjectCode *oc) { IF_DEBUG(linker, ocDebugBelch(oc, "freeObjectCode: start\n")); - // Run finalizers - if (oc->type == STATIC_OBJECT && - (oc->status == OBJECT_READY || oc->status == OBJECT_UNLOADED)) { - // Only run finalizers if the initializers have also been run, which - // happens when we resolve the object. + // Run finalizers only if initializers have been run. + // See Note [Object unloading and finalizers]. + if (oc->type == STATIC_OBJECT && oc->initializersRan) { #if defined(OBJFORMAT_ELF) ocRunFini_ELF(oc); #elif defined(OBJFORMAT_PEi386) @@ -1285,6 +1304,7 @@ mkOc( ObjectType type, pathchar *path, char *image, int imageSize, oc->imageMapped = mapped; oc->misalignment = misalignment; + oc->initializersRan = false; oc->cxa_finalize = NULL; oc->extraInfos = NULL; @@ -1681,6 +1701,7 @@ int ocRunInit(ObjectCode *oc) foreignExportsFinishedLoadingObject(); if (!r) { return r; } + oc->initializersRan = true; oc->status = OBJECT_READY; return 1; ===================================== rts/LinkerInternals.h ===================================== @@ -268,6 +268,12 @@ struct _ObjectCode { after allocation, so that we can use realloc */ int misalignment; + /* Set to true after initializers (.init_array, .ctors, etc.) have been + * executed. Used by freeObjectCode to decide whether finalizers should + * run: only objects whose initializers ran should have their finalizers + * executed. See Note [Object unloading and finalizers]. */ + bool initializersRan; + /* The address of __cxa_finalize; set when at least one finalizer was * register and therefore we must call __cxa_finalize before unloading. * See Note [Resolving __dso_handle]. */ ===================================== testsuite/tests/codeGen/should_run/T27072d.hs ===================================== @@ -0,0 +1,10 @@ +{-# LANGUAGE StaticPointers #-} +module T27072d where + +import GHC.StaticPtr + +f :: StaticPtr Int +f = static 1 + +g :: StaticPtr Int +g = static 2 ===================================== testsuite/tests/codeGen/should_run/T27072d.stdout ===================================== @@ -0,0 +1,2 @@ +SPT entries after init: 2 +SPT entries after finalizer: 0 ===================================== testsuite/tests/codeGen/should_run/T27072d_c.c ===================================== @@ -0,0 +1,38 @@ +// Test that GHC-generated module initializers and finalizer registrations +// work correctly on Darwin. +// +// On Darwin, GHC lowers finalizers as __cxa_atexit registrations from an +// initializer placed in __DATA,__mod_init_func (see Note [Finalizers via +// __cxa_atexit] in GHC.Types.ForeignStubs). +// +// This test verifies the mechanism by checking that: +// 1. The SPT initializer runs at load time (entries are inserted). +// 2. The SPT finalizer (registered via __cxa_atexit from __mod_init_func) +// fires during exit() and removes the entries. +// +// We verify (2) by registering our own __cxa_atexit checker from a +// constructor in a dylib that is loaded before the main executable's +// initializers run. Since __cxa_atexit handlers fire in LIFO order, +// a handler registered earlier runs later — so our checker runs after the +// GHC-generated finalizer, and can observe that SPT entries were removed. +// +// The Apple linker does not support --wrap, so this is the Darwin +// equivalent of T27072w's approach. + +#include "Rts.h" +#include + +extern int hs_spt_key_count(void); + +int main(int argc, char *argv[]) { + RtsConfig conf = defaultRtsConfig; + conf.rts_opts_enabled = RtsOptsAll; + hs_init_ghc(&argc, &argv, conf); + + printf("SPT entries after init: %d\n", hs_spt_key_count()); + fflush(stdout); + + // Do NOT call hs_exit(). Return normally so __cxa_atexit handlers fire, + // which includes the GHC-generated finalizer registered during init. + return 0; +} ===================================== testsuite/tests/codeGen/should_run/T27072d_check.c ===================================== @@ -0,0 +1,29 @@ +// Checker dylib for T27072d. +// +// Compiled as a dylib and linked against the test executable. Because dylib +// initializers run before the main executable's __mod_init_func entries, +// our __cxa_atexit registration happens first. Since __cxa_atexit handlers +// fire in LIFO order, our checker runs *after* the GHC-generated finalizer, +// allowing us to observe that SPT entries were removed. + +#include + +// Provided by the RTS. +extern int hs_spt_key_count(void); + +static void check_spt_finalizer(void *arg __attribute__((unused))) { + int count = hs_spt_key_count(); + printf("SPT entries after finalizer: %d\n", count); + fflush(stdout); +} + +// Register the checker. This constructor runs during dylib initialization, +// which happens before the main executable's initializers. +__attribute__((constructor)) +static void register_spt_checker(void) { + // Use __cxa_atexit so we participate in the same LIFO chain as the + // GHC-generated finalizer. + extern int __cxa_atexit(void (*)(void *), void *, void *); + extern void *__dso_handle; + __cxa_atexit(check_spt_finalizer, (void *)0, &__dso_handle); +} ===================================== testsuite/tests/codeGen/should_run/T27072w.hs ===================================== @@ -0,0 +1,10 @@ +{-# LANGUAGE StaticPointers #-} +module T27072w where + +import GHC.StaticPtr + +f :: StaticPtr Int +f = static 1 + +g :: StaticPtr Int +g = static 2 ===================================== testsuite/tests/codeGen/should_run/T27072w.stdout ===================================== @@ -0,0 +1,3 @@ +SPT entries after init: 2 +finalizer: hs_spt_remove called +finalizer: hs_spt_remove called ===================================== testsuite/tests/codeGen/should_run/T27072w_c.c ===================================== @@ -0,0 +1,32 @@ +// Test that GHC-generated finalizers actually run on wasm32 +// +// We use --wrap=hs_spt_remove to intercept calls from the GHC-generated +// finalizer and verify they happen during exit(). + +#include "Rts.h" +#include + +extern int hs_spt_key_count(void); + +// --wrap=hs_spt_remove: the linker redirects all calls to hs_spt_remove +// through our wrapper, and provides __real_hs_spt_remove for the original. +extern void __real_hs_spt_remove(StgWord64 key[2]); + +void __wrap_hs_spt_remove(StgWord64 key[2]) { + printf("finalizer: hs_spt_remove called\n"); + fflush(stdout); + __real_hs_spt_remove(key); +} + +int main(int argc, char *argv[]) { + RtsConfig conf = defaultRtsConfig; + conf.rts_opts_enabled = RtsOptsAll; + hs_init_ghc(&argc, &argv, conf); + + printf("SPT entries after init: %d\n", hs_spt_key_count()); + fflush(stdout); + + // Do NOT call hs_exit(). Return normally so exit() fires the + // __cxa_atexit registered handlers. + return 0; +} ===================================== testsuite/tests/codeGen/should_run/all.T ===================================== @@ -256,3 +256,22 @@ test('T24893', normal, compile_and_run, ['-O']) test('CCallConv', [req_c], compile_and_run, ['CCallConv_c.c']) test('T26061', normal, compile_and_run, ['']) test('T26537', js_broken(26558), compile_and_run, ['-O2 -fregs-graph']) + +# Check that GHC-generated finalizers run on Darwin. The Apple linker doesn't +# support --wrap, so we can't intercept hs_spt_remove directly. Instead we +# compile a small checker dylib (T27072d_check.c) whose constructor registers +# a __cxa_atexit handler *before* the executable's __mod_init_func entries run. +# LIFO ordering ensures the checker fires after the GHC-generated finalizer, +# so it can observe that SPT entries were removed. +# Requires dynamic way so the RTS is a dylib (avoids archive conflicts). +test('T27072d', [req_c, only_ways(['dyn']), when(not opsys('darwin'), skip), + pre_cmd('{compiler} -shared -no-hs-main' + ' -optl -undefined -optl dynamic_lookup' + ' -o T27072d_check.dylib T27072d_check.c')], + compile_and_run, + ['T27072d_c.c -no-hs-main' + ' -optl -Wl,-needed_library,T27072d_check.dylib -optl -rpath -optl .']) +# check that finalizers are being run, using --wrap to intercept hs_spt_remove. +# Skipped on Darwin (Apple linker doesn't support --wrap). +test('T27072w', [req_c, js_skip, when(opsys('darwin'), skip)], + compile_and_run, ['T27072w_c.c -no-hs-main -optl-Wl,--wrap=hs_spt_remove']) ===================================== testsuite/tests/overloadedstrings/should_fail/T25926.hs ===================================== @@ -0,0 +1,4 @@ +module T25926 where + +f () 0 = () +f 'a' _ = () ===================================== testsuite/tests/overloadedstrings/should_fail/T25926.stderr ===================================== @@ -0,0 +1,5 @@ +T25926.hs:4:3: warning: [GHC-83865] [-Wdeferred-type-errors (in -Wdefault)] + • Couldn't match expected type ‘()’ with actual type ‘Char’ + • In the pattern: 'a' + In an equation for ‘f’: f 'a' _ = () + ===================================== testsuite/tests/overloadedstrings/should_fail/T27124.hs ===================================== @@ -0,0 +1,9 @@ +{-# LANGUAGE OverloadedStrings #-} + +module T27124 where + +foo :: [String] -> Bool +foo "HI" = True +foo _ = False + +main = pure () ===================================== testsuite/tests/overloadedstrings/should_fail/T27124.stderr ===================================== @@ -0,0 +1,6 @@ +T27124.hs:6:5: warning: [GHC-18872] [-Wdeferred-type-errors (in -Wdefault)] + • Couldn't match type ‘[Char]’ with ‘Char’ + arising from the literal ‘"HI"’ + • In the pattern: "HI" + In an equation for ‘foo’: foo "HI" = True + ===================================== testsuite/tests/overloadedstrings/should_fail/all.T ===================================== @@ -0,0 +1,2 @@ +test('T25926', normal, compile, ['-fdefer-type-errors']) +test('T27124', normal, compile, ['-fdefer-type-errors']) ===================================== testsuite/tests/overloadedstrings/should_run/T27124a.hs ===================================== @@ -0,0 +1,23 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE OverloadedStrings #-} + +module T27124a where + +import Data.String (IsString(..)) + +newtype Wrap a = Wrap a deriving (Eq, Show) + +instance IsString a => IsString (Wrap a) where + fromString = Wrap . fromString + +instance {-# INCOHERENT #-} IsString (Wrap Bool) where + fromString _ = Wrap False + +f :: (Eq a, IsString a) => Wrap a -> Bool +f "hello" = True +f _ = False + +main :: IO () +main = do + print (f (Wrap ("hello" :: String))) + print (f (Wrap ("world" :: String))) ===================================== testsuite/tests/overloadedstrings/should_run/all.T ===================================== @@ -1 +1,2 @@ test('overloadedstringsrun01', normal, compile_and_run, ['']) +test('T27124a', normal, compile, ['-fno-specialise-incoherents']) ===================================== testsuite/tests/rts/linker/T27072/Lib.c ===================================== @@ -0,0 +1,18 @@ +// Minimal module with an initializer and finalizer. +// The compiler places the function pointers in .init_array/.fini_array +// (ELF) or __mod_init_func/__mod_term_func (Mach-O). +// +// The counter lives in the main binary so it survives after this +// object is unloaded. + +extern int init_counter; + +__attribute__((constructor)) +static void lib_init(void) { + init_counter++; +} + +__attribute__((destructor)) +static void lib_fini(void) { + init_counter--; +} ===================================== testsuite/tests/rts/linker/T27072/Makefile ===================================== @@ -0,0 +1,21 @@ +.PHONY: clean_build_and_run build_and_run clean build + +clean_build_and_run: + $(MAKE) clean + $(MAKE) build_and_run + +build_and_run: build + ./main + +clean: + $(RM) Lib.o main.o main + +build: Lib.o main + +Lib.o: Lib.c + $(CC) -c -fPIC Lib.c -o Lib.o + +main: main.c + "$(TEST_HC)" $(filter-out -rtsopts, $(TEST_HC_OPTS)) \ + -no-hs-main -optc-Werror \ + main.c -o main ===================================== testsuite/tests/rts/linker/T27072/T27072.stdout ===================================== @@ -0,0 +1,3 @@ +counter before load: 0 +counter after load: 1 +counter after unload: 0 ===================================== testsuite/tests/rts/linker/T27072/all.T ===================================== @@ -0,0 +1,6 @@ +test('T27072', + [req_rts_linker, + js_skip, + extra_files(['Lib.c', 'main.c'])], + makefile_test, + ['clean_build_and_run']) ===================================== testsuite/tests/rts/linker/T27072/main.c ===================================== @@ -0,0 +1,57 @@ +// Test that the RTS linker executes .init_array entries on load and +// .fini_array entries on unload. The loaded module increments a +// counter in its initializer and decrements it in its finalizer. + +#include "Rts.h" +#include + +#if defined(mingw32_HOST_OS) +#define PATH_STR(str) L##str +#else +#define PATH_STR(str) str +#endif + +int init_counter = 0; + +int main(int argc, char *argv[]) { + RtsConfig conf = defaultRtsConfig; + conf.rts_opts_enabled = RtsOptsAll; + hs_init_ghc(&argc, &argv, conf); + + initLinker_(0); + insertSymbol(PATH_STR("main"), "init_counter", &init_counter); + + printf("counter before load: %d\n", init_counter); + fflush(stdout); + + int ok; + ok = loadObj(PATH_STR("Lib.o")); + if (!ok) { + errorBelch("loadObj(Lib.o) failed"); + return 1; + } + ok = resolveObjs(); + if (!ok) { + errorBelch("resolveObjs() failed"); + return 1; + } + + printf("counter after load: %d\n", init_counter); + fflush(stdout); + + ok = unloadObj(PATH_STR("Lib.o")); + if (!ok) { + errorBelch("unloadObj(Lib.o) failed"); + return 1; + } + + // GC triggers actual unloading and finalizer execution. + performMajorGC(); + performMajorGC(); + + printf("counter after unload: %d\n", init_counter); + fflush(stdout); + + hs_exit(); + return 0; +} View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/52db07c24dff2bc047ece1ef13ca436... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/52db07c24dff2bc047ece1ef13ca436... You're receiving this email because of your account on gitlab.haskell.org.