Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 4a7ddc7b by Sylvain Henry at 2026-03-07T05:04:59-05:00 JS: fix linking of exposed but non-preload units (#24886) Units exposed in the unit database but not explicitly passed on the command-line were not considered by the JS linker. This isn't an issue for cabal which passes every unit explicitly but it is an issue when using GHC directly (cf T24886 test). - - - - - 15 changed files: - compiler/GHC/Driver/Main.hs - compiler/GHC/Runtime/Interpreter/JS.hs - testsuite/tests/ghci/should_run/all.T - + testsuite/tests/javascript/T24886.hs - + testsuite/tests/javascript/T24886.stderr - + testsuite/tests/javascript/T24886.stdout - testsuite/tests/javascript/all.T - testsuite/tests/overloadedrecflds/should_compile/all.T - testsuite/tests/overloadedrecflds/should_run/all.T - testsuite/tests/quasiquotation/qq005/test.T - testsuite/tests/quasiquotation/qq006/test.T - testsuite/tests/saks/should_compile/all.T - testsuite/tests/showIface/all.T - testsuite/tests/th/all.T - testsuite/tests/vdq-rta/should_compile/all.T Changes: ===================================== compiler/GHC/Driver/Main.hs ===================================== @@ -2910,7 +2910,7 @@ jsCodeGen hsc_env srcspan i this_mod stg_binds_with_deps binding_id = do initLoaderState interp hsc_env -- Take lock for the actual work. - (dep_linkables, dep_units) <- modifyLoaderState interp $ \pls -> do + (dep_linkables, needed_units) <- modifyLoaderState interp $ \pls -> do let link_opts = initLinkDepsOpts hsc_env -- Find what packages and linkables are required @@ -2924,13 +2924,8 @@ jsCodeGen hsc_env srcspan i this_mod stg_binds_with_deps binding_id = do -- FIXME: we should make the JS linker load new_objs here, instead of -- on-demand. - -- FIXME: we don't report needed units because we would have to find a way - -- to build a meaningful LoadedPkgInfo (see the mess in - -- GHC.Linker.Loader.{loadPackage,loadPackages'}). Detecting what to load - -- and actually loading (using the native interpreter) are intermingled, so - -- we can't directly reuse this code. let pls' = pls { objs_loaded = objs_loaded' } - pure (pls', (ldAllLinkables deps, emptyUDFM {- ldNeededUnits deps -}) ) + pure (pls', (ldAllLinkables deps, ldUnits deps)) let foreign_stubs = NoStubs @@ -2945,7 +2940,7 @@ jsCodeGen hsc_env srcspan i this_mod stg_binds_with_deps binding_id = do -- link code containing binding "id_sym = expr", using id_sym as root withJSInterp i $ \inst -> do let roots = mkExportedModFuns this_mod [id_sym] - jsLinkObject logger tmpfs tmp_dir js_config unit_env inst out_obj roots + jsLinkObject logger tmpfs tmp_dir js_config unit_env inst out_obj roots needed_units -- look up "id_sym" closure and create a StablePtr (HValue) from it href <- lookupClosure interp (IFaststringSymbol id_sym) >>= \case @@ -2955,7 +2950,11 @@ jsCodeGen hsc_env srcspan i this_mod stg_binds_with_deps binding_id = do binding_fref <- withJSInterp i $ \inst -> mkForeignRef href (freeReallyRemoteRef inst href) - return (castForeignRef binding_fref, dep_linkables, dep_units) + -- FIXME: we don't report needed units because we would have to find a way to + -- build a meaningful LoadedPkgInfo (see the mess in + -- GHC.Linker.Loader.{loadPackage,loadPackages'}). + let pkgs_loaded = emptyUDFM + return (castForeignRef binding_fref, dep_linkables, pkgs_loaded) {- ********************************************************************** ===================================== compiler/GHC/Runtime/Interpreter/JS.hs ===================================== @@ -287,8 +287,8 @@ jsLinkInterp logger tmpfs tmp_dir cfg unit_env inst = do -- | Link object files -jsLinkObjects :: Logger -> TmpFs -> TempDir -> StgToJSConfig -> UnitEnv -> ExtInterpInstance JSInterpExtra -> [FilePath] -> (ExportedFun -> Bool) -> IO () -jsLinkObjects logger tmpfs tmp_dir cfg unit_env inst objs is_root = do +jsLinkObjects :: Logger -> TmpFs -> TempDir -> StgToJSConfig -> UnitEnv -> ExtInterpInstance JSInterpExtra -> [FilePath] -> (ExportedFun -> Bool) -> [UnitId] -> IO () +jsLinkObjects logger tmpfs tmp_dir cfg unit_env inst objs is_root extra_units = do let link_cfg = JSLinkConfig { lcNoStats = True -- we don't need the stats , lcNoRts = True -- we don't need the RTS (already linked) @@ -300,7 +300,7 @@ jsLinkObjects logger tmpfs tmp_dir cfg unit_env inst objs is_root = do , lcLinkCsources = True -- enable C sources, if any } - let units = preloadUnits (ue_homeUnitState unit_env) + let units = preloadUnits (ue_homeUnitState unit_env) ++ extra_units -- compute dependencies let link_spec = LinkSpec @@ -322,11 +322,11 @@ jsLinkObjects logger tmpfs tmp_dir cfg unit_env inst objs is_root = do -- | Link an object file using the given functions as roots -jsLinkObject :: Logger -> TmpFs -> TempDir -> StgToJSConfig -> UnitEnv -> ExtInterpInstance JSInterpExtra -> FilePath -> [ExportedFun] -> IO () -jsLinkObject logger tmpfs tmp_dir cfg unit_env inst obj roots = do +jsLinkObject :: Logger -> TmpFs -> TempDir -> StgToJSConfig -> UnitEnv -> ExtInterpInstance JSInterpExtra -> FilePath -> [ExportedFun] -> [UnitId] -> IO () +jsLinkObject logger tmpfs tmp_dir cfg unit_env inst obj roots extra_units = do let is_root f = Set.member f (Set.fromList roots) let objs = [obj] - jsLinkObjects logger tmpfs tmp_dir cfg unit_env inst objs is_root + jsLinkObjects logger tmpfs tmp_dir cfg unit_env inst objs is_root extra_units -- | Link the given link plan ===================================== testsuite/tests/ghci/should_run/all.T ===================================== @@ -91,7 +91,7 @@ test('T22958a', just_ghci, compile_and_run, ['']) test('T22958b', just_ghci, compile_and_run, ['']) test('T22958c', just_ghci, compile_and_run, ['']) test('GhciMainIs', just_ghci, compile_and_run, ['-main-is otherMain']) -test('LargeBCO', [extra_files(['LargeBCO_A.hs']), req_interp, extra_hc_opts("-O -fbyte-code-and-object-code -fprefer-byte-code")], compile_and_run, ['']) +test('LargeBCO', [extra_files(['LargeBCO_A.hs']), req_th, extra_hc_opts("-O -fbyte-code-and-object-code -fprefer-byte-code")], compile_and_run, ['']) test('T24115', just_ghci + [extra_run_opts("-e ':add T24115.hs'")], ghci_script, ['T24115.script']) ===================================== testsuite/tests/javascript/T24886.hs ===================================== @@ -0,0 +1,12 @@ +{-# LANGUAGE TemplateHaskell #-} +module T24886 where + +import GHC.Exts.Heap +import Control.Monad.IO.Class + +-- this is a TH splice importing from ghc-heap, testing that the JS linker +-- can find the ghc-heap package during TH evaluation (see #24886) +do + let !_b = asBox "foo" + liftIO $ putStrLn "ok" + return [] ===================================== testsuite/tests/javascript/T24886.stderr ===================================== @@ -0,0 +1 @@ +ok ===================================== testsuite/tests/javascript/T24886.stdout ===================================== @@ -0,0 +1 @@ +ok ===================================== testsuite/tests/javascript/all.T ===================================== @@ -27,3 +27,4 @@ test('T23479', normal, makefile_test, ['T23479']) test('T24744', normal, makefile_test, ['T24744']) test('T25633', normal, compile_and_run, ['']) +test('T24886', normal, compile, ['']) ===================================== testsuite/tests/overloadedrecflds/should_compile/all.T ===================================== @@ -48,7 +48,7 @@ test('BootFldReexport' # the final module (BootFldReexport), but not fail earlier. , ['BootFldReexport', '-v0']) test('T23220' - , [req_th, extra_files(['T23220_aux.hs']), js_broken(24886)] + , [req_th, extra_files(['T23220_aux.hs'])] , multimod_compile, ['T23220_aux.hs T23220.hs', '-v0']) test('T22106_A', [extra_files(['T22106_aux.hs'])], multimod_compile, ['T22106_A', '-v0']) test('T22106_B', [extra_files(['T22106_aux.hs'])], multimod_compile, ['T22106_B', '-v0']) ===================================== testsuite/tests/overloadedrecflds/should_run/all.T ===================================== @@ -3,7 +3,7 @@ test('overloadedrecfldsrun01', [], multimod_compile_and_run, test('overloadedrecfldsrun02', [extra_files(['OverloadedRecFldsRun02_A.hs'])], multimod_compile_and_run, ['overloadedrecfldsrun02', '']) test('overloadedrecfldsrun03', normal, compile_and_run, ['']) -test('overloadedrecfldsrun04', [req_th,omit_ways(prof_ways), js_broken(24886)], compile_and_run, ['']) +test('overloadedrecfldsrun04', [req_th,omit_ways(prof_ways)], compile_and_run, ['']) test('overloadedrecfldsrun05', normal, compile_and_run, ['']) test('overloadedrecfldsrun07', normal, compile_and_run, ['']) test('overloadedrecflds_generics', normal, compile_and_run, ['']) ===================================== testsuite/tests/quasiquotation/qq005/test.T ===================================== @@ -5,6 +5,6 @@ test('qq005', # profiling ways, due to the TH use, so for now we just # omit the profiling ways omit_ways(prof_ways), - req_interp], + req_th], multimod_compile_and_run, ['Main', '']) ===================================== testsuite/tests/quasiquotation/qq006/test.T ===================================== @@ -1,4 +1,4 @@ test('qq006', [extra_files(['Expr.hs', 'Main.hs']), when(fast(), skip), - req_interp], multimod_compile_fail, + req_th], multimod_compile_fail, ['Main', '-v0']) ===================================== testsuite/tests/saks/should_compile/all.T ===================================== @@ -37,5 +37,5 @@ test('T16721', normal, ghci_script, ['T16721.script']) test('T16756a', normal, compile, ['']) test('saks027', req_th, compile, ['-v0 -ddump-splices -dsuppress-uniques']) -test('saks028', [req_th, js_broken(24886)], compile, ['']) +test('saks028', req_th, compile, ['']) test('T17164', req_th, compile, ['-v0 -ddump-splices -dsuppress-uniques']) ===================================== testsuite/tests/showIface/all.T ===================================== @@ -3,7 +3,7 @@ test('DocsInHiFile0', extra_files(['DocsInHiFile.hs']), makefile_test, []) test('DocsInHiFile1', extra_files(['DocsInHiFile.hs']), makefile_test, []) test('T17871', [extra_files(['T17871a.hs'])], multimod_compile, ['T17871', '-v0']) test('DocsInHiFileTH', - [extra_files(['DocsInHiFileTHExternal.hs', 'DocsInHiFileTH.hs']), req_th, js_broken(24886)], + [extra_files(['DocsInHiFileTHExternal.hs', 'DocsInHiFileTH.hs']), req_th], makefile_test, []) test('NoExportList', normal, makefile_test, []) test('PragmaDocs', normal, makefile_test, []) ===================================== testsuite/tests/th/all.T ===================================== @@ -321,7 +321,7 @@ test('T1476', normal, compile, ['-v0']) test('T1476b', normal, compile, ['-v0']) test('T8031', normal, compile, ['-v0']) test('T8624', only_ways(['normal']), makefile_test, ['T8624']) -test('TH_Lift', js_broken(24886), compile, ['-v0 -ddump-splices -dsuppress-uniques']) +test('TH_Lift', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques']) test('T10047', only_ways(['ghci']), ghci_script, ['T10047.script']) test('T10019', only_ways(['ghci']), ghci_script, ['T10019.script']) test('T10267', [], multimod_compile_fail, ===================================== testsuite/tests/vdq-rta/should_compile/all.T ===================================== @@ -30,8 +30,8 @@ test('T25127_infix', normal, compile, ['']) test('T22326_th_dump1', req_th, compile, ['-v0 -ddump-splices -dsuppress-uniques']) test('T23739_th_dump1', req_th, compile, ['-v0 -ddump-splices -dsuppress-uniques']) -test('T22326_th_pprint1', [req_th, js_broken(24886)], compile, ['']) -test('T23739_th_pprint1', [req_th, js_broken(24886)], compile, ['']) +test('T22326_th_pprint1', req_th, compile, ['']) +test('T23739_th_pprint1', req_th, compile, ['']) test('T23738_th', req_th, compile, ['']) test('T24159_viewpat', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4a7ddc7b8ce8dae666fd511eddee12aa... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4a7ddc7b8ce8dae666fd511eddee12aa... You're receiving this email because of your account on gitlab.haskell.org.