Rodrigo Mesquita pushed to branch wip/romes/step-out at Glasgow Haskell Compiler / GHC

Commits:

20 changed files:

Changes:

  • compiler/GHC/Driver/Config.hs
    ... ... @@ -3,6 +3,7 @@ module GHC.Driver.Config
    3 3
        ( initOptCoercionOpts
    
    4 4
        , initSimpleOpts
    
    5 5
        , initEvalOpts
    
    6
    +   , EvalStep(..)
    
    6 7
        )
    
    7 8
     where
    
    8 9
     
    
    ... ... @@ -28,13 +29,28 @@ initSimpleOpts dflags = SimpleOpts
    28 29
        , so_inline  = True
    
    29 30
        }
    
    30 31
     
    
    32
    +-- | Instruct the interpreter evaluation to break...
    
    33
    +data EvalStep
    
    34
    +  -- | ... at every breakpoint tick
    
    35
    +  = EvalStepSingle
    
    36
    +  -- | ... after every return stmt
    
    37
    +  | EvalStepOut
    
    38
    +  -- | ... only on explicit breakpoints
    
    39
    +  | EvalStepNone
    
    40
    +
    
    31 41
     -- | Extract GHCi options from DynFlags and step
    
    32
    -initEvalOpts :: DynFlags -> Bool -> EvalOpts
    
    42
    +initEvalOpts :: DynFlags -> EvalStep -> EvalOpts
    
    33 43
     initEvalOpts dflags step =
    
    34 44
       EvalOpts
    
    35 45
         { useSandboxThread = gopt Opt_GhciSandbox dflags
    
    36
    -    , singleStep       = step
    
    46
    +    , singleStep       = singleStep
    
    47
    +    , stepOut          = stepOut
    
    37 48
         , breakOnException = gopt Opt_BreakOnException dflags
    
    38 49
         , breakOnError     = gopt Opt_BreakOnError dflags
    
    39 50
         }
    
    51
    +  where
    
    52
    +    (singleStep, stepOut) = case step of
    
    53
    +      EvalStepSingle -> (True,  False)
    
    54
    +      EvalStepOut    -> (False, True)
    
    55
    +      EvalStepNone   -> (False, False)
    
    40 56
     

  • compiler/GHC/Runtime/Eval.hs
    ... ... @@ -343,7 +343,12 @@ handleRunStatus step expr bindings final_ids status history0 = do
    343 343
           setSession hsc_env2
    
    344 344
           return (ExecBreak names Nothing)
    
    345 345
     
    
    346
    -    -- Just case: we stopped at a breakpoint
    
    346
    +    -- EvalBreak (Just ...) case: the interpreter stopped at a breakpoint
    
    347
    +    --
    
    348
    +    -- The interpreter yields on a breakpoint if:
    
    349
    +    --  - the breakpoint was explicitly enabled (in @BreakArray@)
    
    350
    +    --  - or @singleStep = True@ in EvalOpts
    
    351
    +    --  - or @stepOut = True@ in EvalOpts
    
    347 352
         EvalBreak apStack_ref (Just eval_break) resume_ctxt ccs -> do
    
    348 353
           let ibi = evalBreakpointToId eval_break
    
    349 354
           tick_brks <- liftIO $ readModBreaks hsc_env (ibi_tick_mod ibi)
    
    ... ... @@ -351,13 +356,14 @@ handleRunStatus step expr bindings final_ids status history0 = do
    351 356
             span      = modBreaks_locs tick_brks ! ibi_tick_index ibi
    
    352 357
             decl      = intercalate "." $ modBreaks_decls tick_brks ! ibi_tick_index ibi
    
    353 358
     
    
    359
    +      -- Was the breakpoint explicitly enabled?
    
    354 360
           b <- liftIO $ breakpointStatus interp (modBreaks_flags tick_brks) (ibi_tick_index ibi)
    
    355 361
     
    
    356 362
           apStack_fhv <- liftIO $ mkFinalizedHValue interp apStack_ref
    
    357 363
           resume_ctxt_fhv   <- liftIO $ mkFinalizedHValue interp resume_ctxt
    
    358 364
     
    
    359
    -      -- This breakpoint is explicitly enabled; we want to stop
    
    360
    -      -- instead of just logging it.
    
    365
    +      -- This breakpoint is enabled or we mean to break here;
    
    366
    +      -- we want to stop instead of just logging it.
    
    361 367
           if b || breakHere step span then do
    
    362 368
             -- This function only returns control to ghci with 'ExecBreak' when it is really meant to break.
    
    363 369
             -- Specifically, for :steplocal or :stepmodule, don't return control
    
    ... ... @@ -1247,7 +1253,7 @@ compileParsedExprRemote expr@(L loc _) = withSession $ \hsc_env -> do
    1247 1253
             _ -> panic "compileParsedExprRemote"
    
    1248 1254
     
    
    1249 1255
       updateFixityEnv fix_env
    
    1250
    -  let eval_opts = initEvalOpts dflags False
    
    1256
    +  let eval_opts = initEvalOpts dflags EvalStepNone
    
    1251 1257
       status <- liftIO $ evalStmt interp eval_opts (EvalThis hvals_io)
    
    1252 1258
       case status of
    
    1253 1259
         EvalComplete _ (EvalSuccess [hval]) -> return hval
    

  • compiler/GHC/Runtime/Eval/Types.hs
    ... ... @@ -17,6 +17,7 @@ import GHC.Prelude
    17 17
     
    
    18 18
     import GHCi.RemoteTypes
    
    19 19
     import GHCi.Message (EvalExpr, ResumeContext)
    
    20
    +import GHC.Driver.Config (EvalStep(..))
    
    20 21
     import GHC.Types.Id
    
    21 22
     import GHC.Types.Name
    
    22 23
     import GHC.Types.TyThing
    
    ... ... @@ -46,6 +47,9 @@ data SingleStep
    46 47
        -- | :step [expr]
    
    47 48
        | SingleStep
    
    48 49
     
    
    50
    +   -- | :stepout [expr]
    
    51
    +   | StepOut
    
    52
    +
    
    49 53
        -- | :steplocal [expr]
    
    50 54
        | LocalStep
    
    51 55
           { breakAt :: SrcSpan }
    
    ... ... @@ -55,10 +59,12 @@ data SingleStep
    55 59
           { breakAt :: SrcSpan }
    
    56 60
     
    
    57 61
     -- | Whether this 'SingleStep' mode requires instructing the interpreter to
    
    58
    --- step at every breakpoint.
    
    59
    -enableGhcStepMode :: SingleStep -> Bool
    
    60
    -enableGhcStepMode RunToCompletion = False
    
    61
    -enableGhcStepMode _ = True
    
    62
    +-- step at every breakpoint or after every return (see @'EvalStep'@).
    
    63
    +enableGhcStepMode :: SingleStep -> EvalStep
    
    64
    +enableGhcStepMode RunToCompletion = EvalStepNone
    
    65
    +enableGhcStepMode StepOut         = EvalStepOut
    
    66
    +-- for the remaining step modes we need to stop at every single breakpoint.
    
    67
    +enableGhcStepMode _               = EvalStepSingle
    
    62 68
     
    
    63 69
     -- | Given a 'SingleStep' mode and the SrcSpan of a breakpoint we hit, return
    
    64 70
     -- @True@ if based on the step-mode alone we should stop at this breakpoint.
    
    ... ... @@ -70,6 +76,7 @@ breakHere :: SingleStep -> SrcSpan -> Bool
    70 76
     breakHere step break_span = case step of
    
    71 77
       RunToCompletion -> False
    
    72 78
       RunAndLogSteps  -> False
    
    79
    +  StepOut         -> True
    
    73 80
       SingleStep      -> True
    
    74 81
       LocalStep  span -> break_span `isSubspanOf` span
    
    75 82
       ModuleStep span -> srcSpanFileName_maybe span == srcSpanFileName_maybe break_span
    

  • docs/users_guide/ghci.rst
    ... ... @@ -2980,6 +2980,35 @@ commonly used commands.
    2980 2980
         hit by an error (:ghc-flag:`-fbreak-on-error`) or an
    
    2981 2981
         exception (:ghc-flag:`-fbreak-on-exception`).
    
    2982 2982
     
    
    2983
    +.. ghci-cmd:: :stepout
    
    2984
    +
    
    2985
    +    Stop at the first breakpoint immediately after returning from the current
    
    2986
    +    function scope.
    
    2987
    +
    
    2988
    +    Known limitations: because a function tail-call does not push a stack
    
    2989
    +    frame, if step-out is used inside of a function that was tail-called,
    
    2990
    +    execution will not be returned to its caller, but rather its caller's
    
    2991
    +    first non-tail caller. On the other hand, it means the debugger
    
    2992
    +    follows the more realistic execution of the program.
    
    2993
    +    In the following example:
    
    2994
    +
    
    2995
    +    .. code-block:: none
    
    2996
    +
    
    2997
    +    f = do
    
    2998
    +       a
    
    2999
    +       b <--- (1) set breakpoint then step in here
    
    3000
    +       c
    
    3001
    +    b = do
    
    3002
    +       ...
    
    3003
    +       d <--- (2) step-into this tail call
    
    3004
    +    d = do
    
    3005
    +       ...
    
    3006
    +       something <--- (3) step-out here
    
    3007
    +       ...
    
    3008
    +
    
    3009
    +    Stepping-out will stop execution at the `c` invokation in `f`, rather than
    
    3010
    +    stopping at `b`.
    
    3011
    +
    
    2983 3012
     .. ghci-cmd:: :stepmodule
    
    2984 3013
     
    
    2985 3014
         Enable only breakpoints in the current module and resume evaluation
    

  • ghc/GHCi/UI.hs
    ... ... @@ -247,6 +247,7 @@ ghciCommands = map mkCmd [
    247 247
       ("sprint",    keepGoing sprintCmd,            completeExpression),
    
    248 248
       ("step",      keepGoing stepCmd,              completeIdentifier),
    
    249 249
       ("steplocal", keepGoing stepLocalCmd,         completeIdentifier),
    
    250
    +  ("stepout",   keepGoing stepOutCmd,           completeIdentifier),
    
    250 251
       ("stepmodule",keepGoing stepModuleCmd,        completeIdentifier),
    
    251 252
       ("type",      keepGoingMulti' typeOfExpr,          completeExpression),
    
    252 253
       ("trace",     keepGoing traceCmd,             completeExpression),
    
    ... ... @@ -407,6 +408,7 @@ defFullHelpText =
    407 408
       "   :step                       single-step after stopping at a breakpoint\n"++
    
    408 409
       "   :step <expr>                single-step into <expr>\n"++
    
    409 410
       "   :steplocal                  single-step within the current top-level binding\n"++
    
    411
    +  "   :stepout                    stop at the first breakpoint after returning from the current scope\n"++
    
    410 412
       "   :stepmodule                 single-step restricted to the current module\n"++
    
    411 413
       "   :trace                      trace after stopping at a breakpoint\n"++
    
    412 414
       "   :trace <expr>               evaluate <expr> with tracing on (see :history)\n"++
    
    ... ... @@ -3793,6 +3795,12 @@ stepCmd arg = withSandboxOnly ":step" $ step arg
    3793 3795
       step []         = doContinue GHC.SingleStep
    
    3794 3796
       step expression = runStmt expression GHC.SingleStep >> return ()
    
    3795 3797
     
    
    3798
    +stepOutCmd :: GhciMonad m => String -> m ()
    
    3799
    +stepOutCmd arg = withSandboxOnly ":stepout" $ step arg
    
    3800
    +  where
    
    3801
    +  step []         = doContinue GHC.StepOut
    
    3802
    +  step expression = stepCmd expression
    
    3803
    +
    
    3796 3804
     stepLocalCmd :: GhciMonad m => String -> m ()
    
    3797 3805
     stepLocalCmd arg = withSandboxOnly ":steplocal" $ step arg
    
    3798 3806
       where
    

  • libraries/ghci/GHCi/Message.hs
    ... ... @@ -374,6 +374,7 @@ putTHMessage m = case m of
    374 374
     data EvalOpts = EvalOpts
    
    375 375
       { useSandboxThread :: Bool
    
    376 376
       , singleStep :: Bool
    
    377
    +  , stepOut :: Bool
    
    377 378
       , breakOnException :: Bool
    
    378 379
       , breakOnError :: Bool
    
    379 380
       }
    

  • libraries/ghci/GHCi/Run.hs
    ... ... @@ -210,6 +210,7 @@ evalOptsSeq :: EvalOpts
    210 210
     evalOptsSeq = EvalOpts
    
    211 211
                   { useSandboxThread = True
    
    212 212
                   , singleStep = False
    
    213
    +              , stepOut    = False
    
    213 214
                   , breakOnException = False
    
    214 215
                   , breakOnError = False
    
    215 216
                   }
    
    ... ... @@ -333,6 +334,7 @@ withBreakAction opts breakMVar statusMVar act
    333 334
          poke breakPointIOAction stablePtr
    
    334 335
          when (breakOnException opts) $ poke exceptionFlag 1
    
    335 336
          when (singleStep opts) $ setStepFlag
    
    337
    +     when (stepOut opts) $ poke stepOutFlag 1
    
    336 338
          return stablePtr
    
    337 339
             -- Breaking on exceptions is not enabled by default, since it
    
    338 340
             -- might be a bit surprising.  The exception flag is turned off
    
    ... ... @@ -363,6 +365,7 @@ withBreakAction opts breakMVar statusMVar act
    363 365
        resetBreakAction stablePtr = do
    
    364 366
          poke breakPointIOAction noBreakStablePtr
    
    365 367
          poke exceptionFlag 0
    
    368
    +     poke stepOutFlag 0
    
    366 369
          resetStepFlag
    
    367 370
          freeStablePtr stablePtr
    
    368 371
     
    
    ... ... @@ -398,6 +401,7 @@ abandonStmt hvref = do
    398 401
     
    
    399 402
     foreign import ccall "&rts_stop_next_breakpoint" stepFlag      :: Ptr CInt
    
    400 403
     foreign import ccall "&rts_stop_on_exception"    exceptionFlag :: Ptr CInt
    
    404
    +foreign import ccall "&rts_stop_after_return"    stepOutFlag   :: Ptr CInt
    
    401 405
     
    
    402 406
     setStepFlag :: IO ()
    
    403 407
     setStepFlag = poke stepFlag 1
    

  • rts/Interpreter.c
    ... ... @@ -194,6 +194,24 @@ See also Note [Width of parameters] for some more motivation.
    194 194
     #define WITHIN_CHUNK_BOUNDS(n, s)  \
    
    195 195
       (RTS_LIKELY((StgWord*)(Sp_plusW(n)) < ((s)->stack + (s)->stack_size - sizeofW(StgUnderflowFrame))))
    
    196 196
     
    
    197
    +// Note [Debugger Step-out]
    
    198
    +// ~~~~~~~~~~~~~~~~~~~~~~~~
    
    199
    +// When the global debugger step-out flag is set (`rts_stop_after_return`),
    
    200
    +// the interpreter must yield execution right after the first RETURN.
    
    201
    +//
    
    202
    +// When stepping-out, we simply enable `rts_stop_next_breakpoint` when we hit a
    
    203
    +// return instruction (in `do_return_pointer` and `do_return_nonpointer`).
    
    204
    +// The step-out flag is cleared and must be re-enabled explicitly to step-out again.
    
    205
    +//
    
    206
    +// A limitation of this approach is that stepping-out of a function that was
    
    207
    +// tail-called will skip its caller since no stack frame is pushed for a tail
    
    208
    +// call (i.e. a tail call returns directly to its caller's first non-tail caller).
    
    209
    +#define CHECK_BRK_AFTER_RET()               \
    
    210
    +    if (rts_stop_after_return)              \
    
    211
    +    {                                       \
    
    212
    +      rts_stop_next_breakpoint = true;      \
    
    213
    +      rts_stop_after_return = false;        \
    
    214
    +    }                                       \
    
    197 215
     
    
    198 216
     /* Note [PUSH_L underflow]
    
    199 217
        ~~~~~~~~~~~~~~~~~~~~~~~
    
    ... ... @@ -245,6 +263,7 @@ allocate_NONUPD (Capability *cap, int n_words)
    245 263
     
    
    246 264
     int rts_stop_next_breakpoint = 0;
    
    247 265
     int rts_stop_on_exception = 0;
    
    266
    +int rts_stop_after_return = 0;
    
    248 267
     
    
    249 268
     #if defined(INTERP_STATS)
    
    250 269
     
    
    ... ... @@ -734,6 +753,8 @@ do_return_pointer:
    734 753
     
    
    735 754
         IF_DEBUG(sanity,checkStackChunk(Sp, cap->r.rCurrentTSO->stackobj->stack+cap->r.rCurrentTSO->stackobj->stack_size));
    
    736 755
     
    
    756
    +    CHECK_BRK_AFTER_RET();
    
    757
    +
    
    737 758
         switch (get_itbl((StgClosure *)Sp)->type) {
    
    738 759
     
    
    739 760
         case RET_SMALL: {
    
    ... ... @@ -883,6 +904,8 @@ do_return_nonpointer:
    883 904
             // get the offset of the header of the next stack frame
    
    884 905
             offset = stack_frame_sizeW((StgClosure *)Sp);
    
    885 906
     
    
    907
    +        CHECK_BRK_AFTER_RET();
    
    908
    +
    
    886 909
             switch (get_itbl((StgClosure*)(Sp_plusW(offset)))->type) {
    
    887 910
     
    
    888 911
             case RET_BCO:
    

  • rts/RtsSymbols.c
    ... ... @@ -908,6 +908,7 @@ extern char **environ;
    908 908
           SymI_NeedsDataProto(rts_breakpoint_io_action)                     \
    
    909 909
           SymI_NeedsDataProto(rts_stop_next_breakpoint)                     \
    
    910 910
           SymI_NeedsDataProto(rts_stop_on_exception)                        \
    
    911
    +      SymI_NeedsDataProto(rts_stop_after_return)                        \
    
    911 912
           SymI_HasProto(stopTimer)                                          \
    
    912 913
           SymI_HasProto(n_capabilities)                                     \
    
    913 914
           SymI_HasProto(max_n_capabilities)                                 \
    

  • rts/include/stg/MiscClosures.h
    ... ... @@ -619,6 +619,7 @@ RTS_FUN_DECL(stg_castFloatToWord32zh);
    619 619
     // Interpreter.c
    
    620 620
     extern StgWord rts_stop_next_breakpoint[];
    
    621 621
     extern StgWord rts_stop_on_exception[];
    
    622
    +extern StgWord rts_stop_after_return[];
    
    622 623
     extern StgWord rts_breakpoint_io_action[];
    
    623 624
     
    
    624 625
     // Schedule.c
    

  • testsuite/tests/ghci.debugger/scripts/T26042a.hs
    1
    +module Main where
    
    2
    +
    
    3
    +main :: IO ()
    
    4
    +main = do
    
    5
    +  a <- foo
    
    6
    +  print a
    
    7
    +
    
    8
    +foo :: IO Int
    
    9
    +foo = do
    
    10
    +  let x = 3
    
    11
    +      y = 4
    
    12
    +  b <- bar (x + y)
    
    13
    +  return b
    
    14
    +
    
    15
    +bar :: Int -> IO Int
    
    16
    +bar z = return (z * 2)
    
    17
    +

  • testsuite/tests/ghci.debugger/scripts/T26042a.script
    1
    +:load T26042a.hs
    
    2
    +-- simple use of stepout
    
    3
    +:break bar
    
    4
    +main
    
    5
    +:list
    
    6
    +:stepout
    
    7
    +:list
    
    8
    +:stepout
    
    9
    +:list
    
    10
    +-- from here on we're going to evaluate the thunks for `a` in `print a`
    
    11
    +:stepout
    
    12
    +:list
    
    13
    +:stepout
    
    14
    +:list
    
    15
    +:stepout
    
    16
    +:list
    
    17
    +:stepout
    
    18
    +:list
    
    19
    +-- finish execution
    
    20
    +:stepout

  • testsuite/tests/ghci.debugger/scripts/T26042a.stdout
    1
    +Breakpoint 0 activated at T26042a.hs:16:9-22
    
    2
    +Stopped in Main.bar, T26042a.hs:16:9-22
    
    3
    +_result :: IO Int = _
    
    4
    +z :: Int = _
    
    5
    +15  bar :: Int -> IO Int
    
    6
    +16  bar z = return (z * 2)
    
    7
    +            ^^^^^^^^^^^^^^
    
    8
    +17  
    
    9
    +Stopped in Main.foo, T26042a.hs:13:3-10
    
    10
    +_result :: IO Int = _
    
    11
    +b :: Int = _
    
    12
    +12    b <- bar (x + y)
    
    13
    +13    return b
    
    14
    +      ^^^^^^^^
    
    15
    +14  
    
    16
    +Stopped in Main.main, T26042a.hs:6:3-9
    
    17
    +_result :: IO () = _
    
    18
    +a :: Int = _
    
    19
    +5    a <- foo
    
    20
    +6    print a
    
    21
    +     ^^^^^^^
    
    22
    +7  
    
    23
    +Stopped in Main.bar, T26042a.hs:16:17-21
    
    24
    +_result :: Int = _
    
    25
    +z :: Int = _
    
    26
    +15  bar :: Int -> IO Int
    
    27
    +16  bar z = return (z * 2)
    
    28
    +                    ^^^^^
    
    29
    +17  
    
    30
    +Stopped in Main.foo, T26042a.hs:12:13-17
    
    31
    +_result :: Int = _
    
    32
    +x :: Int = _
    
    33
    +y :: Int = _
    
    34
    +11        y = 4
    
    35
    +12    b <- bar (x + y)
    
    36
    +                ^^^^^
    
    37
    +13    return b
    
    38
    +Stopped in Main.foo.x, T26042a.hs:10:11
    
    39
    +_result :: Int = _
    
    40
    +9  foo = do
    
    41
    +10    let x = 3
    
    42
    +              ^
    
    43
    +11        y = 4
    
    44
    +Stopped in Main.foo.y, T26042a.hs:11:11
    
    45
    +_result :: Int = _
    
    46
    +10    let x = 3
    
    47
    +11        y = 4
    
    48
    +              ^
    
    49
    +12    b <- bar (x + y)
    
    50
    +14

  • testsuite/tests/ghci.debugger/scripts/T26042b.hs
    1
    +module Main where
    
    2
    +
    
    3
    +main :: IO ()
    
    4
    +main = do
    
    5
    +  a <- foo False undefined
    
    6
    +  print a
    
    7
    +
    
    8
    +foo :: Bool -> Int -> IO Int
    
    9
    +foo True  i = return i
    
    10
    +foo False _ = do
    
    11
    +  let x = 3
    
    12
    +      y = 4
    
    13
    +  n <- bar (x + y)
    
    14
    +  return n
    
    15
    +
    
    16
    +bar :: Int -> IO Int
    
    17
    +bar z = do
    
    18
    +  let t = z * 2
    
    19
    +  y <- foo True t
    
    20
    +  return y
    
    21
    +
    
    22
    +

  • testsuite/tests/ghci.debugger/scripts/T26042b.script
    1
    +:load T26042b.hs
    
    2
    +-- break on the True branch of foo
    
    3
    +:break 9
    
    4
    +main
    
    5
    +:list
    
    6
    +-- stepout of foo True to caller (ie bar)
    
    7
    +:stepout
    
    8
    +:list
    
    9
    +-- stepout of bar (to branch of foo False, where bar was called)
    
    10
    +:stepout
    
    11
    +:list
    
    12
    +-- stepout to right after the call to foo False in main
    
    13
    +:stepout
    
    14
    +:list
    
    15
    +-- done
    
    16
    +:continue

  • testsuite/tests/ghci.debugger/scripts/T26042b.stdout
    1
    +Breakpoint 0 activated at T26042b.hs:9:15-22
    
    2
    +Stopped in Main.foo, T26042b.hs:9:15-22
    
    3
    +_result :: IO Int = _
    
    4
    +i :: Int = _
    
    5
    +8  foo :: Bool -> Int -> IO Int
    
    6
    +9  foo True  i = return i
    
    7
    +                 ^^^^^^^^
    
    8
    +10  foo False _ = do
    
    9
    +Stopped in Main.bar, T26042b.hs:20:3-10
    
    10
    +_result :: IO Int = _
    
    11
    +y :: Int = _
    
    12
    +19    y <- foo True t
    
    13
    +20    return y
    
    14
    +      ^^^^^^^^
    
    15
    +21  
    
    16
    +Stopped in Main.foo, T26042b.hs:14:3-10
    
    17
    +_result :: IO Int = _
    
    18
    +n :: Int = _
    
    19
    +13    n <- bar (x + y)
    
    20
    +14    return n
    
    21
    +      ^^^^^^^^
    
    22
    +15  
    
    23
    +Stopped in Main.main, T26042b.hs:6:3-9
    
    24
    +_result :: IO () = _
    
    25
    +a :: Int = _
    
    26
    +5    a <- foo False undefined
    
    27
    +6    print a
    
    28
    +     ^^^^^^^
    
    29
    +7  
    
    30
    +14

  • testsuite/tests/ghci.debugger/scripts/T26042c.hs
    1
    +module Main where
    
    2
    +
    
    3
    +main :: IO ()
    
    4
    +main = do
    
    5
    +  a <- foo False undefined
    
    6
    +  print a
    
    7
    +
    
    8
    +foo :: Bool -> Int -> IO Int
    
    9
    +foo True  i = return i
    
    10
    +foo False _ = do
    
    11
    +  let x = 3
    
    12
    +      y = 4
    
    13
    +  bar (x + y)
    
    14
    +
    
    15
    +bar :: Int -> IO Int
    
    16
    +bar z = do
    
    17
    +  let t = z * 2
    
    18
    +  foo True t
    
    19
    +

  • testsuite/tests/ghci.debugger/scripts/T26042c.script
    1
    +:load T26042c.hs
    
    2
    +-- similar to T26042b, but uses tail calls
    
    3
    +-- recall: for step-out, we skip the caller of tail calls
    
    4
    +-- (because we don't push a stack frame for tail calls, so
    
    5
    +-- there's no RET instruction to stop after)
    
    6
    +
    
    7
    +-- break on foo True branch
    
    8
    +:break 9
    
    9
    +main
    
    10
    +:list
    
    11
    +-- step out of foo True and observe that we have skipped its call in bar,
    
    12
    +-- and the call of bar in foo False.
    
    13
    +-- we go straight to `main`.
    
    14
    +:stepout
    
    15
    +:list
    
    16
    +-- stepping out from here will jump into the thunk because it's where we'll
    
    17
    +-- go after returning.
    
    18
    +:stepout
    
    19
    +:list
    
    20
    +-- and so on
    
    21
    +:stepout
    
    22
    +:list
    
    23
    +-- finish
    
    24
    +:continue

  • testsuite/tests/ghci.debugger/scripts/T26042c.stdout
    1
    +Breakpoint 0 activated at T26042c.hs:9:15-22
    
    2
    +Stopped in Main.foo, T26042c.hs:9:15-22
    
    3
    +_result :: IO Int = _
    
    4
    +i :: Int = _
    
    5
    +8  foo :: Bool -> Int -> IO Int
    
    6
    +9  foo True  i = return i
    
    7
    +                 ^^^^^^^^
    
    8
    +10  foo False _ = do
    
    9
    +Stopped in Main.main, T26042c.hs:6:3-9
    
    10
    +_result :: IO () = _
    
    11
    +a :: Int = _
    
    12
    +5    a <- foo False undefined
    
    13
    +6    print a
    
    14
    +     ^^^^^^^
    
    15
    +7  
    
    16
    +Stopped in Main.bar.t, T26042c.hs:17:11-15
    
    17
    +_result :: Int = _
    
    18
    +z :: Int = _
    
    19
    +16  bar z = do
    
    20
    +17    let t = z * 2
    
    21
    +              ^^^^^
    
    22
    +18    foo True t
    
    23
    +Stopped in Main.foo, T26042c.hs:13:8-12
    
    24
    +_result :: Int = _
    
    25
    +x :: Int = _
    
    26
    +y :: Int = _
    
    27
    +12        y = 4
    
    28
    +13    bar (x + y)
    
    29
    +           ^^^^^
    
    30
    +14  
    
    31
    +14

  • testsuite/tests/ghci.debugger/scripts/all.T
    ... ... @@ -144,3 +144,6 @@ test('T24306', normal, ghci_script, ['T24306.script'])
    144 144
     test('T24712', normal, ghci_script, ['T24712.script'])
    
    145 145
     test('T25109', normal, ghci_script, ['T25109.script'])
    
    146 146
     test('T25932', extra_files(['T25932.hs']), ghci_script, ['T25932.script'])
    
    147
    +test('T26042a', extra_files(['T26042a.hs']), ghci_script, ['T26042a.script'])
    
    148
    +test('T26042b', extra_files(['T26042b.hs']), ghci_script, ['T26042b.script'])
    
    149
    +test('T26042c', extra_files(['T26042c.hs']), ghci_script, ['T26042c.script'])