[commit: ghc] master: RtClosureInspect: Fix off-by-one error in cvReconstructType (1766bb3)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/1766bb3cfd1460796c78bd5651f89d53603586f9/ghc

>---------------------------------------------------------------

commit 1766bb3cfd1460796c78bd5651f89d53603586f9
Author: mniip <mniip at mniip.com>
Date:   Tue Aug 23 13:19:02 2016 -0400

    RtClosureInspect: Fix off-by-one error in cvReconstructType
    
    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


>---------------------------------------------------------------

1766bb3cfd1460796c78bd5651f89d53603586f9
 compiler/ghci/RtClosureInspect.hs                   | 7 +++----
 testsuite/tests/ghci.debugger/scripts/T12458.script | 4 ++++
 testsuite/tests/ghci.debugger/scripts/T12458.stdout | 2 ++
 testsuite/tests/ghci.debugger/scripts/all.T         | 1 +
 4 files changed, 10 insertions(+), 4 deletions(-)

diff --git a/compiler/ghci/RtClosureInspect.hs b/compiler/ghci/RtClosureInspect.hs
index 7a59847..c487bc1 100644
--- a/compiler/ghci/RtClosureInspect.hs
+++ b/compiler/ghci/RtClosureInspect.hs
@@ -898,10 +898,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
index 0000000..5d4120d
--- /dev/null
+++ b/testsuite/tests/ghci.debugger/scripts/T12458.script
@@ -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
index 0000000..2a616b0
--- /dev/null
+++ b/testsuite/tests/ghci.debugger/scripts/T12458.stdout
@@ -0,0 +1,2 @@
+d = (_t1::D a)
+()
diff --git a/testsuite/tests/ghci.debugger/scripts/all.T b/testsuite/tests/ghci.debugger/scripts/all.T
index b17d205..6571c7f 100644
--- a/testsuite/tests/ghci.debugger/scripts/all.T
+++ b/testsuite/tests/ghci.debugger/scripts/all.T
@@ -86,3 +86,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'])