[Git][ghc/ghc][master] JS: support -this-unit-id for programs in the linker (#23613)

[Marge Bot (@marge-bot)]

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC


Commits:
550af505 by Sylvain Henry at 2023-07-08T19:33:28-04:00
JS: support -this-unit-id for programs in the linker (#23613)

- - - - -


7 changed files:

- compiler/GHC/StgToJS/Linker/Linker.hs
- + testsuite/tests/driver/T23613.hs
- testsuite/tests/driver/all.T
- testsuite/tests/driver/multipleHomeUnits/all.T
- testsuite/tests/driver/multipleHomeUnits/hi-dir/all.T
- testsuite/tests/driver/multipleHomeUnits/o-files/all.T
- testsuite/tests/driver/multipleHomeUnits/target-file-path/all.T


Changes:

=====================================
compiler/GHC/StgToJS/Linker/Linker.hs
=====================================
@@ -327,7 +327,7 @@ computeLinkDependencies cfg unit_env link_spec finder_opts finder_cache = do
   let (rts_wired_units, rts_wired_functions) = rtsDeps units
 
   -- all the units we want to link together, without their dependencies
-  let root_units = filter (/= mainUnitId)
+  let root_units = filter (/= ue_currentUnit unit_env)
                    $ filter (/= interactiveUnitId)
                    $ nub
                    $ rts_wired_units ++ reverse obj_units ++ reverse units


=====================================
testsuite/tests/driver/T23613.hs
=====================================
@@ -0,0 +1,4 @@
+module Main where
+
+main :: IO ()
+main = return ()


=====================================
testsuite/tests/driver/all.T
=====================================
@@ -320,6 +320,7 @@ test('T21869', [js_broken(22261), when(unregisterised(), skip)], makefile_test,
 test('T22044', normal, makefile_test, [])
 test('T22048', [only_ways(['normal']), grep_errmsg("_rule")], compile, ["-O -fomit-interface-pragmas -ddump-simpl"])
 test('T21722', normal, compile_fail, ['-fno-show-error-context'])
-test('T22669', js_skip, makefile_test, [])
-test('T23339', js_skip, makefile_test, [])
-test('T23339B', [extra_files(['T23339.hs']), js_skip], makefile_test, [])
+test('T22669', req_interp, makefile_test, [])
+test('T23339', req_c, makefile_test, [])
+test('T23339B', [extra_files(['T23339.hs']), req_c], makefile_test, [])
+test('T23613', normal, compile_and_run, ['-this-unit-id=foo'])


=====================================
testsuite/tests/driver/multipleHomeUnits/all.T
=====================================
@@ -1,7 +1,7 @@
 test('multipleHomeUnits_single1', [extra_files([ 'a/', 'unitA'])], multiunit_compile, [['unitA'], '-fhide-source-paths'])
 test('multipleHomeUnits_single2', [extra_files([ 'b/', 'unitB'])], multiunit_compile, [['unitB'], '-fhide-source-paths'])
-test('multipleHomeUnits_single3', [js_broken(22261),extra_files([ 'c/', 'unitC'])], multiunit_compile, [['unitC'], '-fhide-source-paths'])
-test('multipleHomeUnits_single4', [js_broken(22261),extra_files([ 'd/', 'unitD'])], multiunit_compile, [['unitD'], '-fhide-source-paths'])
+test('multipleHomeUnits_single3', [extra_files([ 'c/', 'unitC'])], multiunit_compile, [['unitC'], '-fhide-source-paths'])
+test('multipleHomeUnits_single4', [extra_files([ 'd/', 'unitD'])], multiunit_compile, [['unitD'], '-fhide-source-paths'])
 test('multipleHomeUnits_single5', [req_th,extra_files([ 'th/', 'unitTH'])], multiunit_compile, [['unitTH'], '-fhide-source-paths'])
 test('multipleHomeUnits_cpp', [extra_files([ 'cpp-includes/', 'unitCPPIncludes'])], multiunit_compile, [['unitCPPIncludes'], '-fhide-source-paths'])
 test('multipleHomeUnits_cfile', [extra_files([ 'c-file/', 'unitCFile'])], multiunit_compile, [['unitCFile'], '-fhide-source-paths'])
@@ -24,14 +24,12 @@ test('multipleHomeUnits002',
     [ extra_files(
         [ 'c/', 'd/'
         , 'unitC', 'unitD'])
-    , js_broken(22261)
     ], makefile_test, [])
 
 test('multipleHomeUnits003',
     [ extra_files(
         [ 'a/', 'b/', 'c/', 'd/'
         , 'unitA', 'unitB', 'unitC', 'unitD'])
-    , js_broken(22261)
     ], makefile_test, [])
 
 test('multipleHomeUnits004',


=====================================
testsuite/tests/driver/multipleHomeUnits/hi-dir/all.T
=====================================
@@ -1,7 +1,6 @@
 # This test checks that getRootSummary doesn't cross package boundaries.
 test('multipleHomeUnits_hidir'
     , [extra_files([ 'p1/', 'unitP1'])
-      , js_broken(22261)
       ]
     , makefile_test
     , ['mhu-hidir'])


=====================================
testsuite/tests/driver/multipleHomeUnits/o-files/all.T
=====================================
@@ -1,7 +1,6 @@
 # This test checks that getRootSummary doesn't cross package boundaries.
 test('multipleHomeUnits_o-files'
     , [extra_files([ 'p1/', 'unitP1'])
-      , js_broken(22261)
       , pre_cmd('$MAKE -s --no-print-directory setup')]
     , multiunit_compile
     , [['unitP1'], '-fhide-source-paths'])


=====================================
testsuite/tests/driver/multipleHomeUnits/target-file-path/all.T
=====================================
@@ -1,7 +1,6 @@
 # This test checks that getRootSummary doesn't cross package boundaries.
 test('multipleHomeUnits_target-file-path'
     , [extra_files([ 'p1/', 'unitP1'])
-      , js_broken(22261)
       ]
     , multiunit_compile
     , [['unitP1'], '-fhide-source-paths'])



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/550af50559931b7681fe24fddafd6e3467de077c

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/550af50559931b7681fe24fddafd6e3467de077c
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/20230708/76242a53/attachment-0001.html>