From 8db8d2fd1c881032b1b360c032b6d9d072c11723 Mon Sep 17 00:00:00 2001
From: Zubin Duggal <zubin.duggal@gmail.com>
Date: Fri, 1 Dec 2023 11:51:42 +0530
Subject: [PATCH] driver: Don't lose track of nodes when we fail to resolve
 cycles

The nodes that take part in a cycle should include both hs-boot and hs files,
but when we fail to resolve a cycle, we were only counting the nodes from the
graph without boot files.

Fixes #24196
---
 compiler/GHC/Driver/Make.hs                   | 8 ++++----
 testsuite/tests/driver/T24196/T24196.stderr   | 4 ++++
 testsuite/tests/driver/T24196/T24196A.hs      | 1 +
 testsuite/tests/driver/T24196/T24196A.hs-boot | 3 +++
 testsuite/tests/driver/T24196/T24196B.hs      | 3 +++
 testsuite/tests/driver/T24196/all.T           | 1 +
 6 files changed, 16 insertions(+), 4 deletions(-)
 create mode 100644 testsuite/tests/driver/T24196/T24196.stderr
 create mode 100644 testsuite/tests/driver/T24196/T24196A.hs
 create mode 100644 testsuite/tests/driver/T24196/T24196A.hs-boot
 create mode 100644 testsuite/tests/driver/T24196/T24196B.hs
 create mode 100644 testsuite/tests/driver/T24196/all.T

diff --git a/compiler/GHC/Driver/Make.hs b/compiler/GHC/Driver/Make.hs
index bac99883e2c5..6b69d3606dbb 100644
--- a/compiler/GHC/Driver/Make.hs
+++ b/compiler/GHC/Driver/Make.hs
@@ -608,7 +608,7 @@ createBuildPlan mod_graph maybe_top_mod =
               -- Now perform another toposort but just with these nodes and relevant hs-boot files.
               -- The result should be acyclic, if it's not, then there's an unresolved cycle in the graph.
               mresolved_cycle = collapseSCC (topSortWithBoot nodes)
-          in acyclic ++ [maybe (UnresolvedCycle nodes) ResolvedCycle mresolved_cycle] ++ toBuildPlan sccs []
+          in acyclic ++ [either UnresolvedCycle ResolvedCycle mresolved_cycle] ++ toBuildPlan sccs []
 
         (mg, lookup_node) = moduleGraphNodes False (mgModSummaries' mod_graph)
         trans_deps_map = allReachable mg (mkNodeKey . node_payload)
@@ -639,12 +639,12 @@ createBuildPlan mod_graph maybe_top_mod =
         get_boot_module m = case m of ModuleNode _ ms | HsSrcFile <- ms_hsc_src ms -> lookupModuleEnv boot_modules (ms_mod ms); _ -> Nothing
 
         -- Any cycles should be resolved now
-        collapseSCC :: [SCC ModuleGraphNode] -> Maybe [(Either ModuleGraphNode ModuleGraphNodeWithBootFile)]
+        collapseSCC :: [SCC ModuleGraphNode] -> Either [ModuleGraphNode] [(Either ModuleGraphNode ModuleGraphNodeWithBootFile)]
         -- Must be at least two nodes, as we were in a cycle
-        collapseSCC [AcyclicSCC node1, AcyclicSCC node2] = Just [toNodeWithBoot node1, toNodeWithBoot node2]
+        collapseSCC [AcyclicSCC node1, AcyclicSCC node2] = Right [toNodeWithBoot node1, toNodeWithBoot node2]
         collapseSCC (AcyclicSCC node : nodes) = (toNodeWithBoot node :) <$> collapseSCC nodes
         -- Cyclic
-        collapseSCC _ = Nothing
+        collapseSCC nodes = Left (flattenSCCs nodes)
 
         toNodeWithBoot :: ModuleGraphNode -> Either ModuleGraphNode ModuleGraphNodeWithBootFile
         toNodeWithBoot mn =
diff --git a/testsuite/tests/driver/T24196/T24196.stderr b/testsuite/tests/driver/T24196/T24196.stderr
new file mode 100644
index 000000000000..af11bbe0e1fc
--- /dev/null
+++ b/testsuite/tests/driver/T24196/T24196.stderr
@@ -0,0 +1,4 @@
+Module graph contains a cycle:
+        module ‘T24196A’ (./T24196A.hs-boot)
+        imports module ‘T24196B’ (T24196B.hs)
+  which imports module ‘T24196A’ (./T24196A.hs-boot)
diff --git a/testsuite/tests/driver/T24196/T24196A.hs b/testsuite/tests/driver/T24196/T24196A.hs
new file mode 100644
index 000000000000..231f8f6e6871
--- /dev/null
+++ b/testsuite/tests/driver/T24196/T24196A.hs
@@ -0,0 +1 @@
+module T24196A where
diff --git a/testsuite/tests/driver/T24196/T24196A.hs-boot b/testsuite/tests/driver/T24196/T24196A.hs-boot
new file mode 100644
index 000000000000..6b036443f35c
--- /dev/null
+++ b/testsuite/tests/driver/T24196/T24196A.hs-boot
@@ -0,0 +1,3 @@
+module T24196A where
+
+import T24196B
diff --git a/testsuite/tests/driver/T24196/T24196B.hs b/testsuite/tests/driver/T24196/T24196B.hs
new file mode 100644
index 000000000000..b6de161446d0
--- /dev/null
+++ b/testsuite/tests/driver/T24196/T24196B.hs
@@ -0,0 +1,3 @@
+module T24196B where
+
+import {-# SOURCE #-} T24196A
diff --git a/testsuite/tests/driver/T24196/all.T b/testsuite/tests/driver/T24196/all.T
new file mode 100644
index 000000000000..c5519da4886c
--- /dev/null
+++ b/testsuite/tests/driver/T24196/all.T
@@ -0,0 +1 @@
+test('T24196', extra_files(['T24196A.hs','T24196A.hs-boot','T24196B.hs']), multimod_compile_fail, ['T24196B',''])
-- 
GitLab