Use the right type in :force
authorSimon Peyton Jones <simonpj@microsoft.com>
Fri, 8 Nov 2019 09:22:02 +0000 (09:22 +0000)
committerMarge Bot <ben+marge-bot@smart-cactus.org>
Sat, 9 Nov 2019 23:04:14 +0000 (18:04 -0500)
A missing prime meant that we were considering the wrong
type in the GHCi debugger, when doing :force on multiple
arguments (issue #17431).

The fix is trivial.

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

index d803c0b..a9bf9a8 100644 (file)
@@ -74,7 +74,8 @@ pprintClosureCommand bindThings force str = do
    -- Do the obtainTerm--bindSuspensions-computeSubstitution dance
    go :: GhcMonad m => TCvSubst -> Id -> m (TCvSubst, Term)
    go subst id = do
-       let id' = id `setIdType` substTy subst (idType id)
+       let id_ty' = substTy subst (idType id)
+           id'    = id `setIdType` id_ty'
        term_    <- GHC.obtainTermFromId maxBound force id'
        term     <- tidyTermTyVars term_
        term'    <- if bindThings
@@ -85,13 +86,14 @@ pprintClosureCommand bindThings force str = do
      --  mapping the old tyvars to the reconstructed types.
        let reconstructed_type = termType term
        hsc_env <- getSession
-       case (improveRTTIType hsc_env (idType id) (reconstructed_type)) of
+       case (improveRTTIType hsc_env id_ty' reconstructed_type) of
          Nothing     -> return (subst, term')
          Just subst' -> do { dflags <- GHC.getSessionDynFlags
                            ; liftIO $
                                dumpIfSet_dyn dflags Opt_D_dump_rtti "RTTI"
                                  (fsep $ [text "RTTI Improvement for", ppr id,
-                                  text "is the substitution:" , ppr subst'])
+                                  text "old substitution:" , ppr subst,
+                                  text "new substitution:" , ppr subst'])
                            ; return (subst `unionTCvSubst` subst', term')}
 
    tidyTermTyVars :: GhcMonad m => Term -> m Term
diff --git a/testsuite/tests/ghci/scripts/T17431.hs b/testsuite/tests/ghci/scripts/T17431.hs
new file mode 100644 (file)
index 0000000..7805057
--- /dev/null
@@ -0,0 +1,10 @@
+module T17431 (sort) where
+
+sort :: Ord a => [a] -> [a]
+sort [] = []
+sort (x:xs) = insert x (sort xs)
+
+insert :: Ord a => a -> [a] -> [a]
+insert x [] = [x]
+insert x (y:ys) | x < y     = x:y:ys
+                | otherwise = y:(insert x ys)
diff --git a/testsuite/tests/ghci/scripts/T17431.script b/testsuite/tests/ghci/scripts/T17431.script
new file mode 100644 (file)
index 0000000..a53dcf4
--- /dev/null
@@ -0,0 +1,4 @@
+:l T17431
+:br 5
+sort [3,2,1]
+:force x xs _result
diff --git a/testsuite/tests/ghci/scripts/T17431.stdout b/testsuite/tests/ghci/scripts/T17431.stdout
new file mode 100644 (file)
index 0000000..e6fa548
--- /dev/null
@@ -0,0 +1,11 @@
+Breakpoint 0 activated at T17431.hs:5:15-32
+Stopped in T17431.sort, T17431.hs:5:15-32
+_result :: [a] = _
+x :: a = _
+xs :: [a] = [_,_]
+*** Ignoring breakpoint
+*** Ignoring breakpoint
+*** Ignoring breakpoint
+x = 3
+xs = [2,1]
+_result = [1,2,3]
index ae0e38c..094f101 100755 (executable)
@@ -310,3 +310,4 @@ test('T16876', normal, ghci_script, ['T16876.script'])
 test('T17345', normal, ghci_script, ['T17345.script'])
 test('T17384', normal, ghci_script, ['T17384.script'])
 test('T17403', normal, ghci_script, ['T17403.script'])
+test('T17431', normal, ghci_script, ['T17431.script'])