Fix the GHCi debugger with ApplicativeDo
authorSimon Marlow <marlowsd@gmail.com>
Sun, 22 Jul 2018 15:03:33 +0000 (17:03 +0200)
committerBen Gamari <ben@smart-cactus.org>
Tue, 31 Jul 2018 19:53:19 +0000 (15:53 -0400)
Summary:
`collectLStmtsBinders` was returning nothing for `ApplicativeStmts`, which
caused the debugger to not track free variables in many cases when using
`ApplicativeDo`.

Test Plan:
* new test case
* validate

Reviewers: bgamari, erikd

Reviewed By: bgamari

Subscribers: rwbarton, thomie, carter

GHC Trac Issues: #15422

Differential Revision: https://phabricator.haskell.org/D4991

(cherry picked from commit 4ea9311cc5c3b99ea6915bee23f0a6776731f20e)

compiler/hsSyn/HsUtils.hs
testsuite/tests/ghci.debugger/scripts/all.T
testsuite/tests/ghci.debugger/scripts/break029.hs [new file with mode: 0644]
testsuite/tests/ghci.debugger/scripts/break029.script [new file with mode: 0644]
testsuite/tests/ghci.debugger/scripts/break029.stdout [new file with mode: 0644]

index a759f1a..eba21cf 100644 (file)
@@ -1035,7 +1035,11 @@ collectStmtBinders (ParStmt _ xs _ _)      = collectLStmtsBinders
                                     $ [s | ParStmtBlock _ ss _ _ <- xs, s <- ss]
 collectStmtBinders (TransStmt { trS_stmts = stmts }) = collectLStmtsBinders stmts
 collectStmtBinders (RecStmt { recS_stmts = ss })     = collectLStmtsBinders ss
-collectStmtBinders ApplicativeStmt{} = []
+collectStmtBinders (ApplicativeStmt _ args _) = concatMap collectArgBinders args
+ where
+  collectArgBinders (_, ApplicativeArgOne _ pat _ _) = collectPatBinders pat
+  collectArgBinders (_, ApplicativeArgMany _ _ _ pat) = collectPatBinders pat
+  collectArgBinders _ = []
 collectStmtBinders XStmtLR{} = panic "collectStmtBinders"
 
 
index f2e2658..dd122ca 100644 (file)
@@ -99,3 +99,5 @@ test('T8557', normal, ghci_script, ['T8557.script'])
 test('T12458', normal, ghci_script, ['T12458.script'])
 test('T13825-debugger', when(arch('powerpc64'), expect_broken(14455)),
       ghci_script, ['T13825-debugger.script'])
+
+test('break029', extra_files(['break029.hs']), ghci_script, ['break029.script'])
diff --git a/testsuite/tests/ghci.debugger/scripts/break029.hs b/testsuite/tests/ghci.debugger/scripts/break029.hs
new file mode 100644 (file)
index 0000000..7598d3f
--- /dev/null
@@ -0,0 +1,6 @@
+{-# LANGUAGE ApplicativeDo #-}
+
+f :: Int -> IO Int
+f x = do
+  y <- return (x + 1)
+  return (y * 2)
diff --git a/testsuite/tests/ghci.debugger/scripts/break029.script b/testsuite/tests/ghci.debugger/scripts/break029.script
new file mode 100644 (file)
index 0000000..b2e70b1
--- /dev/null
@@ -0,0 +1,5 @@
+:load break029.hs
+:step f 3
+:step
+:step
+y
diff --git a/testsuite/tests/ghci.debugger/scripts/break029.stdout b/testsuite/tests/ghci.debugger/scripts/break029.stdout
new file mode 100644 (file)
index 0000000..c1d7047
--- /dev/null
@@ -0,0 +1,10 @@
+Stopped in Main.f, break029.hs:(4,7)-(6,16)
+_result :: IO Int = _
+x :: Int = 3
+Stopped in Main.f, break029.hs:5:8-21
+_result :: IO Int = _
+x :: Int = 3
+Stopped in Main.f, break029.hs:6:11-15
+_result :: Int = _
+y :: Int = _
+4