RtClosureInspect: Fix off-by-one error in cvReconstructType
authormniip <mniip@mniip.com>
Tue, 23 Aug 2016 17:19:02 +0000 (13:19 -0400)
committerBen Gamari <ben@smart-cactus.org>
Tue, 30 Aug 2016 16:10:59 +0000 (12:10 -0400)
Replaced error-prone index manipulation on a pointer array with
a simple fold on the array elements.

Test Plan: Added a test case that triggers the bug

Reviewers: hvr, austin, bgamari

Reviewed By: bgamari

Subscribers: simonpj, thomie

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

GHC Trac Issues: #12458

(cherry picked from commit 1766bb3cfd1460796c78bd5651f89d53603586f9)

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

index 86e9a00..9ed6cfb 100644 (file)
@@ -905,10 +905,9 @@ cvReconstructType hsc_env max_depth old_ty hval = runTR_maybe hsc_env $ do
         (_,mb_dc)    <- tryTcErrs (tcLookupDataCon dcname)
         case mb_dc of
           Nothing-> do
-                     --  TODO: Check this case
-            forM [0..length (elems $ ptrs clos)] $ \i -> do
-                        tv <- newVar liftedTypeKind
-                        return$ appArr (\e->(tv,e)) (ptrs clos) i
+            forM (elems $ ptrs clos) $ \a -> do
+              tv <- newVar liftedTypeKind
+              return (tv, a)
 
           Just dc -> do
             arg_tys <- getDataConArgTys dc my_ty
diff --git a/testsuite/tests/ghci.debugger/scripts/T12458.script b/testsuite/tests/ghci.debugger/scripts/T12458.script
new file mode 100644 (file)
index 0000000..5d4120d
--- /dev/null
@@ -0,0 +1,4 @@
+data D a = D
+d = D
+:print d
+d `seq` ()
diff --git a/testsuite/tests/ghci.debugger/scripts/T12458.stdout b/testsuite/tests/ghci.debugger/scripts/T12458.stdout
new file mode 100644 (file)
index 0000000..2a616b0
--- /dev/null
@@ -0,0 +1,2 @@
+d = (_t1::D a)
+()
index 28089a2..b74a6ea 100644 (file)
@@ -87,3 +87,4 @@ test('T2740', normal, ghci_script, ['T2740.script'])
 test('getargs', normal, ghci_script, ['getargs.script'])
 test('T7386', normal, ghci_script, ['T7386.script'])
 test('T8557', normal, ghci_script, ['T8557.script'])
+test('T12458', normal, ghci_script, ['T12458.script'])