[commit: ghc] master: Fix BLACKHOLE inspection in RtClosureInspect (45ed461)

[git at git.haskell.org]

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

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/45ed4619fd5cfe785bbf1142b9d16e4f3c5148ce/ghc

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

commit 45ed4619fd5cfe785bbf1142b9d16e4f3c5148ce
Author: Ömer Sinan Ağacan <omeragacan at gmail.com>
Date:   Mon Oct 15 13:53:21 2018 -0400

    Fix BLACKHOLE inspection in RtClosureInspect
    
    When inspecing a BLACKHOLE if the BLACKHOLE points to a TSO or a
    BLOCKING_QUEUE we should return a suspension to the BLACKHOLE itself
    (instead of returning a suspension to the indirectee). The reason is
    because in the debugger when we want to evaluate this term we need to
    enter the BLACKHOLE and not to the TSO or BLOCKING_QUEUE. See the
    runtime panic caused by this in #8316.
    
    Note that while with this patch we do the right thing to evaluate
    thunks in GHCi, evaluating thunks that are owned by the evaluator thread
    in a breakpoint will cause a deadlock as we don't release the breakMVar,
    which is what blocks the evaluator thread from continuing with
    evaluation. So the GHCi thread will enter the BLACKHOLE, but owner of
    the BLACKHOLE is also blocked.
    
    Reviewers: simonmar, hvr, bgamari
    
    Reviewed By: bgamari
    
    Subscribers: rwbarton, carter
    
    GHC Trac Issues: #8316
    
    Differential Revision: https://phabricator.haskell.org/D5179


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

45ed4619fd5cfe785bbf1142b9d16e4f3c5148ce
 compiler/ghci/RtClosureInspect.hs | 20 ++++++++++++++++----
 1 file changed, 16 insertions(+), 4 deletions(-)

diff --git a/compiler/ghci/RtClosureInspect.hs b/compiler/ghci/RtClosureInspect.hs
index 18feeb5..167ea1b 100644
--- a/compiler/ghci/RtClosureInspect.hs
+++ b/compiler/ghci/RtClosureInspect.hs
@@ -692,12 +692,24 @@ cvObtainTerm hsc_env max_depth force old_ty hval = runTR hsc_env $ do
          traceTR (text "Forcing a " <> text (show (fmap (const ()) t)))
          liftIO $ GHCi.seqHValue hsc_env a
          go (pred max_depth) my_ty old_ty a
--- Blackholes are indirections iff the payload is not TSO or BLOCKING_QUEUE.  So we
--- treat them like indirections; if the payload is TSO or BLOCKING_QUEUE, we'll end up
--- showing '_' which is what we want.
+-- Blackholes are indirections iff the payload is not TSO or BLOCKING_QUEUE. If
+-- the indirection is a TSO or BLOCKING_QUEUE, we return the BLACKHOLE itself as
+-- the suspension so that entering it in GHCi will enter the BLACKHOLE instead
+-- of entering the TSO or BLOCKING_QUEUE (which leads to runtime panic).
       BlackholeClosure{indirectee=ind} -> do
          traceTR (text "Following a BLACKHOLE")
-         go max_depth my_ty old_ty ind
+         ind_clos <- trIO (GHCi.getClosure hsc_env ind)
+         let return_bh_value = return (Suspension BLACKHOLE my_ty a Nothing)
+         case ind_clos of
+           -- TSO and BLOCKING_QUEUE cases
+           BlockingQueueClosure{} -> return_bh_value
+           OtherClosure info _ _
+             | tipe info == TSO -> return_bh_value
+           UnsupportedClosure info
+             | tipe info == TSO -> return_bh_value
+           -- Otherwise follow the indirectee
+           -- (NOTE: This code will break if we support TSO in ghc-heap one day)
+           _ -> go max_depth my_ty old_ty ind
 -- We always follow indirections
       IndClosure{indirectee=ind} -> do
          traceTR (text "Following an indirection" )