summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMatthew Pickering <matthewtpickering@gmail.com>2022-07-04 12:10:50 +0100
committerBen Gamari <ben@smart-cactus.org>2022-07-14 14:02:08 -0400
commita5e8523c8233548860515c5b432584c4ae2ec5f1 (patch)
treed6c7ebae58fc5897dc1337794678d57e1552195a
parent78623f8f2f3653c7debbbd1e0f2ce767c4310f9a (diff)
downloadhaskell-a5e8523c8233548860515c5b432584c4ae2ec5f1.tar.gz
driver: Fix issue with module loops and multiple home units
We were attempting to rehydrate all dependencies of a particular module, but we actually only needed to rehydrate those of the current package (as those are the ones participating in the loop). This fixes loading GHC into a multi-unit session. Fixes #21814 (cherry picked from commit 665fa5a73e385bdfce13180048701a179ec3f36a)
-rw-r--r--compiler/GHC/Driver/Make.hs20
-rw-r--r--compiler/GHC/Unit/Module/Graph.hs6
-rw-r--r--testsuite/tests/driver/multipleHomeUnits/all.T2
-rw-r--r--testsuite/tests/driver/multipleHomeUnits/loop/Loop.hs5
-rw-r--r--testsuite/tests/driver/multipleHomeUnits/loop/Loop.hs-boot1
-rw-r--r--testsuite/tests/driver/multipleHomeUnits/loop/Loop1.hs5
-rw-r--r--testsuite/tests/driver/multipleHomeUnits/multipleHomeUnits_loop.stderr4
-rw-r--r--testsuite/tests/driver/multipleHomeUnits/unitLoop1
8 files changed, 40 insertions, 4 deletions
diff --git a/compiler/GHC/Driver/Make.hs b/compiler/GHC/Driver/Make.hs
index dfc0af7e38..2b8c2a734d 100644
--- a/compiler/GHC/Driver/Make.hs
+++ b/compiler/GHC/Driver/Make.hs
@@ -591,11 +591,18 @@ createBuildPlan mod_graph maybe_top_mod =
(mg, lookup_node) = moduleGraphNodes False (mgModSummaries' mod_graph)
trans_deps_map = allReachable mg (mkNodeKey . node_payload)
+ -- Compute the intermediate modules between a file and its hs-boot file.
+ -- See Step 2a in Note [Upsweep]
boot_path mn uid =
map (summaryNodeSummary . expectJust "toNode" . lookup_node) $ Set.toList $
+ -- Don't include the boot module itself
Set.delete (NodeKey_Module (key IsBoot)) $
- expectJust "boot_path" (M.lookup (NodeKey_Module (key NotBoot)) trans_deps_map)
- `Set.difference` (expectJust "boot_path" (M.lookup (NodeKey_Module (key IsBoot)) trans_deps_map))
+ -- Keep intermediate dependencies: as per Step 2a in Note [Upsweep], these are
+ -- the transitive dependencies of the non-boot file which transitively depend
+ -- on the boot file.
+ Set.filter (\nk -> nodeKeyUnitId nk == uid -- Cheap test
+ && (NodeKey_Module (key IsBoot)) `Set.member` expectJust "dep_on_boot" (M.lookup nk trans_deps_map)) $
+ expectJust "not_boot_dep" (M.lookup (NodeKey_Module (key NotBoot)) trans_deps_map)
where
key ib = ModNodeKeyWithUid (GWIB mn ib) uid
@@ -894,8 +901,13 @@ Step 1: Topologically sort the module graph without hs-boot files. This returns
Step 2: For each cycle, topologically sort the modules in the cycle *with* the relevant hs-boot files. This should
result in an acyclic build plan if the hs-boot files are sufficient to resolve the cycle.
Step 2a: For each module in the cycle, if the module has a boot file then compute the
- modules on the path between it and the hs-boot file. This information is
- stored in ModuleGraphNodeWithBoot.
+ modules on the path between it and the hs-boot file.
+ These are the intermediate modules which:
+ (1) are (transitive) dependencies of the non-boot module, and
+ (2) have the boot module as a (transitive) dependency.
+ In particular, all such intermediate modules must appear in the same unit as
+ the module under consideration, as module cycles cannot cross unit boundaries.
+ This information is stored in ModuleGraphNodeWithBoot.
The `[BuildPlan]` is then interpreted by the `interpretBuildPlan` function.
diff --git a/compiler/GHC/Unit/Module/Graph.hs b/compiler/GHC/Unit/Module/Graph.hs
index 42d3e068b4..ceae3683ea 100644
--- a/compiler/GHC/Unit/Module/Graph.hs
+++ b/compiler/GHC/Unit/Module/Graph.hs
@@ -28,6 +28,7 @@ module GHC.Unit.Module.Graph
, summaryNodeSummary
, NodeKey(..)
+ , nodeKeyUnitId
, ModNodeKey
, mkNodeKey
, msKey
@@ -120,6 +121,11 @@ pprNodeKey (NodeKey_Unit iu) = ppr iu
pprNodeKey (NodeKey_Module mk) = ppr mk
pprNodeKey (NodeKey_Link uid) = ppr uid
+nodeKeyUnitId :: NodeKey -> UnitId
+nodeKeyUnitId (NodeKey_Unit iu) = instUnitInstanceOf iu
+nodeKeyUnitId (NodeKey_Module mk) = mnkUnitId mk
+nodeKeyUnitId (NodeKey_Link uid) = uid
+
data ModNodeKeyWithUid = ModNodeKeyWithUid { mnkModuleName :: ModuleNameWithIsBoot
, mnkUnitId :: UnitId } deriving (Eq, Ord)
diff --git a/testsuite/tests/driver/multipleHomeUnits/all.T b/testsuite/tests/driver/multipleHomeUnits/all.T
index c2bbf0f368..53090f2e68 100644
--- a/testsuite/tests/driver/multipleHomeUnits/all.T
+++ b/testsuite/tests/driver/multipleHomeUnits/all.T
@@ -55,3 +55,5 @@ test('multipleHomeUnitsPackageImports',
], multiunit_compile, [['unitB', 'unitB2', 'unitPI'], '-fhide-source-paths'])
test('MHU_OptionsGHC', normal, compile_fail, [''])
+
+test('multipleHomeUnits_loop', [extra_files([ 'a/', 'unitA', 'loop', 'unitLoop'])], multiunit_compile, [['unitA', 'unitLoop'], '-fhide-source-paths'])
diff --git a/testsuite/tests/driver/multipleHomeUnits/loop/Loop.hs b/testsuite/tests/driver/multipleHomeUnits/loop/Loop.hs
new file mode 100644
index 0000000000..c4c3de9a5d
--- /dev/null
+++ b/testsuite/tests/driver/multipleHomeUnits/loop/Loop.hs
@@ -0,0 +1,5 @@
+module Loop where
+
+import Loop1
+
+import A
diff --git a/testsuite/tests/driver/multipleHomeUnits/loop/Loop.hs-boot b/testsuite/tests/driver/multipleHomeUnits/loop/Loop.hs-boot
new file mode 100644
index 0000000000..aa7d4f4ac5
--- /dev/null
+++ b/testsuite/tests/driver/multipleHomeUnits/loop/Loop.hs-boot
@@ -0,0 +1 @@
+module Loop where
diff --git a/testsuite/tests/driver/multipleHomeUnits/loop/Loop1.hs b/testsuite/tests/driver/multipleHomeUnits/loop/Loop1.hs
new file mode 100644
index 0000000000..140c34b6f5
--- /dev/null
+++ b/testsuite/tests/driver/multipleHomeUnits/loop/Loop1.hs
@@ -0,0 +1,5 @@
+module Loop1 where
+
+import {-# SOURCE #-} Loop
+
+import A
diff --git a/testsuite/tests/driver/multipleHomeUnits/multipleHomeUnits_loop.stderr b/testsuite/tests/driver/multipleHomeUnits/multipleHomeUnits_loop.stderr
new file mode 100644
index 0000000000..7045bacb64
--- /dev/null
+++ b/testsuite/tests/driver/multipleHomeUnits/multipleHomeUnits_loop.stderr
@@ -0,0 +1,4 @@
+[1 of 4] Compiling A[a]
+[2 of 4] Compiling Loop[boot][loop]
+[3 of 4] Compiling Loop1[loop]
+[4 of 4] Compiling Loop[loop]
diff --git a/testsuite/tests/driver/multipleHomeUnits/unitLoop b/testsuite/tests/driver/multipleHomeUnits/unitLoop
new file mode 100644
index 0000000000..baddcf0220
--- /dev/null
+++ b/testsuite/tests/driver/multipleHomeUnits/unitLoop
@@ -0,0 +1 @@
+-i -i./loop Loop Loop1 -package-id a -this-unit-id loop