diff --git a/.Rbuildignore b/.Rbuildignore index b84ee38..e7e1af5 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -1,3 +1,5 @@ +^renv$ +^renv\.lock$ ^\.github$ ^CODE_OF_CONDUCT\.md$ ^CRAN-RELEASE$ diff --git a/inst/julia/setup.jl b/inst/julia/setup.jl index 69b7a93..5efe9c7 100644 --- a/inst/julia/setup.jl +++ b/inst/julia/setup.jl @@ -162,7 +162,50 @@ function call_decompose(call1) (fname, named_args, unamed_args, need_return, show_value) end +const _interrupt_timer = Ref{Union{Timer, Nothing}}(nothing) +const _main_task = Ref{Union{Task, Nothing}}(nothing) + +function _r_interrupt_ptr() + @static if Sys.iswindows() + cglobal((:UserBreak, RCall.libR), Cint) + else + cglobal((:R_interrupts_pending, RCall.libR), Cint) + end +end + +function r_interrupt_pending() + return unsafe_load(_r_interrupt_ptr()) != 0 +end + +function clear_r_interrupt_pending() + unsafe_store!(_r_interrupt_ptr(), Cint(0)) +end + +function start_interrupt_monitor(; interval = 0.2) + stop_interrupt_monitor() + _main_task[] = current_task() + maintask = _main_task[] + _interrupt_timer[] = Timer(0.0; interval = interval) do t + if r_interrupt_pending() + close(t) + # Throw the InterruptException into the main task so the + # actual computation (not just the timer) gets interrupted. + Base.throwto(maintask, InterruptException()) + end + end +end + +function stop_interrupt_monitor() + timer = _interrupt_timer[] + if timer !== nothing + close(timer) + _interrupt_timer[] = nothing + end + _main_task[] = nothing +end + function docall(call1) + start_interrupt_monitor() try fname, named_args, unamed_args, need_return, show_value = call_decompose(call1); if endswith(fname, ".") @@ -189,7 +232,16 @@ function docall(call1) sexp(nothing); end; catch e - Rerror(e, stacktrace(catch_backtrace())).p; + if e isa InterruptException + # Clear the flag so subsequent Julia calls are not + # immediately interrupted again. + clear_r_interrupt_pending() + sexp(nothing); + else + Rerror(e, stacktrace(catch_backtrace())).p; + end; + finally + stop_interrupt_monitor() end; end diff --git a/tests/testthat/test_interrupt.R b/tests/testthat/test_interrupt.R new file mode 100644 index 0000000..394f8a2 --- /dev/null +++ b/tests/testthat/test_interrupt.R @@ -0,0 +1,60 @@ +context("Interrupt handling") + +test_that("R interrupt flag aborts long-running Julia computation", { + skip_on_cran() + julia <- julia_setup(installJulia = TRUE) + + # Define a Julia function that: + # 1. Schedules a task to set R_interrupts_pending after a short delay + # 2. Runs a long loop with yield points (sleep) + # 3. Returns how many iterations completed (which is never reached if interrupt works) + julia_command(' + function _test_interrupt(n, delay_before_interrupt) + # Schedule a task that sets R_interrupts_pending after a delay, + # simulating the user pressing Ctrl+C / Stop. + @async begin + sleep(delay_before_interrupt) + if Sys.iswindows() + ptr = cglobal((:UserBreak, RCall.libR), Cint) + else + ptr = cglobal((:R_interrupts_pending, RCall.libR), Cint) + end + unsafe_store!(ptr, Cint(1)) + end + count = 0 + for i in 1:n + sleep(0.05) # yield point so timer is triggered + count += 1 + end + return count + end + ') + + time_in_R <- system.time({ + # Run 200 iterations (would take ~10s), but set interrupt after 0.5s. + result <- julia_call("_test_interrupt", 200L, 0.5) + }) + + # check 1: this did not take 200 * 0.05 = 10 seconds. + expect_lt(time_in_R[["elapsed"]], 2.5) # should be around 0.5, but in practice it takes a little longer + + # check 2: return value is NULL + expect_null(result) + + # check 3: the julia session is still alive + expect_equal(julia_eval("1 + 1"), 2) + + # check 4: docall's catch block cleared R_interrupts_pending + flag <- julia_eval("begin + ptr = @static if Sys.iswindows() + cglobal((:UserBreak, RCall.libR), Cint) + else + cglobal((:R_interrupts_pending, RCall.libR), Cint) + end + Int(unsafe_load(ptr)) + end") + expect_equal(flag, 0L) + + # Unconditionally clear the flag to avoid affecting any subsequent tests. + julia_command("unsafe_store!(ptr, Cint(0))") +})