diff options
8 files changed, 40 insertions, 4 deletions
diff --git a/compiler/GHC/Driver/Make.hs b/compiler/GHC/Driver/Make.hs index efaefd84f5..1968bfa954 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 c09d778086..29d2356a75 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 @@ -121,6 +122,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 |