Add regressiontest for #18045

Issue #18045 got fixed by !6971.

4 files changed, 49 insertions, 0 deletions

diff --git a/testsuite/tests/ghci.debugger/scripts/T18045.hs b/testsuite/tests/ghci.debugger/scripts/T18045.hs
new file mode 100644
index 0000000000..2bb9b90d05
--- /dev/null
+++ b/testsuite/tests/ghci.debugger/scripts/T18045.hs
@@ -0,0 +1,29 @@
+import qualified Data.IntSet as IntSet
+import Data.Array
+
+newtype Graph = Graph { neighbors :: Array Int [Int] }
+
+readGraph :: [[Int]] -> Graph
+readGraph ([n] : edges) = ans  where
+  ans = Graph $ accumArray (flip (:)) [] (1, n) edgesTwice
+  edgesTwice = concat [[(u, v), (v, u)] | [u, v] <- edges]
+readGraph _ = error "readGraph: bad format"
+
+bfs :: Graph -> Int -> Array Int Int
+-- returns an array with the distance from each node to the start node
+bfs g start = array (bounds (neighbors g)) $ assocList  where
+  assocList = _bfs 0 IntSet.empty (IntSet.singleton start)
+  _bfs dist visited currs = if  IntSet.null currs
+    then  []
+    else  map (\x -> (x, dist)) currli ++ _bfs (dist+1) nvisit ncurr  where
+      currli = IntSet.toList currs
+      nvisit = IntSet.union visited currs
+      ncurr = IntSet.difference nbrs nvisit
+      nbrs = IntSet.fromList (concatMap (neighbors g !) currli)
+
+solve :: [[Int]] -> [Int]
+solve li@(_:edges) = map ((`mod` 2) . (bfs (readGraph li) 1 !) . head) edges
+solve _ = error "no input?"
+
+parse :: String -> [[Int]]
+parse = map (map read . words) . lines
diff --git a/testsuite/tests/ghci.debugger/scripts/T18045.script b/testsuite/tests/ghci.debugger/scripts/T18045.script
new file mode 100644
index 0000000000..31eb17dc0d
--- /dev/null
+++ b/testsuite/tests/ghci.debugger/scripts/T18045.script
@@ -0,0 +1,5 @@
+:load T18045
+:break 18
+solve [[3],[1,2],[2,3]]
+:continue
+dist
diff --git a/testsuite/tests/ghci.debugger/scripts/T18045.stdout b/testsuite/tests/ghci.debugger/scripts/T18045.stdout
new file mode 100644
index 0000000000..7ca60b28b0
--- /dev/null
+++ b/testsuite/tests/ghci.debugger/scripts/T18045.stdout
@@ -0,0 +1,14 @@
+Breakpoint 0 activated at T18045.hs:18:11-68
+[Stopped in Main.bfs._bfs, T18045.hs:18:11-68
+_result :: [(IntSet.Key, Int)] = _
+currli :: [IntSet.Key] = _
+dist :: Int = 0
+ncurr :: IntSet.IntSet = _
+nvisit :: IntSet.IntSet = _
+Stopped in Main.bfs._bfs, T18045.hs:18:11-68
+_result :: [(IntSet.Key, Int)] = _
+currli :: [IntSet.Key] = _
+dist :: Int = _
+ncurr :: IntSet.IntSet = _
+nvisit :: IntSet.IntSet = _
+1
diff --git a/testsuite/tests/ghci.debugger/scripts/all.T b/testsuite/tests/ghci.debugger/scripts/all.T
index 661c75e4ad..3f1fc88644 100644
--- a/testsuite/tests/ghci.debugger/scripts/all.T
+++ b/testsuite/tests/ghci.debugger/scripts/all.T
@@ -124,6 +124,7 @@ test('T16700', normal, ghci_script, ['T16700.script'])
 test('break029', extra_files(['break029.hs']), ghci_script, ['break029.script'])
 test('T2215', normal, ghci_script, ['T2215.script'])
 test('T17989', normal, ghci_script, ['T17989.script'])
+test('T18045', normal, ghci_script, ['T18045.script'])
 test('T19157', normal, ghci_script, ['T19157.script'])
 test('T19355', normal, ghci_script, ['T19355.script'])
 test('T19394', normal, ghci_script, ['T19394.script'])