From 550af50559931b7681fe24fddafd6e3467de077c Mon Sep 17 00:00:00 2001
From: Sylvain Henry <sylvain@haskus.fr>
Date: Thu, 6 Jul 2023 15:59:38 +0200
Subject: [PATCH] JS: support -this-unit-id for programs in the linker (#23613)
---
compiler/GHC/StgToJS/Linker/Linker.hs | 2 +-
testsuite/tests/driver/T23613.hs | 4 ++++
testsuite/tests/driver/all.T | 7 ++++---
testsuite/tests/driver/multipleHomeUnits/all.T | 6 ++----
testsuite/tests/driver/multipleHomeUnits/hi-dir/all.T | 1 -
testsuite/tests/driver/multipleHomeUnits/o-files/all.T | 1 -
.../tests/driver/multipleHomeUnits/target-file-path/all.T | 1 -
7 files changed, 11 insertions(+), 11 deletions(-)
create mode 100644 testsuite/tests/driver/T23613.hs
diff --git a/compiler/GHC/StgToJS/Linker/Linker.hs b/compiler/GHC/StgToJS/Linker/Linker.hs
index 58bcdf2de906..530f8730c6b6 100644
--- a/compiler/GHC/StgToJS/Linker/Linker.hs
+++ b/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
diff --git a/testsuite/tests/driver/T23613.hs b/testsuite/tests/driver/T23613.hs
new file mode 100644
index 000000000000..d82a4bd93b7e
--- /dev/null
+++ b/testsuite/tests/driver/T23613.hs
@@ -0,0 +1,4 @@
+module Main where
+
+main :: IO ()
+main = return ()
diff --git a/testsuite/tests/driver/all.T b/testsuite/tests/driver/all.T
index 4196dad0e9dd..ad480efea956 100644
--- a/testsuite/tests/driver/all.T
+++ b/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'])
diff --git a/testsuite/tests/driver/multipleHomeUnits/all.T b/testsuite/tests/driver/multipleHomeUnits/all.T
index 6b2ad64eb5ef..f748b6013dfa 100644
--- a/testsuite/tests/driver/multipleHomeUnits/all.T
+++ b/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',
diff --git a/testsuite/tests/driver/multipleHomeUnits/hi-dir/all.T b/testsuite/tests/driver/multipleHomeUnits/hi-dir/all.T
index 887bf5838a03..0dcb2fb607bb 100644
--- a/testsuite/tests/driver/multipleHomeUnits/hi-dir/all.T
+++ b/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'])
diff --git a/testsuite/tests/driver/multipleHomeUnits/o-files/all.T b/testsuite/tests/driver/multipleHomeUnits/o-files/all.T
index 7fd69eeb404e..0133545ea933 100644
--- a/testsuite/tests/driver/multipleHomeUnits/o-files/all.T
+++ b/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'])
diff --git a/testsuite/tests/driver/multipleHomeUnits/target-file-path/all.T b/testsuite/tests/driver/multipleHomeUnits/target-file-path/all.T
index 8a46f7f061bf..74d9baf9534f 100644
--- a/testsuite/tests/driver/multipleHomeUnits/target-file-path/all.T
+++ b/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'])
--
GitLab