Cheng Shao pushed to branch wip/use-less-appendfs at Glasgow Haskell Compiler / GHC Commits: 04d143c0 by Luite Stegeman at 2026-04-21T14:05:33-04:00 rts: add a few missing i386 relocations in the rts linker - - - - - 014087e7 by Luite Stegeman at 2026-04-21T14:05:34-04: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 - - - - - 915bba6f by Simon Jakobi at 2026-04-21T14:06:16-04:00 Add regression test for #10531 Closes #10531. - - - - - fdffd1ab by Cheng Shao at 2026-04-22T12:34:53+00:00 compiler: avoid unused temporary `appendFS` operands This patch fixes unused temporary `appendFS` operands in the codebase that are retained in the `FastString` table after concatenation. Rewrite rules are added so that if an operand is `fsLit`/`mkFastString`, the `appendFS` application is rewritten to append the `ShortByteString` operands first. The patch also fixes `sconcat` behavior to align with `mconcat` for the same reason. Fixes #27205. - - - - - 27 changed files: - + changelog.d/fix-finalizers-27072 - compiler/GHC/Data/FastString.hs - compiler/GHC/Driver/CodeOutput.hs - compiler/GHC/Linker/Executable.hs - compiler/GHC/Types/ForeignStubs.hs - rts/Linker.c - rts/LinkerInternals.h - rts/linker/Elf.c - + 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/driver/T10531/A.hs - + testsuite/tests/driver/T10531/B.hs - + testsuite/tests/driver/T10531/C.hs - + testsuite/tests/driver/T10531/Makefile - + testsuite/tests/driver/T10531/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 - testsuite/tests/th/all.T Changes: ===================================== 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/Data/FastString.hs ===================================== @@ -139,6 +139,7 @@ import Foreign.C import System.IO import Data.Data import Data.IORef +import qualified Data.List.NonEmpty as NE import Data.Semigroup as Semi import Foreign @@ -232,6 +233,7 @@ instance IsString FastString where instance Semi.Semigroup FastString where (<>) = appendFS + sconcat = concatFS . NE.toList instance Monoid FastString where mempty = nilFS @@ -619,6 +621,21 @@ unpackFS fs = utf8DecodeShortByteString $ fs_sbs fs zEncodeFS :: FastString -> FastZString zEncodeFS fs = fs_zenc fs +{-# RULES +"appendFS/mkFastString" forall x y. + appendFS x (mkFastString y) = + mkFastStringShortByteString $ + fs_sbs x Semi.<> utf8EncodeShortByteString y + #-} + +{-# RULES +"appendFS/mkFastString" forall x y. + appendFS (mkFastString x) y = + mkFastStringShortByteString $ + utf8EncodeShortByteString x Semi.<> fs_sbs y + #-} + +{-# INLINE[1] appendFS #-} appendFS :: FastString -> FastString -> FastString appendFS fs1 fs2 = mkFastStringShortByteString $ (Semi.<>) (fs_sbs fs1) (fs_sbs fs2) @@ -711,5 +728,19 @@ ptrStrLength (Ptr a) = I# (cstringLength# a) fsLit :: String -> FastString fsLit x = mkFastString x +{-# RULES +"appendFS/fsLit" forall x y. + appendFS x (fsLit y) = + mkFastStringShortByteString $ + fs_sbs x Semi.<> utf8EncodeShortByteString y + #-} + +{-# RULES +"appendFS/fsLit" forall x y. + appendFS (fsLit x) y = + mkFastStringShortByteString $ + utf8EncodeShortByteString x Semi.<> fs_sbs y + #-} + {-# RULES "fslit" forall x . fsLit (unpackCString# x) = mkFastString# x #-} ===================================== compiler/GHC/Driver/CodeOutput.hs ===================================== @@ -119,6 +119,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 CodeGenTag dus0 @@ -133,19 +134,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/Linker/Executable.hs ===================================== @@ -300,7 +300,19 @@ linkExecutable logger tmpfs opts unit_env o_files dep_units = do then ["-Wl,--gc-sections"] else []) + -- 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/Types/ForeignStubs.hs ===================================== @@ -59,11 +59,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 ===================================== @@ -1117,6 +1117,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 @@ -1126,11 +1147,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) @@ -1295,6 +1314,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; @@ -1691,6 +1711,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]. */ ===================================== rts/linker/Elf.c ===================================== @@ -1308,6 +1308,16 @@ do_Elf_Rel_relocations ( ObjectCode* oc, char* ehdrC, case COMPAT_R_386_NONE: break; case COMPAT_R_386_32: *pP = value; break; case COMPAT_R_386_PC32: *pP = value - P; break; + case COMPAT_R_386_PLT32: *pP = value - P; break; + case COMPAT_R_386_GOTOFF: *pP = value - (Elf_Addr)oc->info->got_start; break; + case COMPAT_R_386_GOTPC: *pP = (Elf_Addr)oc->info->got_start + A - P; break; + case COMPAT_R_386_GOT32: + case COMPAT_R_386_GOT32X: + CHECK(symbol); + CHECK(symbol->got_addr); + *pP = (Elf_Addr)symbol->got_addr + - (Elf_Addr)oc->info->got_start + A; + break; # endif # if defined(arm_HOST_ARCH) ===================================== 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 <stdio.h> + +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 <stdio.h> + +// 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 <stdio.h> + +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 ===================================== @@ -260,3 +260,22 @@ test('T25364', normal, compile_and_run, ['']) test('T26061', normal, compile_and_run, ['']) test('T26537', normal, compile_and_run, ['-O2 -fregs-graph']) test('T24016', normal, compile_and_run, ['-O1 -fPIC']) + +# 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/driver/T10531/A.hs ===================================== @@ -0,0 +1,4 @@ +module A where + +main :: IO () +main = putStrLn "A" ===================================== testsuite/tests/driver/T10531/B.hs ===================================== @@ -0,0 +1,6 @@ +module B where + +import A () + +main :: IO () +main = putStrLn "B" ===================================== testsuite/tests/driver/T10531/C.hs ===================================== @@ -0,0 +1,4 @@ +import B () + +main :: IO () +main = putStrLn "hi" ===================================== testsuite/tests/driver/T10531/Makefile ===================================== @@ -0,0 +1,14 @@ +TOP=../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk + +# Test for #10531, a recompilation bug with '-main-is'. + +T10531: + '$(TEST_HC)' $(TEST_HC_OPTS) -Wall A.hs -main-is A.main -o a + '$(TEST_HC)' $(TEST_HC_OPTS) -Wall B.hs -main-is B.main -o b + '$(TEST_HC)' $(TEST_HC_OPTS) -Wall C.hs -o c + rm -f A.o + '$(TEST_HC)' $(TEST_HC_OPTS) -Wall A.hs -main-is A.main -o a + '$(TEST_HC)' $(TEST_HC_OPTS) -Wall B.hs -main-is B.main -o b + ./b$(exeext) ===================================== testsuite/tests/driver/T10531/all.T ===================================== @@ -0,0 +1 @@ +test('T10531', [extra_files(['A.hs', 'B.hs', 'C.hs']), ignore_stdout], makefile_test, []) ===================================== 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 <stdio.h> + +#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; +} ===================================== testsuite/tests/th/all.T ===================================== @@ -636,7 +636,6 @@ test('T25209', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques']) test('TH_MultilineStrings', normal, compile_and_run, ['']) test('T25252', [extra_files(['T25252B.hs', 'T25252_c.c']), - when(arch('i386'), expect_broken_for(25260,['ext-interp'])), req_th, req_c], compile_and_run, ['-fPIC T25252_c.c']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/aa00bea01696fafc92cd29f538a0278... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/aa00bea01696fafc92cd29f538a0278... You're receiving this email because of your account on gitlab.haskell.org.