Rodrigo Mesquita pushed to branch wip/romes/multi-threaded-debugger at Glasgow Haskell Compiler / GHC

Commits:

18 changed files:

Changes:

  • libraries/ghci/GHCi/Run.hs
    ... ... @@ -367,7 +367,7 @@ sandboxIO opts io
    367 367 
           -- tracing, etc.) need the expression to be running in a
    368 368 
           -- separate thread, so debugging is only enabled when
    369 369 
           -- using the sandbox.
    370 
    -      tid <- forkIO (pure ())
    370 
    +      tid <- forkIO (pure ()) -- TODO doesn't work
    371 371 
           runIt id >>= writeThreadEvalStatus tid
    372 372 
           mkRemoteRef tid
    373 373 
             -- We `runIt` on the main thread, but fork a new thread to store to the
    ... ... @@ -419,16 +419,16 @@ setBreakAction opts tid@(ThreadId tid#) = do
    419 419 
       where
    420 420 
         setBreakAction' ctx = do
    421 421
    422 
    -      runIf# singleStep rts_enableStopNextBreakpoint
    423 
    -      runIf# stepOut    rts_enableStopAfterReturn
    422 
    +      runIf# singleStep rts_enableStopNextBreakpoint rts_disableStopNextBreakpoint
    423 
    +      runIf# stepOut    rts_enableStopAfterReturn    rts_disableStopAfterReturn
    424 424
    425 425 
           -- Breaking on exceptions is not enabled by default, since it might be a
    426 426 
           -- bit surprising. The exception flag is turned off as soon as it is hit.
    427 
    -      runIf# breakOnException rts_enableStopOnException
    427 
    +      runIf# breakOnException rts_enableStopOnException rts_disableStopOnException
    428 428
    429 429 
           if isolateThreadBreaks opts
    430 430 
             then setIsolatedCtx ctx
    431 431 
             else unsetIsolatedCtx ctx
    432 432
    433 
    -    runIf#   pred what     = when (pred opts) (what tid#)
    433 
    +    runIf# pred what what_off = if pred opts then what tid# else what_off tid#
    434 434

  • rts/Interpreter.h
    ... ... @@ -21,3 +21,9 @@ void rts_disableStopNextBreakpoint ( StgTSO* );
    21 21 
     // Debugger step out
    22 22 
     void rts_enableStopAfterReturn        ( StgTSO* );
    23 23 
     void rts_disableStopAfterReturn       ( StgTSO* );
    24 
    +
    25 
    +// Debugger stop on exception
    26 
    +void rts_enableStopOnException        ( StgTSO* );
    27 
    +void rts_disableStopOnException       ( StgTSO* );
    28 
    +void rts_enableStopOnExceptionAll     ( void );
    29 
    +void rts_disableStopOnExceptionAll    ( void );

  • testsuite/tests/concurrent/should_run/all.T
    ... ... @@ -168,7 +168,10 @@ test('conc030', extra_run_opts('+RTS -K4M -RTS'), compile_and_run, [''])
    168 168 
     test('conc031', exit_code(1), compile_and_run, [''])
    169 169
    170 170 
     test('conc032', normal, compile_and_run, [''])
    171 
    -test('conc033', normal, compile_and_run, [''])
    171 
    +# Also run in GHCi: the sandbox thread must still be detected as deadlocked
    172 
    +test('conc033',
    173 
    +     [extra_ways(['ghci'] + (['ghci-ext'] if config.have_ext_interp else []))],
    174 
    +     compile_and_run, [''])
    172 175
    173 176 
     # Omit for GHCi, because it just sits there waiting for you to press ^C
    174 177 
     test('conc034', [

  • testsuite/tests/ghci.debugger/scripts/all.T
    ... ... @@ -155,3 +155,7 @@ test('T26042f2', [extra_hc_opts('-O -fno-unoptimized-core-for-interpreter'), ext
    155 155 
     test('T26042g', extra_files(['T26042g.hs']), ghci_script, ['T26042g.script'])
    156 156
    157 157 
     test('T27633c', extra_files(['T27633c_obj.hs']), ghci_script, ['T27633c.script'])
    158 
    +
    159 
    +test('break032', extra_files(['break032.hs']), ghci_script, ['break032.script'])
    160 
    +test('break033', extra_files(['break033.hs']), ghci_script, ['break033.script'])
    161 
    +test('break034', extra_files(['break034.hs']), ghci_script, ['break034.script'])

  • testsuite/tests/ghci.debugger/scripts/break032.hs
    1 
    +module Break032 where
    2 
    +
    3 
    +f :: Int -> Int
    4 
    +f x = x + 1

  • testsuite/tests/ghci.debugger/scripts/break032.script
    1 
    +:set -XTemplateHaskell
    2 
    +:l break032
    3 
    +:break f
    4 
    +-- Running a statement installs the debugger's breakpoint action (TODO: not rely on this.)
    5 
    +print (1 :: Int)
    6 
    +-- A breakpoint hit while running a splice must be ignored, not block forever
    7 
    +y = $(Language.Haskell.TH.Syntax.lift (f 41))

  • testsuite/tests/ghci.debugger/scripts/break032.stdout
    1 
    +Breakpoint 0 activated at break032.hs:4:7-11
    2 
    +1
    3 
    +*** Ignoring breakpoint

  • testsuite/tests/ghci.debugger/scripts/break033.hs
    1 
    +module Break033 where
    2 
    +
    3 
    +import Control.Exception
    4 
    +
    5 
    +f :: Int -> IO Int
    6 
    +f x = do
    7 
    +  r <- try (evaluate (x `div` 0))
    8 
    +  case r of
    9 
    +    Left DivideByZero -> pure x
    10 
    +    Left e            -> throwIO e
    11 
    +    Right y           -> pure y

  • testsuite/tests/ghci.debugger/scripts/break033.script
    1 
    +:l break033
    2 
    +:break f
    3 
    +:set -fbreak-on-exception
    4 
    +f 1
    5 
    +-- stopped on entry, hasn't hit exception yet
    6 
    +:unset -fbreak-on-exception
    7 
    +-- The DivideByZero must not stop us after break-on-exception was unset
    8 
    +:continue

  • testsuite/tests/ghci.debugger/scripts/break033.stdout
    1 
    +Breakpoint 0 activated at break033.hs:(6,7)-(11,31)
    2 
    +Stopped in Break033.f, break033.hs:(6,7)-(11,31)
    3 
    +_result :: IO Int = _
    4 
    +x :: Int = 1
    5 
    +1

  • testsuite/tests/ghci.debugger/scripts/break034.hs
    1 
    +module Break034 where
    2 
    +
    3 
    +f :: Int -> Int
    4 
    +f x = x + 1

  • testsuite/tests/ghci.debugger/scripts/break034.script
    1 
    +:l break034
    2 
    +:set -fbreak-on-error
    3 
    +:break f
    4 
    +f 1
    5 
    +-- Killing the thread stopped at the breakpoint may break again, on the
    6 
    +-- ThreadKilled exception; :abandon must still clean up without errors and
    7 
    +-- without blocking there.
    8 
    +:abandon
    9 
    +f 2
    10 
    +:abandon
    11 
    +putStrLn "done"

  • testsuite/tests/ghci.debugger/scripts/break034.stdout
    1 
    +Breakpoint 0 activated at break034.hs:4:7-11
    2 
    +Stopped in Break034.f, break034.hs:4:7-11
    3 
    +_result :: Int = _
    4 
    +x :: Int = 1
    5 
    +Stopped in Break034.f, break034.hs:4:7-11
    6 
    +_result :: Int = _
    7 
    +x :: Int = 2
    8 
    +done

  • testsuite/tests/ghci/should_run/ForceInterrupt.script
    1 
    +import Control.Concurrent
    2 
    +import Control.Monad
    3 
    +import Data.IORef
    4 
    +import System.IO.Unsafe
    5 
    +ticks <- newIORef (0 :: Int)
    6 
    +let x = unsafePerformIO (writeFile "force.started" "" >> forever (modifyIORef' ticks (+1) >> threadDelay 20000)) :: ()
    7 
    +-- blocks the interpreter waiting for the expression being forced to terminate.
    8 
    +-- Test that a SIGINT (from the Makefile) interrupts the :force and kills the
    9 
    +-- expression which is running in a (possibly remote) thread.
    10 
    +:force x
    11 
    +do { a <- readIORef ticks; threadDelay 500000; b <- readIORef ticks; putStrLn (if a == b then "stopped" else "still running") }

  • testsuite/tests/ghci/should_run/ForceInterrupt.stdout
    1 
    +Interrupted.
    2 
    +stopped

  • testsuite/tests/ghci/should_run/ForceInterruptExt.stdout
    1 
    +Interrupted.
    2 
    +stopped

  • testsuite/tests/ghci/should_run/Makefile
    ... ... @@ -18,6 +18,15 @@ T3171 T3171ext:
    18 18 
     	while [ ! -e $@.started ] && kill -0 $$! 2>/dev/null; do sleep 0.1; done; \
    19 19 
     	kill -INT $$! $$(pgrep -P $$!); wait
    20 20
    21 
    +# Like T3171, but ^C interrupts a :force rather than an expression: the
    22 
    +# computation being forced must be interrupted too, not left running.
    23 
    +ForceInterruptExt: ForceInterrupt_OPTS = -fexternal-interpreter
    24 
    +ForceInterrupt ForceInterruptExt:
    25 
    +	rm -f force.started
    26 
    +	"$(TEST_HC)" $(TEST_HC_OPTS_INTERACTIVE) $(ForceInterrupt_OPTS) < ForceInterrupt.script & \
    27 
    +	while [ ! -e force.started ] && kill -0 $$! 2>/dev/null; do sleep 0.1; done; \
    28 
    +	kill -INT $$! $$(pgrep -P $$!); wait
    29 
    +
    21 30 
     TopEnvIface:
    22 31 
     	"$(TEST_HC)" $(TEST_HC_OPTS_INTERACTIVE) TopEnvIface -v1 -fno-hide-source-paths -e "a" -e ":q" -fwrite-if-simplified-core -fwrite-interface
    23 32 
     	# Second compilation starts from interface files, but still can print "a"

  • testsuite/tests/ghci/should_run/all.T
    ... ... @@ -23,6 +23,21 @@ test('T3171ext',
    23 23 
           combined_output],
    24 24 
          makefile_test, [])
    25 25
    26 
    +test('ForceInterrupt',
    27 
    +     [when(opsys('mingw32'),skip),
    28 
    +      req_interp,
    29 
    +      extra_files(['ForceInterrupt.script']),
    30 
    +      combined_output],
    31 
    +     makefile_test, [])
    32 
    +
    33 
    +test('ForceInterruptExt',
    34 
    +     [when(opsys('mingw32'),skip),
    35 
    +      req_interp,
    36 
    +      unless(config.have_ext_interp, skip),
    37 
    +      extra_files(['ForceInterrupt.script']),
    38 
    +      combined_output],
    39 
    +     makefile_test, [])
    40 
    +
    26 41 
     test('ghcirun004', just_ghci, compile_and_run, [''])
    27 42 
     test('T8377',      just_ghci, compile_and_run, [''])
    28 43 
     test('T9914',      just_ghci, ghci_script, ['T9914.script'])

    • —
    View it on GitLab.
    You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications · Help Notification message regarding https://gitlab.haskell.org/ghc/ghc/-/compare/51dfa0c5b5b6d5295aa3ed8430ab3c81c3e372c6...bfd992fee69bbb18a03e271d6fdd824ff19e2e0a at 1793108165