├── .Rbuildignore ├── .github ├── .gitignore └── workflows │ └── R-CMD-check.yaml ├── .gitignore ├── DESCRIPTION ├── LICENSE ├── LICENSE.md ├── LICENSE.note ├── NAMESPACE ├── NEWS.md ├── R ├── RcppExports.R ├── debug.R └── later.R ├── README.md ├── _pkgdown.yml ├── cleanup ├── configure ├── cran-comments.md ├── include ├── inst ├── bgtest.cpp └── include │ ├── later.h │ └── later_api.h ├── later.Rproj ├── man ├── create_loop.Rd ├── later.Rd ├── later_fd.Rd ├── list_queue.Rd ├── logLevel.Rd ├── loop_empty.Rd ├── next_op_secs.Rd └── run_now.Rd ├── revdep ├── .gitignore ├── README.md ├── cran.md ├── failures.md └── problems.md ├── src ├── Makevars.in ├── Makevars.win ├── README.md ├── RcppExports.cpp ├── badthreads.h ├── callback_registry.cpp ├── callback_registry.h ├── callback_registry_table.h ├── debug.cpp ├── debug.h ├── fd.cpp ├── fd.h ├── init.c ├── interrupt.h ├── later.cpp ├── later.h ├── later_posix.cpp ├── later_win32.cpp ├── optional.h ├── threadutils.h ├── timeconv.h ├── timer_posix.cpp ├── timer_posix.h ├── timestamp.h ├── timestamp_unix.cpp ├── timestamp_win32.cpp ├── tinycthread.c ├── tinycthread.h ├── utils.h └── wref.c ├── tests ├── testthat.R └── testthat │ ├── test-c-api.R │ ├── test-cancel.R │ ├── test-later-fd.R │ ├── test-private-loops.R │ └── test-run_now.R └── vignettes └── later-cpp.Rmd /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^.*\.Rproj$ 2 | ^\.Rproj\.user$ 3 | .travis.yml 4 | ^include$ 5 | /\.o$ 6 | /\.so$ 7 | /\.dll$ 8 | ^src/README.md$ 9 | ^appveyor\.yml$ 10 | ^src/Makevars$ 11 | ^\.github$ 12 | ^cran-comments\.md$ 13 | ^LICENSE\.md$ 14 | ^revdep$ 15 | ^CRAN-RELEASE$ 16 | ^_pkgdown\.yml$ 17 | ^docs$ 18 | ^pkgdown$ 19 | -------------------------------------------------------------------------------- /.github/.gitignore: -------------------------------------------------------------------------------- 1 | *.html 2 | -------------------------------------------------------------------------------- /.github/workflows/R-CMD-check.yaml: -------------------------------------------------------------------------------- 1 | # Workflow derived from https://github.com/rstudio/shiny-workflows 2 | # 3 | # NOTE: This Shiny team GHA workflow is overkill for most R packages. 4 | # For most R packages it is better to use https://github.com/r-lib/actions 5 | on: 6 | push: 7 | branches: [main, rc-**] 8 | pull_request: 9 | branches: [main] 10 | schedule: 11 | - cron: '0 5 * * 1' # every monday 12 | 13 | name: Package checks 14 | 15 | jobs: 16 | website: 17 | uses: rstudio/shiny-workflows/.github/workflows/website.yaml@v1 18 | routine: 19 | uses: rstudio/shiny-workflows/.github/workflows/routine.yaml@v1 20 | R-CMD-check: 21 | uses: rstudio/shiny-workflows/.github/workflows/R-CMD-check.yaml@v1 22 | cpp-version-mismatch: 23 | name: cpp-version-mismatch 24 | runs-on: ubuntu-latest 25 | env: 26 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 27 | steps: 28 | - name: Checkout GitHub repo 29 | uses: rstudio/shiny-workflows/.github/internal/checkout@v1 30 | 31 | - name: Install R, system dependencies, and package dependencies 32 | uses: rstudio/shiny-workflows/setup-r-package@v1 33 | with: 34 | needs: check 35 | extra-packages: | 36 | any::remotes 37 | - name: Compile promises against the newest later 38 | run: | 39 | print(packageVersion("later")) 40 | remotes::install_github("rstudio/promises", force = TRUE) 41 | shell: Rscript {0} 42 | - name: Downgrade later 43 | run: | 44 | remotes::install_version('later', '1.3.1') 45 | shell: Rscript {0} 46 | - name: See if dependent package (built against newer later ver) can still load 47 | run: | 48 | print(packageVersion("later")) 49 | library(promises) 50 | shell: Rscript {0} 51 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .Rproj.user 2 | .Rhistory 3 | .RData 4 | .Ruserdata 5 | *.o 6 | *.so 7 | *.dll 8 | inst/doc 9 | src/Makevars 10 | CRAN-RELEASE 11 | docs 12 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: later 2 | Type: Package 3 | Title: Utilities for Scheduling Functions to Execute Later with Event Loops 4 | Version: 1.4.2.9000 5 | Authors@R: c( 6 | person("Winston", "Chang", role = c("aut", "cre"), email = "winston@posit.co"), 7 | person("Joe", "Cheng", role = c("aut"), email = "joe@posit.co"), 8 | person("Charlie", "Gao", role = c("aut"), email = "charlie.gao@shikokuchuo.net", comment = c(ORCID = "0000-0002-0750-061X")), 9 | person(family = "Posit Software, PBC", role = "cph"), 10 | person("Marcus", "Geelnard", role = c("ctb", "cph"), comment = "TinyCThread library, https://tinycthread.github.io/"), 11 | person("Evan", "Nemerson", role = c("ctb", "cph"), comment = "TinyCThread library, https://tinycthread.github.io/") 12 | ) 13 | Description: Executes arbitrary R or C functions some time after the current 14 | time, after the R execution stack has emptied. The functions are scheduled 15 | in an event loop. 16 | URL: https://r-lib.github.io/later/, https://github.com/r-lib/later 17 | BugReports: https://github.com/r-lib/later/issues 18 | License: MIT + file LICENSE 19 | Imports: 20 | Rcpp (>= 0.12.9), 21 | rlang 22 | LinkingTo: Rcpp 23 | Roxygen: list(markdown = TRUE) 24 | RoxygenNote: 7.3.2 25 | Suggests: 26 | knitr, 27 | nanonext, 28 | R6, 29 | rmarkdown, 30 | testthat (>= 2.1.0) 31 | VignetteBuilder: knitr 32 | Encoding: UTF-8 33 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | YEAR: 2020 2 | COPYRIGHT HOLDER: later authors 3 | -------------------------------------------------------------------------------- /LICENSE.md: -------------------------------------------------------------------------------- 1 | # MIT License 2 | 3 | Copyright (c) 2020 later authors 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /LICENSE.note: -------------------------------------------------------------------------------- 1 | This package includes 3rd party open source software components. The following 2 | is a list of these components (full copies of the license agreements used by 3 | these components are included below): 4 | 5 | - TinyCThread, https://tinycthread.github.io/ 6 | 7 | 8 | TinyCThread license 9 | ---------------------------------------------------------------------- 10 | 11 | Copyright (c) 2012 Marcus Geelnard 12 | 2013-2016 Evan Nemerson 13 | 14 | This software is provided 'as-is', without any express or implied 15 | warranty. In no event will the authors be held liable for any damages 16 | arising from the use of this software. 17 | 18 | Permission is granted to anyone to use this software for any purpose, 19 | including commercial applications, and to alter it and redistribute it 20 | freely, subject to the following restrictions: 21 | 22 | 1. The origin of this software must not be misrepresented; you must not 23 | claim that you wrote the original software. If you use this software 24 | in a product, an acknowledgment in the product documentation would be 25 | appreciated but is not required. 26 | 27 | 2. Altered source versions must be plainly marked as such, and must not be 28 | misrepresented as being the original software. 29 | 30 | 3. This notice may not be removed or altered from any source 31 | distribution. 32 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | # Generated by roxygen2: do not edit by hand 2 | 3 | S3method(format,event_loop) 4 | S3method(print,event_loop) 5 | export(create_loop) 6 | export(current_loop) 7 | export(destroy_loop) 8 | export(exists_loop) 9 | export(global_loop) 10 | export(later) 11 | export(later_fd) 12 | export(loop_empty) 13 | export(next_op_secs) 14 | export(run_now) 15 | export(with_loop) 16 | export(with_temp_loop) 17 | importFrom(Rcpp,evalCpp) 18 | useDynLib(later, .registration=TRUE) 19 | -------------------------------------------------------------------------------- /NEWS.md: -------------------------------------------------------------------------------- 1 | # later (development version) 2 | 3 | # later 1.4.2 4 | 5 | * Fixed #208: Fixed `keyword is hidden by macro definition` compiler warning when using a C23 compiler. (@shikokuchuo, #209) 6 | 7 | # later 1.4.1 8 | 9 | * Fixed #203: Resolves an issue where packages that have `LinkingTo: later` (including `promises` and `httpuv`) and were built against `later` 1.4.0, would fail to load on systems that actually had older versions of `later` installed, erroring out with the message "function 'execLaterFdNative' not provided by package 'later'". With this fix, such dependent packages should gracefully deal with older versions at load time, and complain with helpful error messages if newer C interfaces (than are available on the installed `later`) are accessed. (#204) 10 | 11 | # later 1.4.0 12 | 13 | * Adds `later_fd()` which executes a function when a file descriptor is ready for reading or writing, at some indeterminate time in the future (subject to an optional timeout). This facilitates an event-driven approach to asynchronous or streaming downloads. (@shikokuchuo and @jcheng5, #190) 14 | 15 | * Fixed #186: Improvements to package load time as `rlang` is now only loaded when used. This is a notable efficiency for packages with only a 'linking to' dependency on `later`. Also updates to native symbol registration from dynamic lookup. (@shikokuchuo and @wch, #187) 16 | 17 | * Fixed #191: Errors raised in later callbacks were being re-thrown as generic C++ std::runtime_error with Rcpp >= 1.0.10 (since 2022!). (@shikokuchuo and @lionel-, #192) 18 | 19 | # later 1.3.2 20 | 21 | * Fixed `unused variable` compiler warning. (@MichaelChirico, #176) 22 | 23 | * Fixed #177: The order of includes in `later.h` could cause compilation errors on some platforms. (@jeroen, #178) 24 | 25 | * Closed #181: Fix R CMD check warning re error() format strings (for r-devel). (#133) 26 | 27 | # later 1.3.1 28 | 29 | * For C function declarations that take no parameters, added `void` parameter. (#172) 30 | 31 | # later 1.3.0 32 | 33 | * Closed #148: When later was attached, `parallel::makeForkCluster()` would fail. (#149) 34 | 35 | * Fixed #150: It was possible for callbacks to execute in the wrong order if the clock time was changed in between the scheduling of two callbacks. (#151) 36 | 37 | # later 1.2.0 38 | 39 | * Closed #138: later is now licensed as MIT. (#139) 40 | 41 | * Closed #140: Previously, the event loop stopped running if the R process was forked. (#141) 42 | 43 | * Closed #143: Packages which link to later no longer need to take a direct dependency on Rcpp, because `later.h` no longer includes `Rcpp.h`. (#144) 44 | 45 | * Removed dependency on the BH package. C++11 is now required. (#147) 46 | 47 | # later 1.1.0.1 48 | 49 | * Private event loops are now automatically run by their parent. That is, whenever an event loop is run, its children event loops are automatically run. The `create_loop()` function has a new parameter `parent`, which defaults to the current loop. The auto-running behavior can be disabled by using `create_loop(parent=NULL)`. (#119) 50 | 51 | * Fixed #73, #109: Previously, later did not build on some platforms, notably ARM, because the `-latomic` linker was needed on those platforms. A configure script now detects when `-latomic` is needed. (#114) 52 | 53 | * Previously, `execLaterNative` was initialized when the package was loaded, but not `execLaterNative2`, resulting in a warning message in some cases. (#116) 54 | 55 | # later 1.0.0 56 | 57 | * Added private event loops: these are event loops that can be run independently from the global event loop. These are useful when you have code that schedules callbacks with `later()`, and you want to call `run_now()` block and wait for those callbacks to execute before continuing. Without private event loops, if you call `run_now()` to wait until a particular callback has finished, you might inadvertantly run other callbacks that were scheduled by other code. With private event loops, you can create a private loop, schedule a callback on it, then call `run_now()` on that loop until it executes, all without interfering with the global loop. (#84) 58 | 59 | # later 0.8.0 60 | 61 | * Fixed issue #77: On some platforms, the system's C library has support for C11-style threads, but there is no `threads.h` header file. In this case, later's configure script tried to use the tinycthread, but upon linking, there were function name conflicts between tinycthread and the system's C library. Later no longer tries to use the system's `threads.h`, and the functions in tinycthread were renamed so that they do not accidentally link to the system C library's C11-style thread functions. PR #79 62 | 63 | * Added `all` argument to `run_now()`; defaults to `TRUE`, but if set to `FALSE`, then `run_now` will run at most one later operation before returning. PR #75 64 | 65 | * Fixed issue #74: Using later with R at the terminal on POSIX could cause 100% CPU. This was caused by later accidentally provoking R to call its input handler continuously. PR #76 66 | 67 | * Fixed issue #73: Linking later on ARM failed because `boost::atomic` requires the `-lboost_atomic` flag. Now later tries to use `std::atomic` when available (when the compiler supports C++11), and falls back to `boost::atomic` if not. PR #80 68 | 69 | # later 0.7.5 70 | 71 | * Fixed issue where the order of callbacks scheduled by native later::later could be nondeterministic if they are scheduled too quickly. This was because callbacks were sorted by the time at which they come due, which could be identical. Later now uses the order of insertion as a tiebreaker. PR #69 72 | 73 | # later 0.7.4 74 | 75 | * Fixed issue #45 and #63: glibc 2.28 and musl (used on Arch and Alpine Linux) added support for C11-style threads.h, which masked functions from the tinycthread library used by later. Later now detects support for threads.h and uses it if available; otherwise it uses tinycthread. PR #64 76 | 77 | # later 0.7.3 78 | 79 | * Fixed issue #57: If a user interrupt occurred when later (internally) called `sys.nframe()`, the R process would crash. PR #58 80 | 81 | # later 0.7.2 82 | 83 | * Fixed issue #48: Occasional timedwait errors from later::run_now. Thanks, @vnijs! PR #49 84 | 85 | * Fixed a build warning on OS X 10.11 and earlier. PR #54 86 | 87 | # later 0.7.1 88 | 89 | * Fixed issue #39: Calling the C++ function `later::later()` from a different thread could cause an R GC event to occur on that thread, leading to memory corruption. PR #40 90 | 91 | * Decrease latency of repeated top-level execution. 92 | 93 | # later 0.7 (unreleased) 94 | 95 | * Fixed issue #22: GC events could cause an error message: `Error: unimplemented type 'integer' in 'coerceToInteger'`. PR #23 96 | 97 | * Fixed issues #25, #29, and #31: If errors occurred when callbacks were executed by R's input handler (as opposed to by `run_now()`), then they would not be properly handled by R and put the terminal in a problematic state. PR #33 98 | 99 | * Fixed issue #37: High CPU usage on Linux. PR #38 100 | 101 | * Fixed issue #36: Failure to build on OS X <=10.12 (thanks @mingwandroid). PR #21 102 | 103 | # later 0.6 104 | 105 | * Fix a hang on address sanitized (ASAN) builds of R. Issue #16, PR #17 106 | 107 | * The `run_now()` function now takes a `timeoutSecs` argument. If no tasks are ready to run at the time `run_now(timeoutSecs)` is invoked, we will wait up to `timeoutSecs` for one to become ready. The default value of `0` means `run_now()` will return immediately if no tasks are ready, which is the same behavior as in previous releases. PR #19 108 | 109 | * The `run_now()` function used to return only when it was unable to find any more tasks that were due. This means that if tasks were being scheduled at an interval faster than the tasks are executed, `run_now()` would never return. This release changes that behavior so that a timestamp is taken as `run_now()` begins executing, and only tasks whose timestamps are earlier or equal to it are run. PR #18 110 | 111 | * Fix compilation errors on Solaris. Reported by Brian Ripley. PR #20 112 | 113 | # later 0.5 114 | 115 | * Fix a hang on Fedora 25+ which prevented the package from being installed successfully. Reported by @lepennec. Issue #7, PR #10 116 | 117 | * Fixed issue #12: When an exception occurred in a callback function, it would cause future callbacks to not execute. PR #13 118 | 119 | * Added `next_op_secs()` function to report the number of seconds before the next scheduled operation. PR #15 120 | 121 | # later 0.4 122 | 123 | * Add `loop_empty()` function, which returns `TRUE` if there are currently no callbacks that are scheduled to execute in the present or future. 124 | 125 | * On POSIX platforms, fix an issue where socket connections hang when written to/read from while a later callback is scheduled. The fix required stopping the input handler from being called in several spurious situations: 1) when callbacks are already being run, 2) when R code is busy executing (we used to try as often as possible, now we space it out a bit), and 3) when all the scheduled callbacks are in the future. To accomplish this, we use a background thread that acts like a timer to poke the file descriptor whenever the input handler needs to be run--similar to what we already do for Windows. Issue #4 126 | 127 | * On all platforms, don't invoke callbacks if callbacks are already being invoked (unless explicitly requested by a caller to `run_now()`). 128 | 129 | 130 | # later 0.3 131 | 132 | Initial release. 133 | -------------------------------------------------------------------------------- /R/RcppExports.R: -------------------------------------------------------------------------------- 1 | # Generated by using Rcpp::compileAttributes() -> do not edit by hand 2 | # Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393 3 | 4 | testCallbackOrdering <- function() { 5 | invisible(.Call(`_later_testCallbackOrdering`)) 6 | } 7 | 8 | log_level <- function(level) { 9 | .Call(`_later_log_level`, level) 10 | } 11 | 12 | using_ubsan <- function() { 13 | .Call(`_later_using_ubsan`) 14 | } 15 | 16 | execLater_fd <- function(callback, readfds, writefds, exceptfds, timeoutSecs, loop_id) { 17 | .Call(`_later_execLater_fd`, callback, readfds, writefds, exceptfds, timeoutSecs, loop_id) 18 | } 19 | 20 | fd_cancel <- function(xptr) { 21 | .Call(`_later_fd_cancel`, xptr) 22 | } 23 | 24 | setCurrentRegistryId <- function(id) { 25 | invisible(.Call(`_later_setCurrentRegistryId`, id)) 26 | } 27 | 28 | getCurrentRegistryId <- function() { 29 | .Call(`_later_getCurrentRegistryId`) 30 | } 31 | 32 | deleteCallbackRegistry <- function(loop_id) { 33 | .Call(`_later_deleteCallbackRegistry`, loop_id) 34 | } 35 | 36 | notifyRRefDeleted <- function(loop_id) { 37 | .Call(`_later_notifyRRefDeleted`, loop_id) 38 | } 39 | 40 | createCallbackRegistry <- function(id, parent_id) { 41 | invisible(.Call(`_later_createCallbackRegistry`, id, parent_id)) 42 | } 43 | 44 | existsCallbackRegistry <- function(id) { 45 | .Call(`_later_existsCallbackRegistry`, id) 46 | } 47 | 48 | list_queue_ <- function(id) { 49 | .Call(`_later_list_queue_`, id) 50 | } 51 | 52 | execCallbacks <- function(timeoutSecs, runAll, loop_id) { 53 | .Call(`_later_execCallbacks`, timeoutSecs, runAll, loop_id) 54 | } 55 | 56 | idle <- function(loop_id) { 57 | .Call(`_later_idle`, loop_id) 58 | } 59 | 60 | ensureInitialized <- function() { 61 | invisible(.Call(`_later_ensureInitialized`)) 62 | } 63 | 64 | execLater <- function(callback, delaySecs, loop_id) { 65 | .Call(`_later_execLater`, callback, delaySecs, loop_id) 66 | } 67 | 68 | cancel <- function(callback_id_s, loop_id) { 69 | .Call(`_later_cancel`, callback_id_s, loop_id) 70 | } 71 | 72 | nextOpSecs <- function(loop_id) { 73 | .Call(`_later_nextOpSecs`, loop_id) 74 | } 75 | 76 | -------------------------------------------------------------------------------- /R/debug.R: -------------------------------------------------------------------------------- 1 | #' Get and set logging level 2 | #' 3 | #' The logging level for later can be set to report differing levels of 4 | #' information. Possible logging levels (from least to most information 5 | #' reported) are: \code{"OFF"}, \code{"ERROR"}, \code{"WARN"}, \code{"INFO"}, or 6 | #' \code{"DEBUG"}. The default level is \code{ERROR}. 7 | #' 8 | #' @param level The logging level. Must be one of \code{NULL}, \code{"OFF"}, 9 | #' \code{"ERROR"}, \code{"WARN"}, \code{"INFO"}, or \code{"DEBUG"}. If 10 | #' \code{NULL} (the default), then this function simply returns the current 11 | #' logging level. 12 | #' 13 | #' @return If \code{level=NULL}, then this returns the current logging level. If 14 | #' \code{level} is any other value, then this returns the previous logging 15 | #' level, from before it is set to the new value. 16 | #' 17 | #' @keywords internal 18 | logLevel <- function(level = NULL) { 19 | if (is.null(level)) { 20 | level <- "" 21 | log_level("") 22 | } else { 23 | level <- match.arg(level, c("OFF", "ERROR", "WARN", "INFO", "DEBUG")) 24 | invisible(log_level(level)) 25 | } 26 | } 27 | -------------------------------------------------------------------------------- /R/later.R: -------------------------------------------------------------------------------- 1 | #' @useDynLib later, .registration=TRUE 2 | #' @importFrom Rcpp evalCpp 3 | 4 | .onLoad <- function(...) { 5 | ensureInitialized() 6 | .globals$next_id <- 0L 7 | # Store a ref to the global loop so it doesn't get GC'd. 8 | .globals$global_loop <- create_loop(parent = NULL) 9 | } 10 | 11 | .globals <- new.env(parent = emptyenv()) 12 | # A registry of weak refs to loop handle objects. Given an ID number, we can 13 | # get the corresponding loop handle. We use weak refs because we don't want 14 | # this registry to keep the loop objects alive. 15 | .loops <- new.env(parent = emptyenv()) 16 | 17 | # Our own weakref functions are implemented (instead of using those from 18 | # `rlang`) to avoid loading `rlang` automatically upon package load, as this 19 | # causes additional overhead for packages which only link to `later`. 20 | new_weakref <- function(loop) { 21 | .Call(`_later_new_weakref`, loop) 22 | } 23 | 24 | wref_key <- function(w) { 25 | .Call(`_later_wref_key`, w) 26 | } 27 | 28 | #' Private event loops 29 | #' 30 | #' Normally, later uses a global event loop for scheduling and running 31 | #' functions. However, in some cases, it is useful to create a \emph{private} 32 | #' event loop to schedule and execute tasks without disturbing the global event 33 | #' loop. For example, you might have asynchronous code that queries a remote 34 | #' data source, but want to wait for a full back-and-forth communication to 35 | #' complete before continuing in your code -- from the caller's perspective, it 36 | #' should behave like synchronous code, and not do anything with the global 37 | #' event loop (which could run code unrelated to your operation). To do this, 38 | #' you would run your asynchronous code using a private event loop. 39 | #' 40 | #' \code{create_loop} creates and returns a handle to a private event loop, 41 | #' which is useful when for scheduling tasks when you do not want to interfere 42 | #' with the global event loop. 43 | #' 44 | #' \code{destroy_loop} destroys a private event loop. 45 | #' 46 | #' \code{exists_loop} reports whether an event loop exists -- that is, that it 47 | #' has not been destroyed. 48 | #' 49 | #' \code{current_loop} returns the currently-active event loop. Any calls to 50 | #' \code{\link{later}()} or \code{\link{run_now}()} will use the current loop by 51 | #' default. 52 | #' 53 | #' \code{with_loop} evaluates an expression with a given event loop as the 54 | #' currently-active loop. 55 | #' 56 | #' \code{with_temp_loop} creates an event loop, makes it the current loop, then 57 | #' evaluates the given expression. Afterwards, the new event loop is destroyed. 58 | #' 59 | #' \code{global_loop} returns a handle to the global event loop. 60 | #' 61 | #' 62 | #' @param loop A handle to an event loop. 63 | #' @param expr An expression to evaluate. 64 | #' @param autorun This exists only for backward compatibility. If set to 65 | #' \code{FALSE}, it is equivalent to using \code{parent=NULL}. 66 | #' @param parent The parent event loop for the one being created. Whenever the 67 | #' parent loop runs, this loop will also automatically run, without having to 68 | #' manually call \code{\link{run_now}()} on this loop. If \code{NULL}, then 69 | #' this loop will not have a parent event loop that automatically runs it; the 70 | #' only way to run this loop will be by calling \code{\link{run_now}()} on this 71 | #' loop. 72 | #' @rdname create_loop 73 | #' 74 | #' @export 75 | create_loop <- function(parent = current_loop(), autorun = NULL) { 76 | id <- .globals$next_id 77 | .globals$next_id <- id + 1L 78 | 79 | if (!is.null(autorun)) { 80 | # This is for backward compatibility, if `create_loop(autorun=FALSE)` is called. 81 | parent <- NULL 82 | } 83 | if (identical(parent, FALSE)) { 84 | # This is for backward compatibility, if `create_loop(FALSE)` is called. 85 | # (Previously the first and only parameter was `autorun`.) 86 | parent <- NULL 87 | warning("create_loop(FALSE) is deprecated. Please use create_loop(parent=NULL) from now on.") 88 | } 89 | if (!is.null(parent) && !inherits(parent, "event_loop")) { 90 | stop("`parent` must be NULL or an event_loop object.") 91 | } 92 | 93 | if (is.null(parent)) { 94 | parent_id <- -1L 95 | } else { 96 | parent_id <- parent$id 97 | } 98 | createCallbackRegistry(id, parent_id) 99 | 100 | # Create the handle for the loop 101 | loop <- new.env(parent = emptyenv()) 102 | class(loop) <- "event_loop" 103 | loop$id <- id 104 | lockBinding("id", loop) 105 | 106 | # Add a weak reference to the loop object in our registry. 107 | .loops[[as.character(id)]] <- new_weakref(loop) 108 | 109 | if (id != 0L) { 110 | # Inform the C++ layer that there are no more R references when the handle 111 | # is GC'd (unless it's the global loop.) The global loop handle never gets 112 | # GC'd under normal circumstances because .globals$global_loop refers to it. 113 | # However, if the package is unloaded it can get GC'd, and we don't want the 114 | # destroy_loop() finalizer to give an error message about not being able to 115 | # destroy the global loop. 116 | reg.finalizer(loop, notify_r_ref_deleted, onexit = TRUE) 117 | } 118 | 119 | loop 120 | } 121 | 122 | notify_r_ref_deleted <- function(loop) { 123 | if (identical(loop, global_loop())) { 124 | stop("Can't notify that reference to global loop is deleted.") 125 | } 126 | 127 | res <- notifyRRefDeleted(loop$id) 128 | if (res) { 129 | rm(list = as.character(loop$id), envir = .loops) 130 | } 131 | invisible(res) 132 | } 133 | 134 | #' @rdname create_loop 135 | #' @export 136 | destroy_loop <- function(loop) { 137 | if (identical(loop, global_loop())) { 138 | stop("Can't destroy global loop.") 139 | } 140 | 141 | res <- deleteCallbackRegistry(loop$id) 142 | if (res) { 143 | rm(list = as.character(loop$id), envir = .loops) 144 | } 145 | invisible(res) 146 | } 147 | 148 | #' @rdname create_loop 149 | #' @export 150 | exists_loop <- function(loop) { 151 | existsCallbackRegistry(loop$id) 152 | } 153 | 154 | #' @rdname create_loop 155 | #' @export 156 | current_loop <- function() { 157 | id <- getCurrentRegistryId() 158 | loop_weakref <- .loops[[as.character(id)]] 159 | if (is.null(loop_weakref)) { 160 | stop("Current loop with id ", id, " not found.") 161 | } 162 | 163 | loop <- wref_key(loop_weakref) 164 | if (is.null(loop)) { 165 | stop("Current loop with id ", id, " not found.") 166 | } 167 | 168 | loop 169 | } 170 | 171 | #' @rdname create_loop 172 | #' @export 173 | with_temp_loop <- function(expr) { 174 | loop <- create_loop(parent = NULL) 175 | on.exit(destroy_loop(loop)) 176 | 177 | with_loop(loop, expr) 178 | } 179 | 180 | #' @rdname create_loop 181 | #' @export 182 | with_loop <- function(loop, expr) { 183 | if (!exists_loop(loop)) { 184 | stop("loop has been destroyed!") 185 | } 186 | old_loop <- current_loop() 187 | if (!identical(loop, old_loop)) { 188 | on.exit(setCurrentRegistryId(old_loop$id), add = TRUE) 189 | setCurrentRegistryId(loop$id) 190 | } 191 | 192 | force(expr) 193 | } 194 | 195 | #' @rdname create_loop 196 | #' @export 197 | global_loop <- function() { 198 | .globals$global_loop 199 | } 200 | 201 | 202 | #' @export 203 | format.event_loop <- function(x, ...) { 204 | str <- paste0(" ID: ", x$id) 205 | if (!exists_loop(x)) { 206 | str <- paste(str, "(destroyed)") 207 | } 208 | str 209 | } 210 | 211 | #' @export 212 | print.event_loop <- function(x, ...) { 213 | cat(format(x, ...)) 214 | } 215 | 216 | 217 | #' Executes a function later 218 | #' 219 | #' Schedule an R function or formula to run after a specified period of time. 220 | #' Similar to JavaScript's `setTimeout` function. Like JavaScript, R is 221 | #' single-threaded so there's no guarantee that the operation will run exactly 222 | #' at the requested time, only that at least that much time will elapse. 223 | #' 224 | #' The mechanism used by this package is inspired by Simon Urbanek's 225 | #' [background](https://github.com/s-u/background) package and similar code in 226 | #' Rhttpd. 227 | #' 228 | #' @note 229 | #' To avoid bugs due to reentrancy, by default, scheduled operations only run 230 | #' when there is no other R code present on the execution stack; i.e., when R is 231 | #' sitting at the top-level prompt. You can force past-due operations to run at 232 | #' a time of your choosing by calling [run_now()]. 233 | #' 234 | #' Error handling is not particularly well-defined and may change in the future. 235 | #' options(error=browser) should work and errors in `func` should generally not 236 | #' crash the R process, but not much else can be said about it at this point. 237 | #' If you must have specific behavior occur in the face of errors, put error 238 | #' handling logic inside of `func`. 239 | #' 240 | #' @param func A function or formula (see [rlang::as_function()]). 241 | #' @param delay Number of seconds in the future to delay execution. There is no 242 | #' guarantee that the function will be executed at the desired time, but it 243 | #' should not execute earlier. 244 | #' @param loop A handle to an event loop. Defaults to the currently-active loop. 245 | #' 246 | #' @return A function, which, if invoked, will cancel the callback. The 247 | #' function will return \code{TRUE} if the callback was successfully 248 | #' cancelled and \code{FALSE} if not (this occurs if the callback has 249 | #' executed or has been cancelled already). 250 | #' 251 | #' @examples 252 | #' # Example of formula style 253 | #' later(~cat("Hello from the past\n"), 3) 254 | #' 255 | #' # Example of function style 256 | #' later(function() { 257 | #' print(summary(cars)) 258 | #' }, 2) 259 | #' 260 | #' @export 261 | later <- function(func, delay = 0, loop = current_loop()) { 262 | # `rlang::as_function` is used conditionally so that `rlang` is not loaded 263 | # until used, avoiding this overhead for packages only linking to `later` 264 | if (!is.function(func)) { 265 | func <- rlang::as_function(func) 266 | } 267 | id <- execLater(func, delay, loop$id) 268 | 269 | invisible(create_canceller(id, loop$id)) 270 | } 271 | 272 | # Returns a function that will cancel a callback with the given ID. If the 273 | # callback has already been executed or canceled, then the function has no 274 | # effect. 275 | create_canceller <- function(id, loop_id) { 276 | force(id) 277 | force(loop_id) 278 | function() { 279 | invisible(cancel(id, loop_id)) 280 | } 281 | } 282 | 283 | #' Executes a function when a file descriptor is ready 284 | #' 285 | #' Schedule an R function or formula to run after an indeterminate amount of 286 | #' time when file descriptors are ready for reading or writing, subject to an 287 | #' optional timeout. 288 | #' 289 | #' On the occasion the system-level `poll` (on Windows `WSAPoll`) returns an 290 | #' error, the callback will be made on a vector of all `NA`s. This is 291 | #' indistinguishable from a case where the `poll` succeeds but there are error 292 | #' conditions pending against each file descriptor. 293 | #' 294 | #' If no file descriptors are supplied, the callback is scheduled for immediate 295 | #' execution and made on the empty logical vector `logical(0)`. 296 | #' 297 | #' @param func A function that takes a single argument, a logical vector that 298 | #' indicates which file descriptors are ready (a concatenation of `readfds`, 299 | #' `writefds` and `exceptfds`). This may be all `FALSE` if the 300 | #' `timeout` argument is non-`Inf`. File descriptors with error conditions 301 | #' pending are represented as `NA`, as are invalid file descriptors such as 302 | #' those already closed. 303 | #' @param readfds Integer vector of file descriptors, or Windows SOCKETs, to 304 | #' monitor for being ready to read. 305 | #' @param writefds Integer vector of file descriptors, or Windows SOCKETs, to 306 | #' monitor being ready to write. 307 | #' @param exceptfds Integer vector of file descriptors, or Windows SOCKETs, to 308 | #' monitor for error conditions pending. 309 | #' @param timeout Number of seconds to wait before giving up, and calling `func` 310 | #' with all `FALSE`. The default `Inf` implies waiting indefinitely. 311 | #' Specifying `0` will check once without blocking, and supplying a negative 312 | #' value defaults to a timeout of 1s. 313 | #' @param loop A handle to an event loop. Defaults to the currently-active loop. 314 | #' 315 | #' @inherit later return note 316 | #' 317 | #' @examplesIf requireNamespace("nanonext", quietly = TRUE) 318 | #' # create nanonext sockets 319 | #' s1 <- nanonext::socket(listen = "inproc://nano") 320 | #' s2 <- nanonext::socket(dial = "inproc://nano") 321 | #' fd1 <- nanonext::opt(s1, "recv-fd") 322 | #' fd2 <- nanonext::opt(s2, "recv-fd") 323 | #' 324 | #' # 1. timeout: prints FALSE, FALSE 325 | #' later_fd(print, c(fd1, fd2), timeout = 0.1) 326 | #' Sys.sleep(0.2) 327 | #' run_now() 328 | #' 329 | #' # 2. fd1 ready: prints TRUE, FALSE 330 | #' later_fd(print, c(fd1, fd2), timeout = 1) 331 | #' res <- nanonext::send(s2, "msg") 332 | #' Sys.sleep(0.1) 333 | #' run_now() 334 | #' 335 | #' # 3. both ready: prints TRUE, TRUE 336 | #' res <- nanonext::send(s1, "msg") 337 | #' later_fd(print, c(fd1, fd2), timeout = 1) 338 | #' Sys.sleep(0.1) 339 | #' run_now() 340 | #' 341 | #' # 4. fd2 ready: prints FALSE, TRUE 342 | #' res <- nanonext::recv(s1) 343 | #' later_fd(print, c(fd1, fd2), timeout = 1) 344 | #' Sys.sleep(0.1) 345 | #' run_now() 346 | #' 347 | #' # 5. fds invalid: prints NA, NA 348 | #' close(s2) 349 | #' close(s1) 350 | #' later_fd(print, c(fd1, fd2), timeout = 0) 351 | #' Sys.sleep(0.1) 352 | #' run_now() 353 | #' 354 | #' @export 355 | later_fd <- function(func, readfds = integer(), writefds = integer(), exceptfds = integer(), 356 | timeout = Inf, loop = current_loop()) { 357 | if (!is.function(func)) { 358 | func <- rlang::as_function(func) 359 | } 360 | xptr <- execLater_fd(func, readfds, writefds, exceptfds, timeout, loop$id) 361 | 362 | invisible(create_fd_canceller(xptr)) 363 | } 364 | 365 | # Returns a function that will cancel a callback with the given external 366 | # pointer. If the callback has already been executed or canceled, then the 367 | # function has no effect. 368 | create_fd_canceller <- function(xptr) { 369 | force(xptr) 370 | function() { 371 | invisible(fd_cancel(xptr)) 372 | } 373 | } 374 | 375 | #' Execute scheduled operations 376 | #' 377 | #' Normally, operations scheduled with [later()] will not execute unless/until 378 | #' no other R code is on the stack (i.e. at the top-level). If you need to run 379 | #' blocking R code for a long time and want to allow scheduled operations to run 380 | #' at well-defined points of your own operation, you can call `run_now()` at 381 | #' those points and any operations that are due to run will do so. 382 | #' 383 | #' If one of the callbacks throws an error, the error will _not_ be caught, and 384 | #' subsequent callbacks will not be executed (until `run_now()` is called again, 385 | #' or control returns to the R prompt). You must use your own 386 | #' [tryCatch][base::conditions] if you want to handle errors. 387 | #' 388 | #' @param timeoutSecs Wait (block) for up to this number of seconds waiting for 389 | #' an operation to be ready to run. If `0`, then return immediately if there 390 | #' are no operations that are ready to run. If `Inf` or negative, then wait as 391 | #' long as it takes (if none are scheduled, then this will block forever). 392 | #' @param all If `FALSE`, `run_now()` will execute at most one scheduled 393 | #' operation (instead of all eligible operations). This can be useful in cases 394 | #' where you want to interleave scheduled operations with your own logic. 395 | #' @param loop A handle to an event loop. Defaults to the currently-active loop. 396 | #' 397 | #' @return A logical indicating whether any callbacks were actually run. 398 | #' 399 | #' @export 400 | run_now <- function(timeoutSecs = 0L, all = TRUE, loop = current_loop()) { 401 | if (timeoutSecs == Inf) { 402 | timeoutSecs <- -1 403 | } 404 | 405 | if (!is.numeric(timeoutSecs)) 406 | stop("timeoutSecs must be numeric") 407 | 408 | invisible(execCallbacks(timeoutSecs, all, loop$id)) 409 | } 410 | 411 | #' Check if later loop is empty 412 | #' 413 | #' Returns true if there are currently no callbacks that are scheduled to 414 | #' execute in the present or future. 415 | #' 416 | #' @inheritParams create_loop 417 | #' @keywords internal 418 | #' @export 419 | loop_empty <- function(loop = current_loop()) { 420 | idle(loop$id) 421 | } 422 | 423 | #' Relative time to next scheduled operation 424 | #' 425 | #' Returns the duration between now and the earliest operation that is currently 426 | #' scheduled, in seconds. If the operation is in the past, the value will be 427 | #' negative. If no operation is currently scheduled, the value will be `Inf`. 428 | #' 429 | #' @inheritParams create_loop 430 | #' @export 431 | next_op_secs <- function(loop = current_loop()) { 432 | nextOpSecs(loop$id) 433 | } 434 | 435 | 436 | #' Get the contents of an event loop, as a list 437 | #' 438 | #' This function is for debugging only. 439 | #' 440 | #' @keywords internal 441 | list_queue <- function(loop = current_loop()) { 442 | list_queue_(loop$id) 443 | } 444 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # later 2 | 3 | 4 | [![R build status](https://github.com/r-lib/later/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/r-lib/later/actions) 5 | 6 | 7 | 8 | Schedule an R function or formula to run after a specified period of time. Similar to JavaScript's `setTimeout` function. Like JavaScript, R is single-threaded so there's no guarantee that the operation will run exactly at the requested time, only that at least that much time will elapse. 9 | 10 | To avoid bugs due to reentrancy, by default, scheduled operations only run when there is no other R code present on the execution stack; i.e., when R is sitting at the top-level prompt. You can force past-due operations to run at a time of your choosing by calling `later::run_now()`. 11 | 12 | The mechanism used by this package is inspired by Simon Urbanek's [background](https://github.com/s-u/background) package and similar code in Rhttpd. 13 | 14 | ## Installation 15 | 16 | ```r 17 | pak::pak("r-lib/later") 18 | ``` 19 | 20 | ## Usage from R 21 | 22 | Pass a function (in this case, delayed by 5 seconds): 23 | 24 | ```r 25 | later::later(function() { 26 | print("Got here!") 27 | }, 5) 28 | ``` 29 | 30 | Or a formula (in this case, run as soon as control returns to the top-level): 31 | 32 | ```r 33 | later::later(~print("Got here!")) 34 | ``` 35 | ### File Descriptor Readiness 36 | 37 | It is also possible to have a function run based on when file descriptors are ready for reading or writing, at some indeterminate time in the future. 38 | 39 | Below, a logical vector is printed indicating which of file descriptors 21 or 22 were ready, subject to a timeout of 1s. Instead of just printing the result, the supplied function can also do something more useful such as reading from the descriptor. 40 | 41 | ```r 42 | later::later_fd(print, c(21L, 22L), timeout = 1) 43 | ``` 44 | 45 | This is useful in particular for asynchronous or streaming data transfer over the network / internet, so that reads can be made from TCP sockets as soon as data is available. `later::later_fd()` pairs well with functions such as `curl::multi_fdset()` that return the relevant file descriptors to be monitored . 46 | 47 | ## Usage from C++ 48 | 49 | You can also call `later::later` from C++ code in your own packages, to cause your own C-style functions to be called back. This is safe to call from either the main R thread or a different thread; in both cases, your callback will be invoked from the main R thread. 50 | 51 | `later::later` is accessible from `later_api.h` and its prototype looks like this: 52 | 53 | ```cpp 54 | void later(void (*func)(void*), void* data, double secs) 55 | ``` 56 | 57 | The first argument is a pointer to a function that takes one `void*` argument and returns void. The second argument is a `void*` that will be passed to the function when it's called back. And the third argument is the number of seconds to wait (at a minimum) before invoking. 58 | 59 | `later::later_fd` is also accessible from `later_api.h` and its prototype looks like this: 60 | 61 | ```cpp 62 | void later_fd(void (*func)(int *, void *), void *data, int num_fds, struct pollfd *fds, double secs) 63 | ``` 64 | The first argument is a pointer to a function that takes two arguments: the first being an `int*` array provided by `later_fd()` when called back, and the second being a `void*`. The `int*` array will be the length of `num_fds` and contain the values `0`, `1` or `NA_INTEGER` to indicate the readiness of each file descriptor, or an error condition respectively. The second argument `data` is passed to the `void*` argument of the function when it's called back. The third is the total number of file descriptors being passed, the fourth a pointer to an array of `stuct pollfds`, and the fifth the number of seconds to wait until timing out. 65 | 66 | To use the C++ interface, you'll need to add `later` to your `DESCRIPTION` file under both `LinkingTo` and `Imports`, and also make sure that your `NAMESPACE` file has an `import(later)` entry. 67 | 68 | ### Background tasks 69 | 70 | Finally, this package also offers a higher-level C++ helper class to make it easier to execute tasks on a background thread. It is also available from `later_api.h` and its public/protected interface looks like this: 71 | 72 | ```cpp 73 | class BackgroundTask { 74 | 75 | public: 76 | BackgroundTask(); 77 | virtual ~BackgroundTask(); 78 | 79 | // Start executing the task 80 | void begin(); 81 | 82 | protected: 83 | // The task to be executed on the background thread. 84 | // Neither the R runtime nor any R data structures may be 85 | // touched from the background thread; any values that need 86 | // to be passed into or out of the Execute method must be 87 | // included as fields on the Task subclass object. 88 | virtual void execute() = 0; 89 | 90 | // A short task that runs on the main R thread after the 91 | // background task has completed. It's safe to access the 92 | // R runtime and R data structures from here. 93 | virtual void complete() = 0; 94 | } 95 | ``` 96 | 97 | Create your own subclass, implementing a custom constructor plus the `execute` and `complete` methods. 98 | 99 | It's critical that the code in your `execute` method not mutate any R data structures, call any R code, or cause any R allocations, as it will execute in a background thread where such operations are unsafe. You can, however, perform such operations in the constructor (assuming you perform construction only from the main R thread) and `complete` method. Pass values between the constructor and methods using fields. 100 | 101 | ```rcpp 102 | #include 103 | #include 104 | 105 | class MyTask : public later::BackgroundTask { 106 | public: 107 | MyTask(Rcpp::NumericVector vec) : 108 | inputVals(Rcpp::as >(vec)) { 109 | } 110 | 111 | protected: 112 | void execute() { 113 | double sum = 0; 114 | for (std::vector::const_iterator it = inputVals.begin(); 115 | it != inputVals.end(); 116 | it++) { 117 | 118 | sum += *it; 119 | } 120 | result = sum / inputVals.size(); 121 | } 122 | 123 | void complete() { 124 | Rprintf("Result is %f\n", result); 125 | } 126 | 127 | private: 128 | std::vector inputVals; 129 | double result; 130 | }; 131 | ``` 132 | 133 | To run the task, `new` up your subclass and call `begin()`, e.g. `(new MyTask(vec))->begin()`. There's no need to keep track of the pointer; the task object will delete itself when the task is complete. 134 | 135 | ```r 136 | // [[Rcpp::export]] 137 | void asyncMean(Rcpp::NumericVector data) { 138 | (new MyTask(data))->begin(); 139 | } 140 | ``` 141 | 142 | It's not very useful to execute tasks on background threads if you can't get access to the results back in R. The [promises](https://github.com/rstudio/promises) package complements later by providing a "promise" abstraction. 143 | -------------------------------------------------------------------------------- /_pkgdown.yml: -------------------------------------------------------------------------------- 1 | url: https://r-lib.github.io/later 2 | 3 | -------------------------------------------------------------------------------- /cleanup: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | rm -f src/Makevars 3 | -------------------------------------------------------------------------------- /configure: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | echo "Running configure script" 4 | 5 | # Find compiler 6 | CC=`"${R_HOME}"/bin/R CMD config CC` 7 | 8 | # Detect whether -latomic is needed during linking. This is needed on some 9 | # platforms, notably ARM (Raspberry Pi). 10 | echo "#include 11 | uint64_t v; 12 | int main() { 13 | return (int)__atomic_load_n(&v, __ATOMIC_ACQUIRE); 14 | }" | ${CC} -x c - -o /dev/null > /dev/null 2>&1 15 | 16 | if [ $? -eq 0 ]; then 17 | echo "-latomic linker flag not needed." 18 | else 19 | echo "-latomic linker flag needed." 20 | EXTRA_PKG_LIBS=-latomic 21 | fi 22 | 23 | case "$CC" in 24 | *undefined*) 25 | echo "Found UBSAN. Will skip tests that raise false positives." 26 | PKG_CPPFLAGS="$PKG_CPPFLAGS -DUSING_UBSAN" 27 | ;; 28 | esac 29 | 30 | # Write to Makevars 31 | sed -e "s|@extra_pkg_libs@|$EXTRA_PKG_LIBS|" -e "s|@pkg_cppflags@|$PKG_CPPFLAGS|" \ 32 | src/Makevars.in > src/Makevars 33 | 34 | # Success 35 | exit 0 36 | -------------------------------------------------------------------------------- /cran-comments.md: -------------------------------------------------------------------------------- 1 | ## R CMD check results 2 | 3 | 0 errors | 0 warnings | 0 notes 4 | 5 | ## revdepcheck results 6 | 7 | We checked 31 reverse dependencies (26 from CRAN + 5 from Bioconductor), comparing R CMD check results across CRAN and dev versions of this package. 8 | 9 | * We saw 0 new problems 10 | * We failed to check 0 packages 11 | 12 | -------------------------------------------------------------------------------- /include: -------------------------------------------------------------------------------- 1 | inst/include -------------------------------------------------------------------------------- /inst/bgtest.cpp: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | 4 | // Used in tests/testthat/test-run_now.R 5 | 6 | class TestTask : public later::BackgroundTask { 7 | int _timeoutSecs; 8 | 9 | public: 10 | TestTask(int timeoutSecs) : _timeoutSecs(timeoutSecs) {} 11 | 12 | protected: 13 | // The task to be executed on the background thread. 14 | // Neither the R runtime nor any R data structures may be 15 | // touched from the background thread; any values that need 16 | // to be passed into or out of the Execute method must be 17 | // included as fields on the Task subclass object. 18 | void execute() { 19 | sleep(_timeoutSecs); 20 | } 21 | 22 | // A short task that runs on the main R thread after the 23 | // background task has completed. It's safe to access the 24 | // R runtime and R data structures from here. 25 | void complete() {} 26 | }; 27 | 28 | 29 | // [[Rcpp::depends(later)]] 30 | // [[Rcpp::export]] 31 | void launchBgTask(int secsToSleep) { 32 | (new TestTask(secsToSleep))->begin(); 33 | } -------------------------------------------------------------------------------- /inst/include/later.h: -------------------------------------------------------------------------------- 1 | // DO NOT include later.h directly from other packages; use later_api.h instead! 2 | #ifndef _later_later_h 3 | #define _later_later_h 4 | 5 | #include 6 | 7 | #ifndef R_NO_REMAP 8 | #define R_NO_REMAP 9 | #endif 10 | 11 | #ifndef STRICT_R_HEADERS 12 | #define STRICT_R_HEADERS 13 | #endif 14 | 15 | #ifdef _WIN32 16 | #ifndef _WIN32_WINNT 17 | #define _WIN32_WINNT 0x0600 // so R <= 4.1 can find WSAPoll() on Windows 18 | #endif 19 | #include 20 | #define WIN32_LEAN_AND_MEAN 21 | // Taken from http://tolstoy.newcastle.edu.au/R/e2/devel/06/11/1242.html 22 | // Undefine the Realloc macro, which is defined by both R and by Windows stuff 23 | #undef Realloc 24 | // Also need to undefine the Free macro 25 | #undef Free 26 | #include 27 | #else // _WIN32 28 | #include 29 | #include 30 | #endif // _WIN32 31 | 32 | #include 33 | 34 | // Needed for R_GetCCallable on R 3.3 and older; in more recent versions, this 35 | // is included via Rinternals.h. 36 | #include 37 | 38 | 39 | 40 | namespace later { 41 | 42 | // This is the version of the later API provided by this file. Ideally, this 43 | // should match the version of the API provided by the later DLL that is 44 | // installed on the user's system. However, since this file is compiled into 45 | // other packages (like httpuv and promises), it is possible that there will 46 | // be a mismatch. In the future we will be able to compare at runtime it to 47 | // the result from apiVersion(), with: 48 | // 49 | // int (*dll_api_version)() = (int (*)()) R_GetCCallable("later", "apiVersion"); 50 | // if (LATER_H_API_VERSION != (*dll_api_version)()) { ... } 51 | #define LATER_H_API_VERSION 3 52 | #define GLOBAL_LOOP 0 53 | 54 | 55 | // Gets the version of the later API that's provided by the _actually installed_ 56 | // version of later. 57 | static int apiVersionRuntime() { 58 | int (*dll_api_version)(void) = (int (*)(void)) R_GetCCallable("later", "apiVersion"); 59 | return (*dll_api_version)(); 60 | } 61 | 62 | inline void later(void (*func)(void*), void* data, double secs, int loop_id) { 63 | // This function works by retrieving the later::execLaterNative2 function 64 | // pointer using R_GetCCallable the first time it's called (per compilation 65 | // unit, since it's inline). execLaterNative2 is designed to be safe to call 66 | // from any thread, but R_GetCCallable is only safe to call from R's main 67 | // thread (otherwise you get stack imbalance warnings or worse). Therefore, 68 | // we have to ensure that the first call to execLaterNative2 happens on the 69 | // main thread. We accomplish this using a statically initialized object, 70 | // in later_api.h. Therefore, any other packages wanting to call 71 | // execLaterNative2 need to use later_api.h, not later.h. 72 | // 73 | // You may wonder why we used the filenames later_api.h/later.h instead of 74 | // later.h/later_impl.h; it's because Rcpp treats $PACKAGE.h files 75 | // specially by including them in RcppExports.cpp, and we definitely 76 | // do not want the static initialization to happen there. 77 | 78 | // The function type for the real execLaterNative2 79 | typedef void (*elnfun)(void (*func)(void*), void*, double, int); 80 | static elnfun eln = NULL; 81 | if (!eln) { 82 | // Initialize if necessary 83 | if (func) { 84 | // We're not initialized but someone's trying to actually schedule 85 | // some code to be executed! 86 | REprintf( 87 | "Warning: later::execLaterNative2 called in uninitialized state. " 88 | "If you're using , please switch to .\n" 89 | ); 90 | } 91 | eln = (elnfun)R_GetCCallable("later", "execLaterNative2"); 92 | } 93 | 94 | // We didn't want to execute anything, just initialize 95 | if (!func) { 96 | return; 97 | } 98 | 99 | eln(func, data, secs, loop_id); 100 | } 101 | 102 | inline void later(void (*func)(void*), void* data, double secs) { 103 | later(func, data, secs, GLOBAL_LOOP); 104 | } 105 | 106 | static void later_fd_version_error(void (*func)(int *, void *), void *data, int num_fds, struct pollfd *fds, double secs, int loop_id) { 107 | (void) func; (void) data; (void) num_fds; (void) fds; (void) secs; (void) loop_id; 108 | Rf_error("later_fd called, but installed version of the 'later' package is too old; please upgrade 'later' to 1.4.1 or above"); 109 | } 110 | 111 | inline void later_fd(void (*func)(int *, void *), void *data, int num_fds, struct pollfd *fds, double secs, int loop_id) { 112 | // See above note for later() 113 | 114 | // The function type for the real execLaterFdNative 115 | typedef void (*elfdnfun)(void (*)(int *, void *), void *, int, struct pollfd *, double, int); 116 | static elfdnfun elfdn = NULL; 117 | if (!elfdn) { 118 | // Initialize if necessary 119 | if (func) { 120 | // We're not initialized but someone's trying to actually schedule 121 | // some code to be executed! 122 | REprintf( 123 | "Warning: later::execLaterFdNative called in uninitialized state. " 124 | "If you're using , please switch to .\n" 125 | ); 126 | } 127 | if (apiVersionRuntime() >= 3) { 128 | // Only later API version 3 supports execLaterFdNative 129 | elfdn = (elfdnfun) R_GetCCallable("later", "execLaterFdNative"); 130 | } else { 131 | // The installed version is too old and doesn't offer execLaterFdNative. 132 | elfdn = later_fd_version_error; 133 | } 134 | } 135 | 136 | // We didn't want to execute anything, just initialize 137 | if (!func) { 138 | return; 139 | } 140 | 141 | elfdn(func, data, num_fds, fds, secs, loop_id); 142 | } 143 | 144 | inline void later_fd(void (*func)(int *, void *), void *data, int num_fds, struct pollfd *fds, double secs) { 145 | later_fd(func, data, num_fds, fds, secs, GLOBAL_LOOP); 146 | } 147 | 148 | 149 | class BackgroundTask { 150 | 151 | public: 152 | BackgroundTask() {} 153 | virtual ~BackgroundTask() {} 154 | 155 | // Start executing the task 156 | void begin() { 157 | #ifndef _WIN32 158 | pthread_attr_t attr; 159 | pthread_attr_init(&attr); 160 | pthread_attr_setdetachstate(&attr, PTHREAD_CREATE_DETACHED); 161 | pthread_t t; 162 | pthread_create(&t, &attr, BackgroundTask::task_main, this); 163 | pthread_attr_destroy(&attr); 164 | #else 165 | HANDLE hThread = ::CreateThread( 166 | NULL, 0, 167 | BackgroundTask::task_main_win, 168 | this, 169 | 0, 170 | NULL 171 | ); 172 | ::CloseHandle(hThread); 173 | #endif 174 | } 175 | 176 | protected: 177 | // The task to be executed on the background thread. 178 | // Neither the R runtime nor any R data structures may be 179 | // touched from the background thread; any values that need 180 | // to be passed into or out of the Execute method must be 181 | // included as fields on the Task subclass object. 182 | virtual void execute() = 0; 183 | 184 | // A short task that runs on the main R thread after the 185 | // background task has completed. It's safe to access the 186 | // R runtime and R data structures from here. 187 | virtual void complete() = 0; 188 | 189 | private: 190 | static void* task_main(void* data) { 191 | BackgroundTask* task = reinterpret_cast(data); 192 | // TODO: Error handling 193 | task->execute(); 194 | later(&BackgroundTask::result_callback, task, 0); 195 | return NULL; 196 | } 197 | 198 | #ifdef _WIN32 199 | static DWORD WINAPI task_main_win(LPVOID lpParameter) { 200 | task_main(lpParameter); 201 | return 1; 202 | } 203 | #endif 204 | 205 | static void result_callback(void* data) { 206 | BackgroundTask* task = reinterpret_cast(data); 207 | // TODO: Error handling 208 | task->complete(); 209 | delete task; 210 | } 211 | }; 212 | 213 | } // namespace later 214 | 215 | #endif 216 | -------------------------------------------------------------------------------- /inst/include/later_api.h: -------------------------------------------------------------------------------- 1 | #ifndef _later_later_api_h 2 | #define _later_later_api_h 3 | 4 | #include "later.h" 5 | 6 | namespace { 7 | 8 | class LaterInitializer { 9 | public: 10 | LaterInitializer() { 11 | // See comment in execLaterNative to learn why we need to do this 12 | // in a statically initialized object 13 | later::later(NULL, NULL, 0); 14 | later::later_fd(NULL, NULL, 0, NULL, 0); 15 | } 16 | }; 17 | 18 | static LaterInitializer init; 19 | 20 | } // namespace 21 | 22 | #endif // _later_later_api_h 23 | -------------------------------------------------------------------------------- /later.Rproj: -------------------------------------------------------------------------------- 1 | Version: 1.0 2 | 3 | RestoreWorkspace: Default 4 | SaveWorkspace: Default 5 | AlwaysSaveHistory: Default 6 | 7 | EnableCodeIndexing: Yes 8 | UseSpacesForTab: Yes 9 | NumSpacesForTab: 2 10 | Encoding: UTF-8 11 | 12 | RnwWeave: Sweave 13 | LaTeX: pdfLaTeX 14 | 15 | StripTrailingWhitespace: Yes 16 | 17 | BuildType: Package 18 | PackageUseDevtools: Yes 19 | PackageInstallArgs: --no-multiarch --with-keep.source 20 | PackageRoxygenize: rd,collate,namespace 21 | -------------------------------------------------------------------------------- /man/create_loop.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/later.R 3 | \name{create_loop} 4 | \alias{create_loop} 5 | \alias{destroy_loop} 6 | \alias{exists_loop} 7 | \alias{current_loop} 8 | \alias{with_temp_loop} 9 | \alias{with_loop} 10 | \alias{global_loop} 11 | \title{Private event loops} 12 | \usage{ 13 | create_loop(parent = current_loop(), autorun = NULL) 14 | 15 | destroy_loop(loop) 16 | 17 | exists_loop(loop) 18 | 19 | current_loop() 20 | 21 | with_temp_loop(expr) 22 | 23 | with_loop(loop, expr) 24 | 25 | global_loop() 26 | } 27 | \arguments{ 28 | \item{parent}{The parent event loop for the one being created. Whenever the 29 | parent loop runs, this loop will also automatically run, without having to 30 | manually call \code{\link{run_now}()} on this loop. If \code{NULL}, then 31 | this loop will not have a parent event loop that automatically runs it; the 32 | only way to run this loop will be by calling \code{\link{run_now}()} on this 33 | loop.} 34 | 35 | \item{autorun}{This exists only for backward compatibility. If set to 36 | \code{FALSE}, it is equivalent to using \code{parent=NULL}.} 37 | 38 | \item{loop}{A handle to an event loop.} 39 | 40 | \item{expr}{An expression to evaluate.} 41 | } 42 | \description{ 43 | Normally, later uses a global event loop for scheduling and running 44 | functions. However, in some cases, it is useful to create a \emph{private} 45 | event loop to schedule and execute tasks without disturbing the global event 46 | loop. For example, you might have asynchronous code that queries a remote 47 | data source, but want to wait for a full back-and-forth communication to 48 | complete before continuing in your code -- from the caller's perspective, it 49 | should behave like synchronous code, and not do anything with the global 50 | event loop (which could run code unrelated to your operation). To do this, 51 | you would run your asynchronous code using a private event loop. 52 | } 53 | \details{ 54 | \code{create_loop} creates and returns a handle to a private event loop, 55 | which is useful when for scheduling tasks when you do not want to interfere 56 | with the global event loop. 57 | 58 | \code{destroy_loop} destroys a private event loop. 59 | 60 | \code{exists_loop} reports whether an event loop exists -- that is, that it 61 | has not been destroyed. 62 | 63 | \code{current_loop} returns the currently-active event loop. Any calls to 64 | \code{\link{later}()} or \code{\link{run_now}()} will use the current loop by 65 | default. 66 | 67 | \code{with_loop} evaluates an expression with a given event loop as the 68 | currently-active loop. 69 | 70 | \code{with_temp_loop} creates an event loop, makes it the current loop, then 71 | evaluates the given expression. Afterwards, the new event loop is destroyed. 72 | 73 | \code{global_loop} returns a handle to the global event loop. 74 | } 75 | -------------------------------------------------------------------------------- /man/later.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/later.R 3 | \name{later} 4 | \alias{later} 5 | \title{Executes a function later} 6 | \usage{ 7 | later(func, delay = 0, loop = current_loop()) 8 | } 9 | \arguments{ 10 | \item{func}{A function or formula (see \code{\link[rlang:as_function]{rlang::as_function()}}).} 11 | 12 | \item{delay}{Number of seconds in the future to delay execution. There is no 13 | guarantee that the function will be executed at the desired time, but it 14 | should not execute earlier.} 15 | 16 | \item{loop}{A handle to an event loop. Defaults to the currently-active loop.} 17 | } 18 | \value{ 19 | A function, which, if invoked, will cancel the callback. The 20 | function will return \code{TRUE} if the callback was successfully 21 | cancelled and \code{FALSE} if not (this occurs if the callback has 22 | executed or has been cancelled already). 23 | } 24 | \description{ 25 | Schedule an R function or formula to run after a specified period of time. 26 | Similar to JavaScript's \code{setTimeout} function. Like JavaScript, R is 27 | single-threaded so there's no guarantee that the operation will run exactly 28 | at the requested time, only that at least that much time will elapse. 29 | } 30 | \details{ 31 | The mechanism used by this package is inspired by Simon Urbanek's 32 | \href{https://github.com/s-u/background}{background} package and similar code in 33 | Rhttpd. 34 | } 35 | \note{ 36 | To avoid bugs due to reentrancy, by default, scheduled operations only run 37 | when there is no other R code present on the execution stack; i.e., when R is 38 | sitting at the top-level prompt. You can force past-due operations to run at 39 | a time of your choosing by calling \code{\link[=run_now]{run_now()}}. 40 | 41 | Error handling is not particularly well-defined and may change in the future. 42 | options(error=browser) should work and errors in \code{func} should generally not 43 | crash the R process, but not much else can be said about it at this point. 44 | If you must have specific behavior occur in the face of errors, put error 45 | handling logic inside of \code{func}. 46 | } 47 | \examples{ 48 | # Example of formula style 49 | later(~cat("Hello from the past\n"), 3) 50 | 51 | # Example of function style 52 | later(function() { 53 | print(summary(cars)) 54 | }, 2) 55 | 56 | } 57 | -------------------------------------------------------------------------------- /man/later_fd.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/later.R 3 | \name{later_fd} 4 | \alias{later_fd} 5 | \title{Executes a function when a file descriptor is ready} 6 | \usage{ 7 | later_fd( 8 | func, 9 | readfds = integer(), 10 | writefds = integer(), 11 | exceptfds = integer(), 12 | timeout = Inf, 13 | loop = current_loop() 14 | ) 15 | } 16 | \arguments{ 17 | \item{func}{A function that takes a single argument, a logical vector that 18 | indicates which file descriptors are ready (a concatenation of \code{readfds}, 19 | \code{writefds} and \code{exceptfds}). This may be all \code{FALSE} if the 20 | \code{timeout} argument is non-\code{Inf}. File descriptors with error conditions 21 | pending are represented as \code{NA}, as are invalid file descriptors such as 22 | those already closed.} 23 | 24 | \item{readfds}{Integer vector of file descriptors, or Windows SOCKETs, to 25 | monitor for being ready to read.} 26 | 27 | \item{writefds}{Integer vector of file descriptors, or Windows SOCKETs, to 28 | monitor being ready to write.} 29 | 30 | \item{exceptfds}{Integer vector of file descriptors, or Windows SOCKETs, to 31 | monitor for error conditions pending.} 32 | 33 | \item{timeout}{Number of seconds to wait before giving up, and calling \code{func} 34 | with all \code{FALSE}. The default \code{Inf} implies waiting indefinitely. 35 | Specifying \code{0} will check once without blocking, and supplying a negative 36 | value defaults to a timeout of 1s.} 37 | 38 | \item{loop}{A handle to an event loop. Defaults to the currently-active loop.} 39 | } 40 | \value{ 41 | A function, which, if invoked, will cancel the callback. The 42 | function will return \code{TRUE} if the callback was successfully 43 | cancelled and \code{FALSE} if not (this occurs if the callback has 44 | executed or has been cancelled already). 45 | } 46 | \description{ 47 | Schedule an R function or formula to run after an indeterminate amount of 48 | time when file descriptors are ready for reading or writing, subject to an 49 | optional timeout. 50 | } 51 | \details{ 52 | On the occasion the system-level \code{poll} (on Windows \code{WSAPoll}) returns an 53 | error, the callback will be made on a vector of all \code{NA}s. This is 54 | indistinguishable from a case where the \code{poll} succeeds but there are error 55 | conditions pending against each file descriptor. 56 | 57 | If no file descriptors are supplied, the callback is scheduled for immediate 58 | execution and made on the empty logical vector \code{logical(0)}. 59 | } 60 | \note{ 61 | To avoid bugs due to reentrancy, by default, scheduled operations only run 62 | when there is no other R code present on the execution stack; i.e., when R is 63 | sitting at the top-level prompt. You can force past-due operations to run at 64 | a time of your choosing by calling \code{\link[=run_now]{run_now()}}. 65 | 66 | Error handling is not particularly well-defined and may change in the future. 67 | options(error=browser) should work and errors in \code{func} should generally not 68 | crash the R process, but not much else can be said about it at this point. 69 | If you must have specific behavior occur in the face of errors, put error 70 | handling logic inside of \code{func}. 71 | } 72 | \examples{ 73 | \dontshow{if (requireNamespace("nanonext", quietly = TRUE)) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} 74 | # create nanonext sockets 75 | s1 <- nanonext::socket(listen = "inproc://nano") 76 | s2 <- nanonext::socket(dial = "inproc://nano") 77 | fd1 <- nanonext::opt(s1, "recv-fd") 78 | fd2 <- nanonext::opt(s2, "recv-fd") 79 | 80 | # 1. timeout: prints FALSE, FALSE 81 | later_fd(print, c(fd1, fd2), timeout = 0.1) 82 | Sys.sleep(0.2) 83 | run_now() 84 | 85 | # 2. fd1 ready: prints TRUE, FALSE 86 | later_fd(print, c(fd1, fd2), timeout = 1) 87 | res <- nanonext::send(s2, "msg") 88 | Sys.sleep(0.1) 89 | run_now() 90 | 91 | # 3. both ready: prints TRUE, TRUE 92 | res <- nanonext::send(s1, "msg") 93 | later_fd(print, c(fd1, fd2), timeout = 1) 94 | Sys.sleep(0.1) 95 | run_now() 96 | 97 | # 4. fd2 ready: prints FALSE, TRUE 98 | res <- nanonext::recv(s1) 99 | later_fd(print, c(fd1, fd2), timeout = 1) 100 | Sys.sleep(0.1) 101 | run_now() 102 | 103 | # 5. fds invalid: prints NA, NA 104 | close(s2) 105 | close(s1) 106 | later_fd(print, c(fd1, fd2), timeout = 0) 107 | Sys.sleep(0.1) 108 | run_now() 109 | \dontshow{\}) # examplesIf} 110 | } 111 | -------------------------------------------------------------------------------- /man/list_queue.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/later.R 3 | \name{list_queue} 4 | \alias{list_queue} 5 | \title{Get the contents of an event loop, as a list} 6 | \usage{ 7 | list_queue(loop = current_loop()) 8 | } 9 | \description{ 10 | This function is for debugging only. 11 | } 12 | \keyword{internal} 13 | -------------------------------------------------------------------------------- /man/logLevel.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/debug.R 3 | \name{logLevel} 4 | \alias{logLevel} 5 | \title{Get and set logging level} 6 | \usage{ 7 | logLevel(level = NULL) 8 | } 9 | \arguments{ 10 | \item{level}{The logging level. Must be one of \code{NULL}, \code{"OFF"}, 11 | \code{"ERROR"}, \code{"WARN"}, \code{"INFO"}, or \code{"DEBUG"}. If 12 | \code{NULL} (the default), then this function simply returns the current 13 | logging level.} 14 | } 15 | \value{ 16 | If \code{level=NULL}, then this returns the current logging level. If 17 | \code{level} is any other value, then this returns the previous logging 18 | level, from before it is set to the new value. 19 | } 20 | \description{ 21 | The logging level for later can be set to report differing levels of 22 | information. Possible logging levels (from least to most information 23 | reported) are: \code{"OFF"}, \code{"ERROR"}, \code{"WARN"}, \code{"INFO"}, or 24 | \code{"DEBUG"}. The default level is \code{ERROR}. 25 | } 26 | \keyword{internal} 27 | -------------------------------------------------------------------------------- /man/loop_empty.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/later.R 3 | \name{loop_empty} 4 | \alias{loop_empty} 5 | \title{Check if later loop is empty} 6 | \usage{ 7 | loop_empty(loop = current_loop()) 8 | } 9 | \arguments{ 10 | \item{loop}{A handle to an event loop.} 11 | } 12 | \description{ 13 | Returns true if there are currently no callbacks that are scheduled to 14 | execute in the present or future. 15 | } 16 | \keyword{internal} 17 | -------------------------------------------------------------------------------- /man/next_op_secs.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/later.R 3 | \name{next_op_secs} 4 | \alias{next_op_secs} 5 | \title{Relative time to next scheduled operation} 6 | \usage{ 7 | next_op_secs(loop = current_loop()) 8 | } 9 | \arguments{ 10 | \item{loop}{A handle to an event loop.} 11 | } 12 | \description{ 13 | Returns the duration between now and the earliest operation that is currently 14 | scheduled, in seconds. If the operation is in the past, the value will be 15 | negative. If no operation is currently scheduled, the value will be \code{Inf}. 16 | } 17 | -------------------------------------------------------------------------------- /man/run_now.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/later.R 3 | \name{run_now} 4 | \alias{run_now} 5 | \title{Execute scheduled operations} 6 | \usage{ 7 | run_now(timeoutSecs = 0L, all = TRUE, loop = current_loop()) 8 | } 9 | \arguments{ 10 | \item{timeoutSecs}{Wait (block) for up to this number of seconds waiting for 11 | an operation to be ready to run. If \code{0}, then return immediately if there 12 | are no operations that are ready to run. If \code{Inf} or negative, then wait as 13 | long as it takes (if none are scheduled, then this will block forever).} 14 | 15 | \item{all}{If \code{FALSE}, \code{run_now()} will execute at most one scheduled 16 | operation (instead of all eligible operations). This can be useful in cases 17 | where you want to interleave scheduled operations with your own logic.} 18 | 19 | \item{loop}{A handle to an event loop. Defaults to the currently-active loop.} 20 | } 21 | \value{ 22 | A logical indicating whether any callbacks were actually run. 23 | } 24 | \description{ 25 | Normally, operations scheduled with \code{\link[=later]{later()}} will not execute unless/until 26 | no other R code is on the stack (i.e. at the top-level). If you need to run 27 | blocking R code for a long time and want to allow scheduled operations to run 28 | at well-defined points of your own operation, you can call \code{run_now()} at 29 | those points and any operations that are due to run will do so. 30 | } 31 | \details{ 32 | If one of the callbacks throws an error, the error will \emph{not} be caught, and 33 | subsequent callbacks will not be executed (until \code{run_now()} is called again, 34 | or control returns to the R prompt). You must use your own 35 | \link[base:conditions]{tryCatch} if you want to handle errors. 36 | } 37 | -------------------------------------------------------------------------------- /revdep/.gitignore: -------------------------------------------------------------------------------- 1 | checks 2 | library 3 | checks.noindex 4 | library.noindex 5 | cloud.noindex 6 | data.sqlite 7 | *.html 8 | -------------------------------------------------------------------------------- /revdep/README.md: -------------------------------------------------------------------------------- 1 | # Platform 2 | 3 | |field |value | 4 | |:--------|:-------------------------------------| 5 | |version |R version 4.4.3 (2025-02-28) | 6 | |os |Ubuntu 24.04.2 LTS | 7 | |system |x86_64, linux-gnu | 8 | |ui |RStudio | 9 | |language |en_GB:en | 10 | |collate |en_GB.UTF-8 | 11 | |ctype |en_GB.UTF-8 | 12 | |tz |Europe/London | 13 | |date |2025-04-07 | 14 | |rstudio |2024.12.1+563 Kousa Dogwood (desktop) | 15 | |pandoc |3.1.3 @ /usr/bin/pandoc | 16 | |quarto |1.6.40 @ /usr/local/bin/quarto | 17 | 18 | # Dependencies 19 | 20 | |package |old |new |Δ | 21 | |:-------|:------|:----------|:--| 22 | |later |1.4.1 |1.4.1.9000 |* | 23 | |Rcpp |1.0.14 |1.0.14 | | 24 | |rlang |1.1.5 |1.1.5 | | 25 | 26 | # Revdeps 27 | 28 | ## Failed to check (5) 29 | 30 | |package |version |error |warning |note | 31 | |:---------|:-------|:-----|:-------|:----| 32 | |mapview |? | | | | 33 | |OmnipathR |? | | | | 34 | |plumber |? | | | | 35 | |Prostar |? | | | | 36 | |tall |? | | | | 37 | 38 | -------------------------------------------------------------------------------- /revdep/cran.md: -------------------------------------------------------------------------------- 1 | ## revdepcheck results 2 | 3 | We checked 31 reverse dependencies (26 from CRAN + 5 from Bioconductor), comparing R CMD check results across CRAN and dev versions of this package. 4 | 5 | * We saw 0 new problems 6 | * We failed to check 0 packages 7 | 8 | -------------------------------------------------------------------------------- /revdep/failures.md: -------------------------------------------------------------------------------- 1 | # mapview 2 | 3 |
4 | 5 | * Version: 6 | * GitHub: https://github.com/r-lib/later 7 | * Source code: NA 8 | * Number of recursive dependencies: 0 9 | 10 |
11 | 12 | ## Error before installation 13 | 14 | ### Devel 15 | 16 | ``` 17 | 18 | 19 | 20 | 21 | 22 | 23 | ``` 24 | ### CRAN 25 | 26 | ``` 27 | 28 | 29 | 30 | 31 | 32 | 33 | ``` 34 | # OmnipathR 35 | 36 |
37 | 38 | * Version: 39 | * GitHub: https://github.com/r-lib/later 40 | * Source code: NA 41 | * Number of recursive dependencies: 0 42 | 43 |
44 | 45 | ## Error before installation 46 | 47 | ### Devel 48 | 49 | ``` 50 | 51 | 52 | 53 | 54 | 55 | 56 | ``` 57 | ### CRAN 58 | 59 | ``` 60 | 61 | 62 | 63 | 64 | 65 | 66 | ``` 67 | # plumber 68 | 69 |
70 | 71 | * Version: 72 | * GitHub: https://github.com/r-lib/later 73 | * Source code: NA 74 | * Number of recursive dependencies: 0 75 | 76 |
77 | 78 | ## Error before installation 79 | 80 | ### Devel 81 | 82 | ``` 83 | 84 | 85 | 86 | 87 | 88 | 89 | ``` 90 | ### CRAN 91 | 92 | ``` 93 | 94 | 95 | 96 | 97 | 98 | 99 | ``` 100 | # Prostar 101 | 102 |
103 | 104 | * Version: 105 | * GitHub: https://github.com/r-lib/later 106 | * Source code: NA 107 | * Number of recursive dependencies: 0 108 | 109 |
110 | 111 | ## Error before installation 112 | 113 | ### Devel 114 | 115 | ``` 116 | 117 | 118 | 119 | 120 | 121 | 122 | ``` 123 | ### CRAN 124 | 125 | ``` 126 | 127 | 128 | 129 | 130 | 131 | 132 | ``` 133 | # tall 134 | 135 |
136 | 137 | * Version: 138 | * GitHub: https://github.com/r-lib/later 139 | * Source code: NA 140 | * Number of recursive dependencies: 0 141 | 142 |
143 | 144 | ## Error before installation 145 | 146 | ### Devel 147 | 148 | ``` 149 | 150 | 151 | 152 | 153 | 154 | 155 | ``` 156 | ### CRAN 157 | 158 | ``` 159 | 160 | 161 | 162 | 163 | 164 | 165 | ``` 166 | -------------------------------------------------------------------------------- /revdep/problems.md: -------------------------------------------------------------------------------- 1 | *Wow, no problems at all. :)* -------------------------------------------------------------------------------- /src/Makevars.in: -------------------------------------------------------------------------------- 1 | PKG_CPPFLAGS = -pthread -DSTRICT_R_HEADERS -DRCPP_NO_MODULES @pkg_cppflags@ 2 | PKG_LIBS = -pthread @extra_pkg_libs@ 3 | 4 | #### Debugging flags #### 5 | # Uncomment to enable thread assertions 6 | # PKG_CPPFLAGS += -DDEBUG_THREAD -UNDEBUG 7 | -------------------------------------------------------------------------------- /src/Makevars.win: -------------------------------------------------------------------------------- 1 | PKG_CPPFLAGS = -DSTRICT_R_HEADERS -DRCPP_NO_MODULES 2 | PKG_LIBS = -lWs2_32 3 | 4 | #### Debugging flags #### 5 | # Uncomment to enable thread assertions 6 | # PKG_CPPFLAGS += -DDEBUG_THREAD -UNDEBUG 7 | -------------------------------------------------------------------------------- /src/README.md: -------------------------------------------------------------------------------- 1 | Build notes 2 | =========== 3 | 4 | 5 | ## tinycthread 6 | 7 | Later uses threads via the tinycthread library, which has an API that is based on `` from the C11 standard. Our version of tinycthread has a modified API. This is because the API of the standard version of tinycthread is very similar to ``, but this causes problems when linking: if the system's C library implements the functions from threads.h, then during the linking phase, the resulting program will call the C library's functions instead of the functions from tinycthread, which is unsafe and can cause errors. 8 | 9 | The tinycthread library is from https://github.com/tinycthread/tinycthread, and we used commit 6957fc8383d6c7db25b60b8c849b29caab1caaee, which is says it is version 1.2, but it is not officially released or tagged. 10 | 11 | To work around the problem of linking to (incorrect) system functions with the same name, our version of tinycthread has modified names for all externally-visible functions and values: they all begin with `tct_`. 12 | 13 | We also added a dummy header file called `badthreads.h`. For all of the names from C11 threads.h, it `#define`s them to a value that will cause an error at compile time. This is to make sure that we don't accidentally use anything from threads.h. Note: `thread_local` is no longer redefined as it has become a keyword in C23 - it is not used in our code base and we should take care not to use it. 14 | 15 | There is another change that we have made to tinycthread is in `tinycthread.h`. It is a workaround for building on CRAN's Solaris build machine which was needed at some point in the past. Note that when we tested on a Solaris VM, it didn't seem to be necessary, but we kept it there just to be safe, because we can't actually test on the CRAN Solaris build machine. 16 | 17 | ``` 18 | // jcheng 2017-11-03: _XOPEN_SOURCE 600 is necessary to prevent Solaris headers 19 | // from complaining about the combination of C99 and _XOPEN_SOURCE <= 500. The 20 | // error message starts with: 21 | // "Compiler or options invalid for pre-UNIX 03 X/Open applications" 22 | #if defined(sun) && (__STDC_VERSION__ - 0 >= 199901L) && (!defined(_XOPEN_SOURCE) || ((_XOPEN_SOURCE - 0) < 600)) 23 | #undef _XOPEN_SOURCE 24 | #define _XOPEN_SOURCE 600 25 | #endif 26 | ``` 27 | -------------------------------------------------------------------------------- /src/RcppExports.cpp: -------------------------------------------------------------------------------- 1 | // Generated by using Rcpp::compileAttributes() -> do not edit by hand 2 | // Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393 3 | 4 | #include "../inst/include/later.h" 5 | #include 6 | 7 | using namespace Rcpp; 8 | 9 | #ifdef RCPP_USE_GLOBAL_ROSTREAM 10 | Rcpp::Rostream& Rcpp::Rcout = Rcpp::Rcpp_cout_get(); 11 | Rcpp::Rostream& Rcpp::Rcerr = Rcpp::Rcpp_cerr_get(); 12 | #endif 13 | 14 | // testCallbackOrdering 15 | void testCallbackOrdering(); 16 | RcppExport SEXP _later_testCallbackOrdering() { 17 | BEGIN_RCPP 18 | Rcpp::RNGScope rcpp_rngScope_gen; 19 | testCallbackOrdering(); 20 | return R_NilValue; 21 | END_RCPP 22 | } 23 | // log_level 24 | std::string log_level(std::string level); 25 | RcppExport SEXP _later_log_level(SEXP levelSEXP) { 26 | BEGIN_RCPP 27 | Rcpp::RObject rcpp_result_gen; 28 | Rcpp::RNGScope rcpp_rngScope_gen; 29 | Rcpp::traits::input_parameter< std::string >::type level(levelSEXP); 30 | rcpp_result_gen = Rcpp::wrap(log_level(level)); 31 | return rcpp_result_gen; 32 | END_RCPP 33 | } 34 | // using_ubsan 35 | bool using_ubsan(); 36 | RcppExport SEXP _later_using_ubsan() { 37 | BEGIN_RCPP 38 | Rcpp::RObject rcpp_result_gen; 39 | Rcpp::RNGScope rcpp_rngScope_gen; 40 | rcpp_result_gen = Rcpp::wrap(using_ubsan()); 41 | return rcpp_result_gen; 42 | END_RCPP 43 | } 44 | // execLater_fd 45 | Rcpp::RObject execLater_fd(Rcpp::Function callback, Rcpp::IntegerVector readfds, Rcpp::IntegerVector writefds, Rcpp::IntegerVector exceptfds, Rcpp::NumericVector timeoutSecs, Rcpp::IntegerVector loop_id); 46 | RcppExport SEXP _later_execLater_fd(SEXP callbackSEXP, SEXP readfdsSEXP, SEXP writefdsSEXP, SEXP exceptfdsSEXP, SEXP timeoutSecsSEXP, SEXP loop_idSEXP) { 47 | BEGIN_RCPP 48 | Rcpp::RObject rcpp_result_gen; 49 | Rcpp::RNGScope rcpp_rngScope_gen; 50 | Rcpp::traits::input_parameter< Rcpp::Function >::type callback(callbackSEXP); 51 | Rcpp::traits::input_parameter< Rcpp::IntegerVector >::type readfds(readfdsSEXP); 52 | Rcpp::traits::input_parameter< Rcpp::IntegerVector >::type writefds(writefdsSEXP); 53 | Rcpp::traits::input_parameter< Rcpp::IntegerVector >::type exceptfds(exceptfdsSEXP); 54 | Rcpp::traits::input_parameter< Rcpp::NumericVector >::type timeoutSecs(timeoutSecsSEXP); 55 | Rcpp::traits::input_parameter< Rcpp::IntegerVector >::type loop_id(loop_idSEXP); 56 | rcpp_result_gen = Rcpp::wrap(execLater_fd(callback, readfds, writefds, exceptfds, timeoutSecs, loop_id)); 57 | return rcpp_result_gen; 58 | END_RCPP 59 | } 60 | // fd_cancel 61 | Rcpp::LogicalVector fd_cancel(Rcpp::RObject xptr); 62 | RcppExport SEXP _later_fd_cancel(SEXP xptrSEXP) { 63 | BEGIN_RCPP 64 | Rcpp::RObject rcpp_result_gen; 65 | Rcpp::RNGScope rcpp_rngScope_gen; 66 | Rcpp::traits::input_parameter< Rcpp::RObject >::type xptr(xptrSEXP); 67 | rcpp_result_gen = Rcpp::wrap(fd_cancel(xptr)); 68 | return rcpp_result_gen; 69 | END_RCPP 70 | } 71 | // setCurrentRegistryId 72 | void setCurrentRegistryId(int id); 73 | RcppExport SEXP _later_setCurrentRegistryId(SEXP idSEXP) { 74 | BEGIN_RCPP 75 | Rcpp::RNGScope rcpp_rngScope_gen; 76 | Rcpp::traits::input_parameter< int >::type id(idSEXP); 77 | setCurrentRegistryId(id); 78 | return R_NilValue; 79 | END_RCPP 80 | } 81 | // getCurrentRegistryId 82 | int getCurrentRegistryId(); 83 | RcppExport SEXP _later_getCurrentRegistryId() { 84 | BEGIN_RCPP 85 | Rcpp::RObject rcpp_result_gen; 86 | Rcpp::RNGScope rcpp_rngScope_gen; 87 | rcpp_result_gen = Rcpp::wrap(getCurrentRegistryId()); 88 | return rcpp_result_gen; 89 | END_RCPP 90 | } 91 | // deleteCallbackRegistry 92 | bool deleteCallbackRegistry(int loop_id); 93 | RcppExport SEXP _later_deleteCallbackRegistry(SEXP loop_idSEXP) { 94 | BEGIN_RCPP 95 | Rcpp::RObject rcpp_result_gen; 96 | Rcpp::RNGScope rcpp_rngScope_gen; 97 | Rcpp::traits::input_parameter< int >::type loop_id(loop_idSEXP); 98 | rcpp_result_gen = Rcpp::wrap(deleteCallbackRegistry(loop_id)); 99 | return rcpp_result_gen; 100 | END_RCPP 101 | } 102 | // notifyRRefDeleted 103 | bool notifyRRefDeleted(int loop_id); 104 | RcppExport SEXP _later_notifyRRefDeleted(SEXP loop_idSEXP) { 105 | BEGIN_RCPP 106 | Rcpp::RObject rcpp_result_gen; 107 | Rcpp::RNGScope rcpp_rngScope_gen; 108 | Rcpp::traits::input_parameter< int >::type loop_id(loop_idSEXP); 109 | rcpp_result_gen = Rcpp::wrap(notifyRRefDeleted(loop_id)); 110 | return rcpp_result_gen; 111 | END_RCPP 112 | } 113 | // createCallbackRegistry 114 | void createCallbackRegistry(int id, int parent_id); 115 | RcppExport SEXP _later_createCallbackRegistry(SEXP idSEXP, SEXP parent_idSEXP) { 116 | BEGIN_RCPP 117 | Rcpp::RNGScope rcpp_rngScope_gen; 118 | Rcpp::traits::input_parameter< int >::type id(idSEXP); 119 | Rcpp::traits::input_parameter< int >::type parent_id(parent_idSEXP); 120 | createCallbackRegistry(id, parent_id); 121 | return R_NilValue; 122 | END_RCPP 123 | } 124 | // existsCallbackRegistry 125 | bool existsCallbackRegistry(int id); 126 | RcppExport SEXP _later_existsCallbackRegistry(SEXP idSEXP) { 127 | BEGIN_RCPP 128 | Rcpp::RObject rcpp_result_gen; 129 | Rcpp::RNGScope rcpp_rngScope_gen; 130 | Rcpp::traits::input_parameter< int >::type id(idSEXP); 131 | rcpp_result_gen = Rcpp::wrap(existsCallbackRegistry(id)); 132 | return rcpp_result_gen; 133 | END_RCPP 134 | } 135 | // list_queue_ 136 | Rcpp::List list_queue_(int id); 137 | RcppExport SEXP _later_list_queue_(SEXP idSEXP) { 138 | BEGIN_RCPP 139 | Rcpp::RObject rcpp_result_gen; 140 | Rcpp::RNGScope rcpp_rngScope_gen; 141 | Rcpp::traits::input_parameter< int >::type id(idSEXP); 142 | rcpp_result_gen = Rcpp::wrap(list_queue_(id)); 143 | return rcpp_result_gen; 144 | END_RCPP 145 | } 146 | // execCallbacks 147 | bool execCallbacks(double timeoutSecs, bool runAll, int loop_id); 148 | RcppExport SEXP _later_execCallbacks(SEXP timeoutSecsSEXP, SEXP runAllSEXP, SEXP loop_idSEXP) { 149 | BEGIN_RCPP 150 | Rcpp::RObject rcpp_result_gen; 151 | Rcpp::RNGScope rcpp_rngScope_gen; 152 | Rcpp::traits::input_parameter< double >::type timeoutSecs(timeoutSecsSEXP); 153 | Rcpp::traits::input_parameter< bool >::type runAll(runAllSEXP); 154 | Rcpp::traits::input_parameter< int >::type loop_id(loop_idSEXP); 155 | rcpp_result_gen = Rcpp::wrap(execCallbacks(timeoutSecs, runAll, loop_id)); 156 | return rcpp_result_gen; 157 | END_RCPP 158 | } 159 | // idle 160 | bool idle(int loop_id); 161 | RcppExport SEXP _later_idle(SEXP loop_idSEXP) { 162 | BEGIN_RCPP 163 | Rcpp::RObject rcpp_result_gen; 164 | Rcpp::RNGScope rcpp_rngScope_gen; 165 | Rcpp::traits::input_parameter< int >::type loop_id(loop_idSEXP); 166 | rcpp_result_gen = Rcpp::wrap(idle(loop_id)); 167 | return rcpp_result_gen; 168 | END_RCPP 169 | } 170 | // ensureInitialized 171 | void ensureInitialized(); 172 | RcppExport SEXP _later_ensureInitialized() { 173 | BEGIN_RCPP 174 | Rcpp::RNGScope rcpp_rngScope_gen; 175 | ensureInitialized(); 176 | return R_NilValue; 177 | END_RCPP 178 | } 179 | // execLater 180 | std::string execLater(Rcpp::Function callback, double delaySecs, int loop_id); 181 | RcppExport SEXP _later_execLater(SEXP callbackSEXP, SEXP delaySecsSEXP, SEXP loop_idSEXP) { 182 | BEGIN_RCPP 183 | Rcpp::RObject rcpp_result_gen; 184 | Rcpp::RNGScope rcpp_rngScope_gen; 185 | Rcpp::traits::input_parameter< Rcpp::Function >::type callback(callbackSEXP); 186 | Rcpp::traits::input_parameter< double >::type delaySecs(delaySecsSEXP); 187 | Rcpp::traits::input_parameter< int >::type loop_id(loop_idSEXP); 188 | rcpp_result_gen = Rcpp::wrap(execLater(callback, delaySecs, loop_id)); 189 | return rcpp_result_gen; 190 | END_RCPP 191 | } 192 | // cancel 193 | bool cancel(std::string callback_id_s, int loop_id); 194 | RcppExport SEXP _later_cancel(SEXP callback_id_sSEXP, SEXP loop_idSEXP) { 195 | BEGIN_RCPP 196 | Rcpp::RObject rcpp_result_gen; 197 | Rcpp::RNGScope rcpp_rngScope_gen; 198 | Rcpp::traits::input_parameter< std::string >::type callback_id_s(callback_id_sSEXP); 199 | Rcpp::traits::input_parameter< int >::type loop_id(loop_idSEXP); 200 | rcpp_result_gen = Rcpp::wrap(cancel(callback_id_s, loop_id)); 201 | return rcpp_result_gen; 202 | END_RCPP 203 | } 204 | // nextOpSecs 205 | double nextOpSecs(int loop_id); 206 | RcppExport SEXP _later_nextOpSecs(SEXP loop_idSEXP) { 207 | BEGIN_RCPP 208 | Rcpp::RObject rcpp_result_gen; 209 | Rcpp::RNGScope rcpp_rngScope_gen; 210 | Rcpp::traits::input_parameter< int >::type loop_id(loop_idSEXP); 211 | rcpp_result_gen = Rcpp::wrap(nextOpSecs(loop_id)); 212 | return rcpp_result_gen; 213 | END_RCPP 214 | } 215 | -------------------------------------------------------------------------------- /src/badthreads.h: -------------------------------------------------------------------------------- 1 | #ifndef _BADTHREADS_H_ 2 | #define _BADTHREADS_H_ 3 | 4 | /* 5 | * This file contains functions and symbols that are defined in C11 threads.h. 6 | * If any of these symbols are used in a file that includes badthreads.h, it 7 | * should throw an error at compile time. 8 | * 9 | * The purpose of this file is to make sure that code does not accidentally 10 | * use symbols from threads.h. If this happens, and the system C library has 11 | * C11-style thread support, then the resulting object could link to the 12 | * system's functions that have the same name, instead of the local functions. 13 | */ 14 | 15 | #define thrd_t THREADS_H_ERROR 16 | #define thrd_create THREADS_H_ERROR 17 | #define thrd_equal THREADS_H_ERROR 18 | #define thrd_current THREADS_H_ERROR 19 | #define thrd_sleep THREADS_H_ERROR 20 | #define thrd_yield THREADS_H_ERROR 21 | #define thrd_exit THREADS_H_ERROR 22 | #define thrd_detach THREADS_H_ERROR 23 | #define thrd_join THREADS_H_ERROR 24 | #define thrd_success THREADS_H_ERROR 25 | #define thrd_timedout THREADS_H_ERROR 26 | #define thrd_busy THREADS_H_ERROR 27 | #define thrd_nomem THREADS_H_ERROR 28 | #define thrd_error THREADS_H_ERROR 29 | #define thrd_start_t THREADS_H_ERROR 30 | #define mtx_t THREADS_H_ERROR 31 | #define mtx_init THREADS_H_ERROR 32 | #define mtx_lock THREADS_H_ERROR 33 | #define mtx_timedlock THREADS_H_ERROR 34 | #define mtx_trylock THREADS_H_ERROR 35 | #define mtx_unlock THREADS_H_ERROR 36 | #define mtx_destroy THREADS_H_ERROR 37 | #define mtx_plain THREADS_H_ERROR 38 | #define mtx_recursive THREADS_H_ERROR 39 | #define mtx_timed THREADS_H_ERROR 40 | #define call_once THREADS_H_ERROR 41 | #define cnd_t THREADS_H_ERROR 42 | #define cnd_init THREADS_H_ERROR 43 | #define cnd_signal THREADS_H_ERROR 44 | #define cnd_broadcast THREADS_H_ERROR 45 | #define cnd_wait THREADS_H_ERROR 46 | #define cnd_timedwait THREADS_H_ERROR 47 | #define cnd_destroy THREADS_H_ERROR 48 | // #define thread_local THREADS_H_ERROR /* Don't redefine thread_local as it is a keyword in C23 */ 49 | #define tss_t THREADS_H_ERROR 50 | #define TSS_DTOR_ITERATIONS THREADS_H_ERROR 51 | #define tss_dtor_t THREADS_H_ERROR 52 | #define tss_create THREADS_H_ERROR 53 | #define tss_get THREADS_H_ERROR 54 | #define tss_set THREADS_H_ERROR 55 | #define tss_delete THREADS_H_ERROR 56 | 57 | 58 | #endif 59 | -------------------------------------------------------------------------------- /src/callback_registry.cpp: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | #include 5 | 6 | #include "callback_registry.h" 7 | #include "debug.h" 8 | 9 | std::atomic nextCallbackId(1); 10 | 11 | // ============================================================================ 12 | // Invoke functions 13 | // ============================================================================ 14 | 15 | enum InvokeResult { 16 | INVOKE_IN_PROGRESS, 17 | INVOKE_INTERRUPTED, 18 | INVOKE_ERROR, 19 | INVOKE_CPP_ERROR, 20 | INVOKE_COMPLETED 21 | }; 22 | 23 | // This is set by invoke_c(). I 24 | InvokeResult last_invoke_result; 25 | std::string last_invoke_message; 26 | 27 | // A wrapper for calling R_CheckUserInterrupt via R_ToplevelExec. 28 | void checkInterruptFn(void*) { 29 | R_CheckUserInterrupt(); 30 | } 31 | 32 | // The purpose of this function is to provide a plain C function to be called 33 | // by R_ToplevelExec. Because it's called as a C function, it must not throw 34 | // exceptions. Because this function returns void, the way for it to report 35 | // the result to its caller is by setting last_invoke_result. 36 | // 37 | // This code needs to be able to handle interrupts, R errors, and C++ 38 | // exceptions. There are many ways these things can happen. 39 | // 40 | // * If the Callback object is a RcppFunctionCallback, then in the case of an 41 | // interrupt or an R error, it will throw a C++ exception. These exceptions 42 | // are the ones defined by Rcpp, and they will be caught by the try-catch in 43 | // this function. 44 | // * It could be a StdFunctionCallback with C or C++ code. 45 | // * If the function invokes an Rcpp::Function and an interrupt or R error 46 | // happens within the Rcpp::Function, it will throw exceptions just like 47 | // the RcppFunctionCallback case, and they will be caught. 48 | // * If some other C++ exception occurs, it will be caught. 49 | // * If an interrupt (Ctrl-C, or Esc in RStudio) is received (outside of an 50 | // Rcpp::Function), this function will continue through to the end (and 51 | // set the state to INVOKE_COMPLETED). Later, when the invoke_wrapper() 52 | // function (which called this one) checks to see if the interrupt 53 | // happened, it will set the state to INVOKE_INTERRUPTED. (Note that it is 54 | // potentially possible for an interrupt and an exception to occur, in 55 | // which case we set the state to INVOKE_ERROR.) 56 | // * If the function calls R code with Rf_eval(), an interrupt or R error 57 | // could occur. If it's an interrupt, then it will be detect as in the 58 | // previous case. If an error occurs, then that error will be detected by 59 | // the invoke_wrapper() function (which called this one) and the state 60 | // will be set to INVOKE_ERROR. 61 | // 62 | // Note that the last case has one potentially problematic issue. If an error 63 | // occurs in R code, then it will longjmp out of of this function, back to its 64 | // caller, invoke_wrapped(). This will longjmp out of a try statement, which 65 | // is generally not a good idea. We don't know ahead of time whether the 66 | // Callback may longjmp or throw an exception -- some Callbacks could 67 | // potentially do both. 68 | // 69 | // The alternative is to move the try-catch out of this function and into 70 | // invoke_wrapped(), surrounding the `R_ToplevelExec(invoke_c, ...)`. However, 71 | // if we do this, then exceptions would pass through the R_ToplevelExec, which 72 | // is dangerous because it is plain C code. The current way of doing it is 73 | // imperfect, but less dangerous. 74 | // 75 | // There does not seem to be a 100% safe way to call functions which could 76 | // either longjmp or throw exceptions. If we do figure out a way to do that, 77 | // it should be used here. 78 | extern "C" void invoke_c(void* callback_p) { 79 | ASSERT_MAIN_THREAD() 80 | last_invoke_result = INVOKE_IN_PROGRESS; 81 | last_invoke_message = ""; 82 | 83 | Callback* cb_p = (Callback*)callback_p; 84 | 85 | try { 86 | cb_p->invoke(); 87 | } 88 | catch(Rcpp::internal::InterruptedException &e) { 89 | // Reaches here if the callback is in Rcpp code and an interrupt occurs. 90 | DEBUG_LOG("invoke_c: caught Rcpp::internal::InterruptedException", LOG_INFO); 91 | last_invoke_result = INVOKE_INTERRUPTED; 92 | return; 93 | } 94 | catch(Rcpp::eval_error &e) { 95 | // Reaches here if an R-level error happens in an Rcpp::Function. 96 | DEBUG_LOG("invoke_c: caught Rcpp::eval_error", LOG_INFO); 97 | last_invoke_result = INVOKE_ERROR; 98 | last_invoke_message = e.what(); 99 | return; 100 | } 101 | catch(Rcpp::exception& e) { 102 | // Reaches here if an R-level error happens in an Rcpp::Function. 103 | DEBUG_LOG("invoke_c: caught Rcpp::exception", LOG_INFO); 104 | last_invoke_result = INVOKE_ERROR; 105 | last_invoke_message = e.what(); 106 | return; 107 | } 108 | catch(std::exception& e) { 109 | // Reaches here if some other (non-Rcpp) C++ exception is thrown. 110 | DEBUG_LOG(std::string("invoke_c: caught std::exception: ") + typeid(e).name(), 111 | LOG_INFO); 112 | last_invoke_result = INVOKE_CPP_ERROR; 113 | last_invoke_message = e.what(); 114 | return; 115 | } 116 | catch( ... ) { 117 | // Reaches here if a non-exception C++ object is thrown. 118 | DEBUG_LOG(std::string("invoke_c: caught unknown object: ") + typeid(std::current_exception()).name(), 119 | LOG_INFO); 120 | last_invoke_result = INVOKE_CPP_ERROR; 121 | return; 122 | } 123 | 124 | // Reaches here if no exceptions are thrown. It's possible to get here if an 125 | // interrupt was received outside of Rcpp code, or if an R error happened 126 | // using Rf_eval(). 127 | DEBUG_LOG("invoke_c: COMPLETED", LOG_DEBUG); 128 | last_invoke_result = INVOKE_COMPLETED; 129 | } 130 | 131 | // Wrapper method for invoking a callback. The Callback object has an invoke() 132 | // method, but instead of invoking it directly, this method should be used 133 | // instead. The purpose of this method is to call invoke(), but wrap it in a 134 | // R_ToplevelExec, so that any LONGJMPs (due to errors in R functions) won't 135 | // cross that barrier in the call stack. If interrupts, exceptions, or 136 | // LONGJMPs do occur, this function throws a C++ exception. 137 | void Callback::invoke_wrapped() const { 138 | ASSERT_MAIN_THREAD() 139 | Rboolean result = R_ToplevelExec(invoke_c, (void*)this); 140 | 141 | if (!result) { 142 | DEBUG_LOG("invoke_wrapped: R_ToplevelExec return is FALSE; error or interrupt occurred in R code", LOG_INFO); 143 | last_invoke_result = INVOKE_ERROR; 144 | } 145 | 146 | if (R_ToplevelExec(checkInterruptFn, NULL) == FALSE) { 147 | // Reaches here if the callback is C/C++ code and an interrupt occurs. 148 | DEBUG_LOG("invoke_wrapped: interrupt (outside of R code) detected by R_CheckUserInterrupt", LOG_INFO); 149 | last_invoke_result = INVOKE_INTERRUPTED; 150 | } 151 | 152 | switch (last_invoke_result) { 153 | case INVOKE_INTERRUPTED: 154 | DEBUG_LOG("invoke_wrapped: throwing Rcpp::internal::InterruptedException", LOG_INFO); 155 | throw Rcpp::internal::InterruptedException(); 156 | case INVOKE_ERROR: 157 | DEBUG_LOG("invoke_wrapped: throwing Rcpp::exception", LOG_INFO); 158 | throw Rcpp::exception(last_invoke_message.c_str()); 159 | case INVOKE_CPP_ERROR: 160 | throw std::runtime_error("invoke_wrapped: throwing std::runtime_error"); 161 | default: 162 | return; 163 | } 164 | } 165 | 166 | 167 | // ============================================================================ 168 | // StdFunctionCallback 169 | // ============================================================================ 170 | 171 | StdFunctionCallback::StdFunctionCallback(Timestamp when, std::function func) : 172 | Callback(when), 173 | func(func) 174 | { 175 | this->callbackId = nextCallbackId++; 176 | } 177 | 178 | Rcpp::RObject StdFunctionCallback::rRepresentation() const { 179 | using namespace Rcpp; 180 | ASSERT_MAIN_THREAD() 181 | 182 | return List::create( 183 | _["id"] = callbackId, 184 | _["when"] = when.diff_secs(Timestamp()), 185 | _["callback"] = Rcpp::CharacterVector::create("C/C++ function") 186 | ); 187 | } 188 | 189 | 190 | // ============================================================================ 191 | // RcppFunctionCallback 192 | // ============================================================================ 193 | 194 | RcppFunctionCallback::RcppFunctionCallback(Timestamp when, Rcpp::Function func) : 195 | Callback(when), 196 | func(func) 197 | { 198 | ASSERT_MAIN_THREAD() 199 | this->callbackId = nextCallbackId++; 200 | } 201 | 202 | Rcpp::RObject RcppFunctionCallback::rRepresentation() const { 203 | using namespace Rcpp; 204 | ASSERT_MAIN_THREAD() 205 | 206 | return List::create( 207 | _["id"] = callbackId, 208 | _["when"] = when.diff_secs(Timestamp()), 209 | _["callback"] = func 210 | ); 211 | } 212 | 213 | 214 | // ============================================================================ 215 | // CallbackRegistry 216 | // ============================================================================ 217 | 218 | // [[Rcpp::export]] 219 | void testCallbackOrdering() { 220 | std::vector callbacks; 221 | Timestamp ts; 222 | std::function func; 223 | for (size_t i = 0; i < 100; i++) { 224 | callbacks.push_back(StdFunctionCallback(ts, func)); 225 | } 226 | for (size_t i = 1; i < 100; i++) { 227 | if (callbacks[i] < callbacks[i-1]) { 228 | ::Rf_error("Callback ordering is broken [1]"); 229 | } 230 | if (!(callbacks[i] > callbacks[i-1])) { 231 | ::Rf_error("Callback ordering is broken [2]"); 232 | } 233 | if (callbacks[i-1] > callbacks[i]) { 234 | ::Rf_error("Callback ordering is broken [3]"); 235 | } 236 | if (!(callbacks[i-1] < callbacks[i])) { 237 | ::Rf_error("Callback ordering is broken [4]"); 238 | } 239 | } 240 | for (size_t i = 100; i > 1; i--) { 241 | if (callbacks[i-1] < callbacks[i-2]) { 242 | ::Rf_error("Callback ordering is broken [2]"); 243 | } 244 | } 245 | } 246 | 247 | CallbackRegistry::CallbackRegistry(int id, Mutex* mutex, ConditionVariable* condvar) 248 | : id(id), mutex(mutex), condvar(condvar) 249 | { 250 | ASSERT_MAIN_THREAD() 251 | } 252 | 253 | CallbackRegistry::~CallbackRegistry() { 254 | ASSERT_MAIN_THREAD() 255 | } 256 | 257 | int CallbackRegistry::getId() const { 258 | return id; 259 | } 260 | 261 | uint64_t CallbackRegistry::add(Rcpp::Function func, double secs) { 262 | // Copies of the Rcpp::Function should only be made on the main thread. 263 | ASSERT_MAIN_THREAD() 264 | Timestamp when(secs); 265 | Callback_sp cb = std::make_shared(when, func); 266 | Guard guard(mutex); 267 | queue.insert(cb); 268 | condvar->signal(); 269 | 270 | return cb->getCallbackId(); 271 | } 272 | 273 | uint64_t CallbackRegistry::add(void (*func)(void*), void* data, double secs) { 274 | Timestamp when(secs); 275 | Callback_sp cb = std::make_shared(when, std::bind(func, data)); 276 | Guard guard(mutex); 277 | queue.insert(cb); 278 | condvar->signal(); 279 | 280 | return cb->getCallbackId(); 281 | } 282 | 283 | bool CallbackRegistry::cancel(uint64_t id) { 284 | Guard guard(mutex); 285 | 286 | cbSet::const_iterator it; 287 | for (it = queue.begin(); it != queue.end(); ++it) { 288 | if ((*it)->getCallbackId() == id) { 289 | queue.erase(it); 290 | return true; 291 | } 292 | } 293 | 294 | return false; 295 | } 296 | 297 | // The smallest timestamp present in the registry, if any. 298 | // Use this to determine the next time we need to pump events. 299 | Optional CallbackRegistry::nextTimestamp(bool recursive) const { 300 | Guard guard(mutex); 301 | 302 | Optional minTimestamp; 303 | 304 | if (! this->queue.empty()) { 305 | cbSet::const_iterator it = queue.begin(); 306 | minTimestamp = Optional((*it)->when); 307 | } 308 | 309 | // Now check children 310 | if (recursive) { 311 | for (std::vector >::const_iterator it = children.begin(); 312 | it != children.end(); 313 | ++it) 314 | { 315 | Optional childNextTimestamp = (*it)->nextTimestamp(recursive); 316 | 317 | if (childNextTimestamp.has_value()) { 318 | if (minTimestamp.has_value()) { 319 | if (*childNextTimestamp < *minTimestamp) { 320 | minTimestamp = childNextTimestamp; 321 | } 322 | } else { 323 | minTimestamp = childNextTimestamp; 324 | } 325 | } 326 | } 327 | } 328 | 329 | return minTimestamp; 330 | } 331 | 332 | bool CallbackRegistry::empty() const { 333 | Guard guard(mutex); 334 | return this->queue.empty() && this->fd_waits == 0; 335 | } 336 | 337 | // Returns true if the smallest timestamp exists and is not in the future. 338 | bool CallbackRegistry::due(const Timestamp& time, bool recursive) const { 339 | ASSERT_MAIN_THREAD() 340 | Guard guard(mutex); 341 | cbSet::const_iterator cbSet_it = queue.begin(); 342 | if (!this->queue.empty() && !((*cbSet_it)->when > time)) { 343 | return true; 344 | } 345 | 346 | // Now check children 347 | if (recursive) { 348 | for (std::vector >::const_iterator it = children.begin(); 349 | it != children.end(); 350 | ++it) 351 | { 352 | if ((*it)->due(time, true)) { 353 | return true; 354 | } 355 | } 356 | } 357 | 358 | return false; 359 | } 360 | 361 | std::vector CallbackRegistry::take(size_t max, const Timestamp& time) { 362 | ASSERT_MAIN_THREAD() 363 | Guard guard(mutex); 364 | std::vector results; 365 | while (this->due(time, false) && (max <= 0 || results.size() < max)) { 366 | cbSet::iterator it = queue.begin(); 367 | results.push_back(*it); 368 | this->queue.erase(it); 369 | } 370 | return results; 371 | } 372 | 373 | bool CallbackRegistry::wait(double timeoutSecs, bool recursive) const { 374 | ASSERT_MAIN_THREAD() 375 | if (timeoutSecs < 0) { 376 | // "1000 years ought to be enough for anybody" --Bill Gates 377 | timeoutSecs = 3e10; 378 | } 379 | 380 | Timestamp expireTime(timeoutSecs); 381 | 382 | Guard guard(mutex); 383 | while (true) { 384 | Timestamp end = expireTime; 385 | Optional next = nextTimestamp(recursive); 386 | if (next.has_value() && *next < expireTime) { 387 | end = *next; 388 | } 389 | double waitFor = end.diff_secs(Timestamp()); 390 | if (waitFor <= 0) 391 | break; 392 | // Don't wait for more than 2 seconds at a time, in order to keep us 393 | // at least somewhat responsive to user interrupts 394 | if (waitFor > 2) { 395 | waitFor = 2; 396 | } 397 | condvar->timedwait(waitFor); 398 | Rcpp::checkUserInterrupt(); 399 | } 400 | 401 | return due(); 402 | } 403 | 404 | 405 | Rcpp::List CallbackRegistry::list() const { 406 | ASSERT_MAIN_THREAD() 407 | Guard guard(mutex); 408 | 409 | Rcpp::List results; 410 | 411 | cbSet::const_iterator it; 412 | 413 | for (it = queue.begin(); it != queue.end(); it++) { 414 | results.push_back((*it)->rRepresentation()); 415 | } 416 | 417 | return results; 418 | } 419 | 420 | void CallbackRegistry::fd_waits_incr() { 421 | Guard guard(mutex); 422 | ++fd_waits; 423 | } 424 | 425 | void CallbackRegistry::fd_waits_decr() { 426 | Guard guard(mutex); 427 | --fd_waits; 428 | } 429 | -------------------------------------------------------------------------------- /src/callback_registry.h: -------------------------------------------------------------------------------- 1 | #ifndef _CALLBACK_REGISTRY_H_ 2 | #define _CALLBACK_REGISTRY_H_ 3 | 4 | #include 5 | #include 6 | #include 7 | #include 8 | #include "timestamp.h" 9 | #include "optional.h" 10 | #include "threadutils.h" 11 | 12 | // Callback is an abstract class with two subclasses. The reason that there 13 | // are two subclasses is because one of them is for C++ (std::function) 14 | // callbacks, and the other is for R (Rcpp::Function) callbacks. Because 15 | // Callbacks can be created from either the main thread or a background 16 | // thread, the top-level Callback class cannot contain any Rcpp objects -- 17 | // otherwise R objects could be allocated on a background thread, which will 18 | // cause memory corruption. 19 | 20 | class Callback { 21 | 22 | public: 23 | virtual ~Callback() {}; 24 | Callback(Timestamp when) : when(when) {}; 25 | 26 | bool operator<(const Callback& other) const { 27 | return this->when < other.when || 28 | (!(this->when > other.when) && this->callbackId < other.callbackId); 29 | } 30 | 31 | bool operator>(const Callback& other) const { 32 | return other < *this; 33 | } 34 | 35 | uint64_t getCallbackId() const { 36 | return callbackId; 37 | }; 38 | 39 | virtual void invoke() const = 0; 40 | 41 | void invoke_wrapped() const; 42 | 43 | virtual Rcpp::RObject rRepresentation() const = 0; 44 | 45 | Timestamp when; 46 | 47 | protected: 48 | // Used to break ties when comparing to a callback that has precisely the same 49 | // timestamp 50 | uint64_t callbackId; 51 | }; 52 | 53 | 54 | class StdFunctionCallback : public Callback { 55 | public: 56 | StdFunctionCallback(Timestamp when, std::function func); 57 | 58 | void invoke() const { 59 | #ifdef RCPP_USING_UNWIND_PROTECT // See https://github.com/r-lib/later/issues/191 60 | Rcpp::unwindProtect([this]() { 61 | BEGIN_RCPP 62 | func(); 63 | END_RCPP 64 | }); 65 | #else 66 | func(); 67 | #endif 68 | } 69 | 70 | Rcpp::RObject rRepresentation() const; 71 | 72 | private: 73 | std::function func; 74 | }; 75 | 76 | 77 | class RcppFunctionCallback : public Callback { 78 | public: 79 | RcppFunctionCallback(Timestamp when, Rcpp::Function func); 80 | 81 | void invoke() const { 82 | func(); 83 | } 84 | 85 | Rcpp::RObject rRepresentation() const; 86 | 87 | private: 88 | Rcpp::Function func; 89 | }; 90 | 91 | 92 | 93 | typedef std::shared_ptr Callback_sp; 94 | 95 | template 96 | struct pointer_less_than { 97 | const bool operator()(const T a, const T b) const { 98 | return *a < *b; 99 | } 100 | }; 101 | 102 | 103 | // Stores R function callbacks, ordered by timestamp. 104 | class CallbackRegistry { 105 | private: 106 | int id; 107 | 108 | // Most of the behavior of the registry is like a priority queue. However, a 109 | // std::priority_queue only allows access to the top element, and when we 110 | // cancel a callback or get an Rcpp::List representation, we need random 111 | // access, so we'll use a std::set. 112 | typedef std::set > cbSet; 113 | // This is a priority queue of shared pointers to Callback objects. The 114 | // reason it is not a priority_queue is because that can cause 115 | // objects to be copied on the wrong thread, and even trigger an R GC event 116 | // on the wrong thread. https://github.com/r-lib/later/issues/39 117 | cbSet queue; 118 | int fd_waits = 0; 119 | Mutex* mutex; 120 | ConditionVariable* condvar; 121 | 122 | public: 123 | // The CallbackRegistry must be given a Mutex and ConditionVariable when 124 | // initialized, because they are shared among the CallbackRegistry objects 125 | // and the CallbackRegistryTable; they serve as a global lock. Note that the 126 | // lifetime of these objects must be longer than the CallbackRegistry. 127 | CallbackRegistry(int id, Mutex* mutex, ConditionVariable* condvar); 128 | ~CallbackRegistry(); 129 | 130 | int getId() const; 131 | 132 | // Add a function to the registry, to be executed at `secs` seconds in 133 | // the future (i.e. relative to the current time). 134 | uint64_t add(Rcpp::Function func, double secs); 135 | 136 | // Add a C function to the registry, to be executed at `secs` seconds in 137 | // the future (i.e. relative to the current time). 138 | uint64_t add(void (*func)(void*), void* data, double secs); 139 | 140 | bool cancel(uint64_t id); 141 | 142 | // The smallest timestamp present in the registry, if any. 143 | // Use this to determine the next time we need to pump events. 144 | Optional nextTimestamp(bool recursive = true) const; 145 | 146 | // Is the registry completely empty? (including later_fd waits) 147 | bool empty() const; 148 | 149 | // Is anything ready to execute? 150 | bool due(const Timestamp& time = Timestamp(), bool recursive = true) const; 151 | 152 | // Pop and return an ordered list of functions to execute now. 153 | std::vector take(size_t max = -1, const Timestamp& time = Timestamp()); 154 | 155 | // Wait until the next available callback is ready to execute. 156 | bool wait(double timeoutSecs, bool recursive) const; 157 | 158 | // Return a List of items in the queue. 159 | Rcpp::List list() const; 160 | 161 | // Increment and decrement the number of active later_fd waits 162 | void fd_waits_incr(); 163 | void fd_waits_decr(); 164 | 165 | // References to parent and children registries. These are used for 166 | // automatically running child loops. They should only be accessed and 167 | // modified from the main thread. 168 | std::shared_ptr parent; 169 | std::vector > children; 170 | }; 171 | 172 | #endif // _CALLBACK_REGISTRY_H_ 173 | -------------------------------------------------------------------------------- /src/callback_registry_table.h: -------------------------------------------------------------------------------- 1 | #ifndef _CALLBACK_REGISTRY_TABLE_H_ 2 | #define _CALLBACK_REGISTRY_TABLE_H_ 3 | 4 | #include 5 | #include 6 | #include "threadutils.h" 7 | #include "debug.h" 8 | #include "callback_registry.h" 9 | #include "later.h" 10 | 11 | using std::shared_ptr; 12 | using std::make_shared; 13 | 14 | class CallbackRegistryTable; 15 | extern CallbackRegistryTable callbackRegistryTable; 16 | 17 | // ============================================================================ 18 | // Callback registry table 19 | // ============================================================================ 20 | // 21 | // This class is used for accessing a registry by ID. The CallbackRegistries 22 | // also have a tree structure. The global loop/registry is the root. However, 23 | // there can also be trees that are independent of the global loop, if a loop 24 | // is created without a parent. 25 | // 26 | // The operations on this class are thread-safe, because they might be used to 27 | // from another thread. 28 | // 29 | class CallbackRegistryTable { 30 | 31 | // Basically a struct that keeps track of a registry and whether or an R loop 32 | // object references it. 33 | class RegistryHandle { 34 | public: 35 | RegistryHandle(std::shared_ptr registry, bool r_ref_exists) 36 | : registry(registry), r_ref_exists(r_ref_exists) { 37 | }; 38 | // Need to declare a copy constructor. Needed because pre-C++11 std::map 39 | // doesn't have an .emplace() method. 40 | RegistryHandle() = default; 41 | 42 | std::shared_ptr registry; 43 | bool r_ref_exists; 44 | }; 45 | 46 | public: 47 | CallbackRegistryTable() : mutex(tct_mtx_plain | tct_mtx_recursive), condvar(mutex) { 48 | } 49 | 50 | bool exists(int id) { 51 | Guard guard(&mutex); 52 | return (registries.find(id) != registries.end()); 53 | } 54 | 55 | // Create a new CallbackRegistry. If parent_id is -1, then there is no parent. 56 | void create(int id, int parent_id) { 57 | ASSERT_MAIN_THREAD() 58 | Guard guard(&mutex); 59 | 60 | if (exists(id)) { 61 | Rcpp::stop("Can't create event loop %d because it already exists.", id); 62 | } 63 | 64 | // Each new registry is passed our mutex and condvar. These serve as a 65 | // shared lock across all CallbackRegistries and this 66 | // CallbackRegistryTable. If each registry had a separate lock, some 67 | // routines would recursively acquire a lock downward in the 68 | // CallbackRegistry tree, and some recursively acquire a lock upward; 69 | // without a shared lock, if these things happen at the same time from 70 | // different threads, it could deadlock. 71 | shared_ptr registry = make_shared(id, &mutex, &condvar); 72 | 73 | if (parent_id != -1) { 74 | shared_ptr parent = getRegistry(parent_id); 75 | if (parent == nullptr) { 76 | Rcpp::stop("Can't create registry. Parent with id %d does not exist.", parent_id); 77 | } 78 | registry->parent = parent; 79 | parent->children.push_back(registry); 80 | } 81 | 82 | // Would be better to use .emplace() to avoid copy-constructor, but that 83 | // requires C++11. 84 | registries[id] = RegistryHandle(registry, true); 85 | } 86 | 87 | // Returns a shared_ptr to the registry. If the registry is not present in 88 | // the table, or if the target CallbackRegistry has already been deleted, 89 | // then the shared_ptr is empty. 90 | shared_ptr getRegistry(int id) { 91 | Guard guard(&mutex); 92 | if (!exists(id)) { 93 | return shared_ptr(); 94 | } 95 | // If the target of the shared_ptr has been deleted, then this is an empty 96 | // shared_ptr. 97 | return registries[id].registry; 98 | } 99 | 100 | uint64_t scheduleCallback(void (*func)(void*), void* data, double delaySecs, int loop_id) { 101 | // This method can be called from any thread 102 | Guard guard(&mutex); 103 | 104 | shared_ptr registry = getRegistry(loop_id); 105 | if (registry == nullptr) { 106 | return 0; 107 | } 108 | return doExecLater(registry, func, data, delaySecs, true); 109 | } 110 | 111 | // This is called when the R loop handle referring to a CallbackRegistry is 112 | // destroyed. Returns true if the CallbackRegistry exists and this function 113 | // has not previously been called on it; false otherwise. 114 | bool notifyRRefDeleted(int id) { 115 | ASSERT_MAIN_THREAD() 116 | Guard guard(&mutex); 117 | 118 | if (!exists(id)) { 119 | return false; 120 | } 121 | 122 | if (registries[id].r_ref_exists) { 123 | registries[id].r_ref_exists = false; 124 | this->pruneRegistries(); 125 | return true; 126 | } else { 127 | return false; 128 | } 129 | } 130 | 131 | // Iterate over all registries, and remove a registry when: 132 | // * If the loop has a parent: 133 | // * There's no R loop object referring to it, AND the registry is empty. 134 | // * If the loop does not have a parent: 135 | // * There's no R loop object referring to it. (Dont' need the registry to 136 | // be empty, because if there's no parent and no R reference to the loop, 137 | // there is no way to execute callbacks in the registry.) 138 | void pruneRegistries() { 139 | ASSERT_MAIN_THREAD() 140 | Guard guard(&mutex); 141 | 142 | std::map::iterator it = registries.begin(); 143 | 144 | // Iterate over all registries. Remove under the following conditions: 145 | // * There are no more R loop handle references to the registry, AND 146 | // * The registry is empty, OR the registry has no parent. 147 | // This logic is equivalent to the logic describing the function, just in 148 | // a different order. 149 | // 150 | // std::map are sorted, and children always have a larger ID than their 151 | // parents. Because of this, if there is a case where initially a child does 152 | // not have any R refs, but the parent does have an R ref, then the parent's 153 | // R ref is deleted, both will removed in a single pass. 154 | while (it != registries.end()) { 155 | if (!it->second.r_ref_exists && 156 | (it->second.registry->empty() || it->second.registry->parent == nullptr)) 157 | { 158 | // Need to increment iterator before removing the registry; otherwise 159 | // the iterator will be invalid. 160 | int id = it->first; 161 | it++; 162 | remove(id); 163 | } else { 164 | it++; 165 | } 166 | } 167 | } 168 | 169 | // Remove a callback registry from the table 170 | bool remove(int id) { 171 | // Removal is always called from the main thread. 172 | ASSERT_MAIN_THREAD() 173 | Guard guard(&mutex); 174 | 175 | shared_ptr registry = getRegistry(id); 176 | if (registry == nullptr) { 177 | return false; 178 | } 179 | 180 | // Deregister this object from its parent. Do it here instead of the in the 181 | // CallbackRegistry destructor, for two reasons: One is that we can be 100% 182 | // sure that the deregistration happens right now (it's possible that the 183 | // object's destructor won't run yet, because someone else has a shared_ptr 184 | // to it). Second, we can't reliably use a shared_ptr to the object from 185 | // inside its destructor; we need to some pointer comparison, but by the 186 | // time the destructor runs, you can't run shared_from_this() in the object, 187 | // because there are no more shared_ptrs to it. 188 | shared_ptr parent = registry->parent; 189 | if (parent != nullptr) { 190 | // Remove this registry from the parent's list of children. 191 | for (std::vector >::iterator it = parent->children.begin(); 192 | it != parent->children.end(); 193 | ) 194 | { 195 | if (*it == registry) { 196 | parent->children.erase(it); 197 | break; 198 | } else { 199 | ++it; 200 | } 201 | } 202 | } 203 | 204 | // Tell the children that they no longer have a parent. 205 | for (std::vector >::iterator it = registry->children.begin(); 206 | it != registry->children.end(); 207 | ++it) 208 | { 209 | (*it)->parent.reset(); 210 | } 211 | 212 | registries.erase(id); 213 | 214 | return true; 215 | } 216 | 217 | private: 218 | std::map registries; 219 | Mutex mutex; 220 | ConditionVariable condvar; 221 | 222 | }; 223 | 224 | 225 | #endif 226 | -------------------------------------------------------------------------------- /src/debug.cpp: -------------------------------------------------------------------------------- 1 | #include "debug.h" 2 | #include "utils.h" 3 | #include 4 | #include 5 | #include 6 | #include 7 | 8 | // For debug.h 9 | #if defined(DEBUG_THREAD) 10 | tct_thrd_t __main_thread__; 11 | tct_thrd_t __background_thread__; 12 | #endif 13 | 14 | 15 | // It's not safe to call REprintf from the background thread but we need some 16 | // way to output error messages. R CMD check does not it if the code uses the 17 | // symbols stdout, stderr, and printf, so this function is a way to avoid 18 | // those. It's to calling `fprintf(stderr, ...)`. 19 | void err_printf(const char *fmt, ...) { 20 | const size_t max_size = 4096; 21 | char buf[max_size]; 22 | 23 | va_list args; 24 | va_start(args, fmt); 25 | int n = vsnprintf(buf, max_size, fmt, args); 26 | va_end(args); 27 | 28 | if (n == -1) 29 | return; 30 | 31 | if (write(STDERR_FILENO, buf, n)) {} 32 | // This is here simply to avoid a warning about "ignoring return value" of 33 | // the write(), on some compilers. (Seen with gcc 4.4.7 on RHEL 6) 34 | } 35 | 36 | // Set the default log level 37 | LogLevel log_level_ = LOG_ERROR; 38 | 39 | 40 | // Sets the current log level and returns previous value. 41 | // [[Rcpp::export]] 42 | std::string log_level(std::string level) { 43 | LogLevel old_level = log_level_; 44 | 45 | if (level == "") { 46 | // Do nothing 47 | } else if (level == "OFF") { 48 | log_level_ = LOG_OFF; 49 | } else if (level == "ERROR") { 50 | log_level_ = LOG_ERROR; 51 | } else if (level == "WARN") { 52 | log_level_ = LOG_WARN; 53 | } else if (level == "INFO") { 54 | log_level_ = LOG_INFO; 55 | } else if (level == "DEBUG") { 56 | log_level_ = LOG_DEBUG; 57 | } else { 58 | Rf_error("Unknown value for `level`"); 59 | } 60 | 61 | switch(old_level) { 62 | case LOG_OFF: return "OFF"; 63 | case LOG_ERROR: return "ERROR"; 64 | case LOG_WARN: return "WARN"; 65 | case LOG_INFO: return "INFO"; 66 | case LOG_DEBUG: return "DEBUG"; 67 | default: return ""; 68 | } 69 | } 70 | 71 | // Reports whether package was compiled with UBSAN 72 | // [[Rcpp::export]] 73 | bool using_ubsan() { 74 | #ifdef USING_UBSAN 75 | return true; 76 | #else 77 | return false; 78 | #endif 79 | } 80 | -------------------------------------------------------------------------------- /src/debug.h: -------------------------------------------------------------------------------- 1 | #ifndef DEBUG_H 2 | #define DEBUG_H 3 | 4 | // See the Makevars file to see how to compile with various debugging settings. 5 | 6 | #if defined(DEBUG_THREAD) 7 | #include "tinycthread.h" 8 | 9 | extern tct_thrd_t __main_thread__; 10 | extern tct_thrd_t __background_thread__; 11 | 12 | // This must be called from the main thread so that thread assertions can be 13 | // tested later. 14 | #define REGISTER_MAIN_THREAD() __main_thread__ = tct_thrd_current(); 15 | #define REGISTER_BACKGROUND_THREAD() __background_thread__ = tct_thrd_current(); 16 | #define ASSERT_MAIN_THREAD() assert(tct_thrd_current() == __main_thread__); 17 | #define ASSERT_BACKGROUND_THREAD() assert(tct_thrd_current() == __background_thread__); 18 | 19 | #else 20 | #define REGISTER_MAIN_THREAD() 21 | #define REGISTER_BACKGROUND_THREAD() 22 | #define ASSERT_MAIN_THREAD() 23 | #define ASSERT_BACKGROUND_THREAD() 24 | 25 | #endif // defined(DEBUG_THREAD) 26 | 27 | 28 | // ============================================================================ 29 | // Logging 30 | // ============================================================================ 31 | 32 | void err_printf(const char *fmt, ...); 33 | 34 | enum LogLevel { 35 | LOG_OFF, 36 | LOG_ERROR, 37 | LOG_WARN, 38 | LOG_INFO, 39 | LOG_DEBUG 40 | }; 41 | 42 | extern LogLevel log_level_; 43 | 44 | // This is a macro instead of a function, so that if msg is an expression that 45 | // involves constructing a string, the string construction does not need to be 46 | // executed when the message is not being logged. If it were a function, the 47 | // expression would need to be executed even when the message is not actually 48 | // logged. 49 | // 50 | // Conversion to std::string is done so that msg can be a char* or a 51 | // std::string. This method is needed because macros can't be overloaded. 52 | #define DEBUG_LOG(msg, level) if (log_level_ >= level) err_printf("%s\n", std::string(msg).c_str()); 53 | 54 | #endif 55 | -------------------------------------------------------------------------------- /src/fd.cpp: -------------------------------------------------------------------------------- 1 | #include "fd.h" 2 | #include 3 | #include 4 | #include 5 | #include 6 | #include 7 | #include "tinycthread.h" 8 | #include "later.h" 9 | #include "callback_registry_table.h" 10 | 11 | class ThreadArgs { 12 | public: 13 | ThreadArgs( 14 | int num_fds, 15 | struct pollfd *fds, 16 | double timeout, 17 | int loop, 18 | CallbackRegistryTable& table 19 | ) 20 | : timeout(createTimestamp(timeout)), 21 | active(std::make_shared>(true)), 22 | fds(std::vector(fds, fds + num_fds)), 23 | results(std::vector(num_fds)), 24 | loop(loop), 25 | registry(table.getRegistry(loop)) { 26 | 27 | if (registry == nullptr) 28 | throw std::runtime_error("CallbackRegistry does not exist."); 29 | 30 | // increment fd_waits at registry (paired with decr in destructor) for loop_empty() 31 | registry->fd_waits_incr(); 32 | } 33 | 34 | ThreadArgs( 35 | const Rcpp::Function& func, 36 | int num_fds, 37 | struct pollfd *fds, 38 | double timeout, 39 | int loop, 40 | CallbackRegistryTable& table 41 | ) : ThreadArgs(num_fds, fds, timeout, loop, table) { 42 | callback = std::unique_ptr(new Rcpp::Function(func)); 43 | } 44 | 45 | ThreadArgs( 46 | void (*func)(int *, void *), 47 | void *data, 48 | int num_fds, 49 | struct pollfd *fds, 50 | double timeout, 51 | int loop, 52 | CallbackRegistryTable& table 53 | ) : ThreadArgs(num_fds, fds, timeout, loop, table) { 54 | callback_native = std::bind(func, std::placeholders::_1, data); 55 | } 56 | 57 | ~ThreadArgs() { 58 | // decrement fd_waits at registry (paired with incr in constructor) for loop_empty() 59 | registry->fd_waits_decr(); 60 | } 61 | 62 | Timestamp timeout; 63 | std::shared_ptr> active; 64 | std::unique_ptr callback = nullptr; 65 | std::function callback_native = nullptr; 66 | std::vector fds; 67 | std::vector results; 68 | const int loop; 69 | 70 | private: 71 | std::shared_ptr registry; 72 | 73 | static Timestamp createTimestamp(double timeout) { 74 | if (timeout > 3e10) { 75 | timeout = 3e10; // "1000 years ought to be enough for anybody" --Bill Gates 76 | } else if (timeout < 0) { 77 | timeout = 1; // curl_multi_timeout() uses -1 to denote a default we set at 1s 78 | } 79 | return Timestamp(timeout); 80 | } 81 | 82 | }; 83 | 84 | static void later_callback(void *arg) { 85 | 86 | ASSERT_MAIN_THREAD() 87 | 88 | std::unique_ptr> argsptr(static_cast*>(arg)); 89 | std::shared_ptr args = *argsptr; 90 | bool still_active = true; 91 | // atomic compare_exchange_strong: 92 | // if args->active is true, it is changed to false (so future requests to fd_cancel return false) 93 | // if args->active is false (cancelled), still_active is changed to false 94 | args->active->compare_exchange_strong(still_active, false); 95 | if (!still_active) 96 | return; 97 | if (args->callback != nullptr) { 98 | Rcpp::LogicalVector results(args->results.begin(), args->results.end()); 99 | (*args->callback)(results); 100 | } else { 101 | args->callback_native(args->results.data()); 102 | } 103 | 104 | } 105 | 106 | // CONSIDER: if necessary to add method for HANDLES on Windows. Would be different code to SOCKETs. 107 | // TODO: implement re-usable background thread. 108 | static int wait_thread(void *arg) { 109 | 110 | tct_thrd_detach(tct_thrd_current()); 111 | 112 | std::unique_ptr> argsptr(static_cast*>(arg)); 113 | std::shared_ptr args = *argsptr; 114 | 115 | // poll() whilst checking for cancellation at intervals 116 | 117 | int ready; 118 | double waitFor = std::fmax(args->timeout.diff_secs(Timestamp()), 0); 119 | do { 120 | // Never wait for longer than ~1 second so we can check for cancellation 121 | waitFor = std::fmin(waitFor, 1.024); 122 | ready = LATER_POLL_FUNC(args->fds.data(), static_cast(args->fds.size()), static_cast(waitFor * 1000)); 123 | if (!args->active->load()) return 1; 124 | if (ready) break; 125 | } while ((waitFor = args->timeout.diff_secs(Timestamp())) > 0); 126 | 127 | // store pollfd revents in args->results for use by callback 128 | 129 | if (ready > 0) { 130 | for (std::size_t i = 0; i < args->fds.size(); i++) { 131 | (args->results)[i] = (args->fds)[i].revents == 0 ? 0 : (args->fds)[i].revents & (POLLIN | POLLOUT) ? 1: NA_INTEGER; 132 | } 133 | } else if (ready < 0) { 134 | std::fill(args->results.begin(), args->results.end(), NA_INTEGER); 135 | } 136 | 137 | callbackRegistryTable.scheduleCallback(later_callback, static_cast(argsptr.release()), 0, args->loop); 138 | 139 | return 0; 140 | 141 | } 142 | 143 | static int execLater_launch_thread(std::shared_ptr args) { 144 | 145 | std::unique_ptr> argsptr(new std::shared_ptr(args)); 146 | 147 | tct_thrd_t thr; 148 | 149 | return tct_thrd_create(&thr, &wait_thread, static_cast(argsptr.release())) != tct_thrd_success; 150 | 151 | } 152 | 153 | static SEXP execLater_fd_impl(const Rcpp::Function& callback, int num_fds, struct pollfd *fds, double timeout, int loop_id) { 154 | 155 | std::shared_ptr args = std::make_shared(callback, num_fds, fds, timeout, loop_id, callbackRegistryTable); 156 | 157 | if (execLater_launch_thread(args)) 158 | Rcpp::stop("Thread creation failed"); 159 | 160 | Rcpp::XPtr>> xptr(new std::shared_ptr>(args->active), true); 161 | return xptr; 162 | 163 | } 164 | 165 | // native version 166 | static int execLater_fd_native(void (*func)(int *, void *), void *data, int num_fds, struct pollfd *fds, double timeout, int loop_id) { 167 | 168 | std::shared_ptr args = std::make_shared(func, data, num_fds, fds, timeout, loop_id, callbackRegistryTable); 169 | 170 | return execLater_launch_thread(args); 171 | 172 | } 173 | 174 | // [[Rcpp::export]] 175 | Rcpp::RObject execLater_fd(Rcpp::Function callback, Rcpp::IntegerVector readfds, Rcpp::IntegerVector writefds, 176 | Rcpp::IntegerVector exceptfds, Rcpp::NumericVector timeoutSecs, Rcpp::IntegerVector loop_id) { 177 | 178 | const int rfds = static_cast(readfds.size()); 179 | const int wfds = static_cast(writefds.size()); 180 | const int efds = static_cast(exceptfds.size()); 181 | const int num_fds = rfds + wfds + efds; 182 | const double timeout = num_fds ? timeoutSecs[0] : 0; 183 | const int loop = loop_id[0]; 184 | 185 | std::vector pollfds; 186 | pollfds.reserve(num_fds); 187 | struct pollfd pfd; 188 | 189 | for (int i = 0; i < rfds; i++) { 190 | pfd.fd = readfds[i]; 191 | pfd.events = POLLIN; 192 | pfd.revents = 0; 193 | pollfds.push_back(pfd); 194 | } 195 | for (int i = 0; i < wfds; i++) { 196 | pfd.fd = writefds[i]; 197 | pfd.events = POLLOUT; 198 | pfd.revents = 0; 199 | pollfds.push_back(pfd); 200 | } 201 | for (int i = 0; i < efds; i++) { 202 | pfd.fd = exceptfds[i]; 203 | pfd.events = 0; 204 | pfd.revents = 0; 205 | pollfds.push_back(pfd); 206 | } 207 | 208 | return execLater_fd_impl(callback, num_fds, pollfds.data(), timeout, loop); 209 | 210 | } 211 | 212 | // [[Rcpp::export]] 213 | Rcpp::LogicalVector fd_cancel(Rcpp::RObject xptr) { 214 | 215 | Rcpp::XPtr>> active(xptr); 216 | 217 | bool cancelled = true; 218 | // atomic compare_exchange_strong: 219 | // if *active is true, *active is changed to false (successful cancel) 220 | // if *active is false (already run or cancelled), cancelled is changed to false 221 | (*active)->compare_exchange_strong(cancelled, false); 222 | 223 | return cancelled; 224 | 225 | } 226 | 227 | // Schedules a C function that takes a pointer to an integer array (provided by 228 | // this function when calling back) and a void * argument, to execute on file 229 | // descriptor readiness. Returns 0 upon success and 1 if creating the wait 230 | // thread failed. NOTE: this is different to execLaterNative2() which returns 0 231 | // on failure. 232 | extern "C" int execLaterFdNative(void (*func)(int *, void *), void *data, int num_fds, struct pollfd *fds, double timeoutSecs, int loop_id) { 233 | ensureInitialized(); 234 | return execLater_fd_native(func, data, num_fds, fds, timeoutSecs, loop_id); 235 | } 236 | -------------------------------------------------------------------------------- /src/fd.h: -------------------------------------------------------------------------------- 1 | #ifndef _LATER_FD_H_ 2 | #define _LATER_FD_H_ 3 | 4 | #ifdef _WIN32 5 | #ifndef _WIN32_WINNT 6 | #define _WIN32_WINNT 0x0600 // so R <= 4.1 can find WSAPoll() on Windows 7 | #endif 8 | #include 9 | #else 10 | #include 11 | #endif 12 | 13 | #ifdef _WIN32 14 | #define LATER_POLL_FUNC WSAPoll 15 | #define LATER_NFDS_T ULONG 16 | #else 17 | #define LATER_POLL_FUNC poll 18 | #define LATER_NFDS_T nfds_t 19 | #endif 20 | 21 | #endif // _LATER_FD_H_ 22 | -------------------------------------------------------------------------------- /src/init.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include // for NULL 4 | #include 5 | #include // for uint64_t 6 | #include "fd.h" // for struct pollfd 7 | 8 | /* FIXME: 9 | Check these declarations against the C/Fortran source code. 10 | */ 11 | 12 | /* .Call calls */ 13 | SEXP _later_ensureInitialized(void); 14 | SEXP _later_execCallbacks(SEXP, SEXP, SEXP); 15 | SEXP _later_idle(SEXP); 16 | SEXP _later_execLater(SEXP, SEXP, SEXP); 17 | SEXP _later_cancel(SEXP, SEXP); 18 | SEXP _later_execLater_fd(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP); 19 | SEXP _later_fd_cancel(SEXP); 20 | SEXP _later_nextOpSecs(SEXP); 21 | SEXP _later_testCallbackOrdering(void); 22 | SEXP _later_createCallbackRegistry(SEXP, SEXP); 23 | SEXP _later_deleteCallbackRegistry(SEXP); 24 | SEXP _later_existsCallbackRegistry(SEXP); 25 | SEXP _later_notifyRRefDeleted(SEXP); 26 | SEXP _later_setCurrentRegistryId(SEXP); 27 | SEXP _later_getCurrentRegistryId(void); 28 | SEXP _later_list_queue_(SEXP); 29 | SEXP _later_log_level(SEXP); 30 | SEXP _later_using_ubsan(void); 31 | SEXP _later_new_weakref(SEXP); 32 | SEXP _later_wref_key(SEXP); 33 | 34 | static const R_CallMethodDef CallEntries[] = { 35 | {"_later_ensureInitialized", (DL_FUNC) &_later_ensureInitialized, 0}, 36 | {"_later_execCallbacks", (DL_FUNC) &_later_execCallbacks, 3}, 37 | {"_later_idle", (DL_FUNC) &_later_idle, 1}, 38 | {"_later_execLater", (DL_FUNC) &_later_execLater, 3}, 39 | {"_later_cancel", (DL_FUNC) &_later_cancel, 2}, 40 | {"_later_execLater_fd", (DL_FUNC) &_later_execLater_fd, 6}, 41 | {"_later_fd_cancel", (DL_FUNC) &_later_fd_cancel, 1}, 42 | {"_later_nextOpSecs", (DL_FUNC) &_later_nextOpSecs, 1}, 43 | {"_later_testCallbackOrdering", (DL_FUNC) &_later_testCallbackOrdering, 0}, 44 | {"_later_createCallbackRegistry", (DL_FUNC) &_later_createCallbackRegistry, 2}, 45 | {"_later_deleteCallbackRegistry", (DL_FUNC) &_later_deleteCallbackRegistry, 1}, 46 | {"_later_existsCallbackRegistry", (DL_FUNC) &_later_existsCallbackRegistry, 1}, 47 | {"_later_notifyRRefDeleted", (DL_FUNC) &_later_notifyRRefDeleted, 1}, 48 | {"_later_setCurrentRegistryId", (DL_FUNC) &_later_setCurrentRegistryId, 1}, 49 | {"_later_getCurrentRegistryId", (DL_FUNC) &_later_getCurrentRegistryId, 0}, 50 | {"_later_list_queue_", (DL_FUNC) &_later_list_queue_, 1}, 51 | {"_later_log_level", (DL_FUNC) &_later_log_level, 1}, 52 | {"_later_using_ubsan", (DL_FUNC) &_later_using_ubsan, 0}, 53 | {"_later_new_weakref", (DL_FUNC) &_later_new_weakref, 1}, 54 | {"_later_wref_key", (DL_FUNC) &_later_wref_key, 1}, 55 | {NULL, NULL, 0} 56 | }; 57 | 58 | uint64_t execLaterNative(void (*func)(void*), void* data, double secs); 59 | uint64_t execLaterNative2(void (*func)(void*), void* data, double secs, int loop); 60 | int execLaterFdNative(void (*)(int *, void *), void *, int, struct pollfd *, double, int); 61 | int apiVersion(void); 62 | 63 | void R_init_later(DllInfo *dll) { 64 | R_registerRoutines(dll, NULL, CallEntries, NULL, NULL); 65 | R_useDynamicSymbols(dll, FALSE); 66 | R_forceSymbols(dll, TRUE); 67 | // 2019-08-06 68 | // execLaterNative is registered here ONLY for backward compatibility; If 69 | // someone installed a package which had `#include ` (like 70 | // httpuv) then that package would have compiled the inline functions from 71 | // inst/include/later.h, which in turn used `R_GetCCallable("later", 72 | // "execLaterNative")`, then called that function with 3 arguments. For 73 | // anyone who upgrades this package but does not upgrade the downstream 74 | // dependency, that interface cannot change. 75 | // 76 | // So we register `execLaterNative` here, even though we don't actually call 77 | // it from inst/include/later.h anymore. This ensures that downstream deps 78 | // that were built with the previous version can still use 79 | // `R_GetCCallable("later", "execLaterNative")` and have it work properly. 80 | // 81 | // In a future version, after no one is running downstream packages that are 82 | // built against the previous version of later, we can remove this line. 83 | // 84 | // https://github.com/r-lib/later/issues/97 85 | R_RegisterCCallable("later", "execLaterNative", (DL_FUNC)&execLaterNative); 86 | R_RegisterCCallable("later", "execLaterNative2", (DL_FUNC)&execLaterNative2); 87 | R_RegisterCCallable("later", "execLaterFdNative",(DL_FUNC)&execLaterFdNative); 88 | R_RegisterCCallable("later", "apiVersion", (DL_FUNC)&apiVersion); 89 | } 90 | -------------------------------------------------------------------------------- /src/interrupt.h: -------------------------------------------------------------------------------- 1 | #ifndef _INTERRUPT_H_ 2 | #define _INTERRUPT_H_ 3 | 4 | #ifdef _WIN32 5 | 6 | #include 7 | #undef TRUE 8 | #undef FALSE 9 | 10 | #endif // _WIN32 11 | 12 | 13 | // Borrowed from https://github.com/wch/r-source/blob/a0a6b159/src/include/R_ext/GraphicsDevice.h#L843-L858 14 | #ifndef BEGIN_SUSPEND_INTERRUPTS 15 | /* Macros for suspending interrupts */ 16 | #define BEGIN_SUSPEND_INTERRUPTS do { \ 17 | Rboolean __oldsusp__ = R_interrupts_suspended; \ 18 | R_interrupts_suspended = TRUE; 19 | #define END_SUSPEND_INTERRUPTS R_interrupts_suspended = __oldsusp__; \ 20 | if (R_interrupts_pending && ! R_interrupts_suspended) \ 21 | Rf_onintr(); \ 22 | } while(0) 23 | 24 | #include 25 | LibExtern Rboolean R_interrupts_suspended; 26 | LibExtern int R_interrupts_pending; 27 | extern void Rf_onintr(void); 28 | LibExtern Rboolean mbcslocale; 29 | #endif 30 | 31 | 32 | #endif -------------------------------------------------------------------------------- /src/later.cpp: -------------------------------------------------------------------------------- 1 | #include "later.h" 2 | #include 3 | #include 4 | #include 5 | #include 6 | #include "debug.h" 7 | #include "utils.h" 8 | #include "threadutils.h" 9 | 10 | #include "callback_registry.h" 11 | #include "callback_registry_table.h" 12 | 13 | #include "interrupt.h" 14 | 15 | using std::shared_ptr; 16 | 17 | static size_t exec_callbacks_reentrancy_count = 0; 18 | 19 | // instance has global scope as declared in callback_registry_table.h 20 | CallbackRegistryTable callbackRegistryTable; 21 | 22 | 23 | class ProtectCallbacks { 24 | public: 25 | ProtectCallbacks() { 26 | exec_callbacks_reentrancy_count++; 27 | } 28 | ~ProtectCallbacks() { 29 | exec_callbacks_reentrancy_count--; 30 | } 31 | }; 32 | 33 | // Returns number of frames on the call stack. Basically just a wrapper for 34 | // base::sys.nframe(). Note that this can report that an error occurred if the 35 | // user sends an interrupt while the `sys.nframe()` function is running. I 36 | // believe that the only reason that it should set errorOccurred is because of 37 | // a user interrupt. 38 | int sys_nframe() { 39 | ASSERT_MAIN_THREAD() 40 | SEXP e, result; 41 | int errorOccurred, value; 42 | 43 | BEGIN_SUSPEND_INTERRUPTS { 44 | PROTECT(e = Rf_lang1(Rf_install("sys.nframe"))); 45 | PROTECT(result = R_tryEval(e, R_BaseEnv, &errorOccurred)); 46 | 47 | if (errorOccurred) { 48 | value = -1; 49 | } else { 50 | value = INTEGER(result)[0]; 51 | } 52 | 53 | UNPROTECT(2); 54 | } END_SUSPEND_INTERRUPTS; 55 | 56 | return value; 57 | } 58 | 59 | // Returns true if execCallbacks is executing, or sys.nframes() returns 0. 60 | bool at_top_level() { 61 | ASSERT_MAIN_THREAD() 62 | if (exec_callbacks_reentrancy_count != 0) 63 | return false; 64 | 65 | int nframe = sys_nframe(); 66 | if (nframe == -1) { 67 | throw Rcpp::exception("Error occurred while calling sys.nframe()"); 68 | } 69 | return nframe == 0; 70 | } 71 | 72 | // ============================================================================ 73 | // Current registry/event loop 74 | // ============================================================================ 75 | // 76 | // In the R code, the term "loop" is used. In the C++ code, the terms "loop" 77 | // and "registry" are both used. "Loop" is usually used when interfacing with 78 | // R-facing event loop, and "registry" is usually used when interfacing with 79 | // the implementation, which uses a callback registry. 80 | // 81 | // The current registry is kept track of entirely in C++, and not in R 82 | // (although it can be queried from R). This is because when running a loop 83 | // with children, it sets the current loop as it runs each of the children, 84 | // and to do so in R would require calling back into R for each child, which 85 | // would impose more overhead. 86 | 87 | static int current_registry; 88 | 89 | // [[Rcpp::export]] 90 | void setCurrentRegistryId(int id) { 91 | ASSERT_MAIN_THREAD() 92 | current_registry = id; 93 | } 94 | 95 | // [[Rcpp::export]] 96 | int getCurrentRegistryId() { 97 | ASSERT_MAIN_THREAD() 98 | return current_registry; 99 | } 100 | 101 | // Class for setting current registry and resetting when function exits, using 102 | // RAII. 103 | class CurrentRegistryGuard { 104 | public: 105 | CurrentRegistryGuard(int id) { 106 | ASSERT_MAIN_THREAD() 107 | old_id = getCurrentRegistryId(); 108 | setCurrentRegistryId(id); 109 | } 110 | ~CurrentRegistryGuard() { 111 | setCurrentRegistryId(old_id); 112 | } 113 | private: 114 | int old_id; 115 | }; 116 | 117 | 118 | // ============================================================================ 119 | // Callback registry functions 120 | // ============================================================================ 121 | 122 | shared_ptr getGlobalRegistry() { 123 | shared_ptr registry = callbackRegistryTable.getRegistry(GLOBAL_LOOP); 124 | if (registry == nullptr) { 125 | Rf_error("Global registry does not exist."); 126 | } 127 | return registry; 128 | } 129 | 130 | // This deletes a CallbackRegistry and deregisters it as a child of its 131 | // parent. Any children of this registry are orphaned -- they no longer have a 132 | // parent. (Maybe this should be an option?) 133 | // 134 | // [[Rcpp::export]] 135 | bool deleteCallbackRegistry(int loop_id) { 136 | ASSERT_MAIN_THREAD() 137 | if (loop_id == GLOBAL_LOOP) { 138 | Rf_error("Can't delete global loop."); 139 | } 140 | if (loop_id == getCurrentRegistryId()) { 141 | Rf_error("Can't delete current loop."); 142 | } 143 | 144 | return callbackRegistryTable.remove(loop_id); 145 | } 146 | 147 | 148 | // This is called when the R loop handle is GC'd. 149 | // [[Rcpp::export]] 150 | bool notifyRRefDeleted(int loop_id) { 151 | ASSERT_MAIN_THREAD() 152 | if (loop_id == GLOBAL_LOOP) { 153 | Rf_error("Can't delete global loop."); 154 | } 155 | if (loop_id == getCurrentRegistryId()) { 156 | Rf_error("Can't delete current loop."); 157 | } 158 | 159 | return callbackRegistryTable.notifyRRefDeleted(loop_id); 160 | } 161 | 162 | 163 | // [[Rcpp::export]] 164 | void createCallbackRegistry(int id, int parent_id) { 165 | ASSERT_MAIN_THREAD() 166 | callbackRegistryTable.create(id, parent_id); 167 | } 168 | 169 | // [[Rcpp::export]] 170 | bool existsCallbackRegistry(int id) { 171 | ASSERT_MAIN_THREAD() 172 | return callbackRegistryTable.exists(id); 173 | } 174 | 175 | // [[Rcpp::export]] 176 | Rcpp::List list_queue_(int id) { 177 | ASSERT_MAIN_THREAD() 178 | shared_ptr registry = callbackRegistryTable.getRegistry(id); 179 | if (registry == nullptr) { 180 | Rf_error("CallbackRegistry does not exist."); 181 | } 182 | return registry->list(); 183 | } 184 | 185 | 186 | // Execute callbacks for a single event loop. 187 | bool execCallbacksOne( 188 | bool runAll, 189 | shared_ptr callback_registry, 190 | Timestamp now 191 | ) { 192 | ASSERT_MAIN_THREAD() 193 | // execCallbacks can be called directly from C code, and the callbacks may 194 | // include Rcpp code. (Should we also call wrap?) 195 | Rcpp::RNGScope rngscope; 196 | ProtectCallbacks pcscope; 197 | 198 | // Set current loop for the duration of this function. 199 | CurrentRegistryGuard current_registry_guard(callback_registry->getId()); 200 | 201 | do { 202 | // We only take one at a time, because we don't want to lose callbacks if 203 | // one of the callbacks throws an error 204 | std::vector callbacks = callback_registry->take(1, now); 205 | if (callbacks.size() == 0) { 206 | break; 207 | } 208 | 209 | #ifdef RCPP_USING_UNWIND_PROTECT // See https://github.com/r-lib/later/issues/191 210 | // This line may throw errors! 211 | callbacks[0]->invoke(); 212 | #else 213 | // This line may throw errors! 214 | callbacks[0]->invoke_wrapped(); 215 | #endif 216 | 217 | } while (runAll); 218 | 219 | // I think there's no need to lock this since it's only modified from the 220 | // main thread. But need to check. 221 | std::vector > children = callback_registry->children; 222 | for (std::vector >::iterator it = children.begin(); 223 | it != children.end(); 224 | ++it) 225 | { 226 | execCallbacksOne(true, *it, now); 227 | } 228 | 229 | return true; 230 | } 231 | 232 | // Execute callbacks for an event loop and its children. 233 | // [[Rcpp::export]] 234 | bool execCallbacks(double timeoutSecs, bool runAll, int loop_id) { 235 | ASSERT_MAIN_THREAD() 236 | shared_ptr registry = callbackRegistryTable.getRegistry(loop_id); 237 | if (registry == nullptr) { 238 | Rf_error("CallbackRegistry does not exist."); 239 | } 240 | 241 | if (!registry->wait(timeoutSecs, true)) { 242 | return false; 243 | } 244 | 245 | Timestamp now; 246 | execCallbacksOne(runAll, registry, now); 247 | 248 | // Call this now, in case any CallbackRegistries which have no R references 249 | // have emptied. 250 | callbackRegistryTable.pruneRegistries(); 251 | return true; 252 | } 253 | 254 | 255 | // This function is called from the input handler on Unix, or the Windows 256 | // equivalent. It may throw exceptions. 257 | // 258 | // Invoke execCallbacks up to 20 times. At the first iteration where no work is 259 | // done, terminate. We call this from the top level instead of just calling 260 | // execCallbacks because the top level only gets called occasionally (every 10's 261 | // of ms), so tasks that generate other tasks will execute surprisingly slowly. 262 | // 263 | // Example: 264 | // promise_map(1:1000, function(i) { 265 | // message(i) 266 | // promise_resolve(i) 267 | // }) 268 | bool execCallbacksForTopLevel() { 269 | bool any = false; 270 | for (size_t i = 0; i < 20; i++) { 271 | if (!execCallbacks(0, true, GLOBAL_LOOP)) 272 | return any; 273 | any = true; 274 | } 275 | return any; 276 | } 277 | 278 | // [[Rcpp::export]] 279 | bool idle(int loop_id) { 280 | ASSERT_MAIN_THREAD() 281 | shared_ptr registry = callbackRegistryTable.getRegistry(loop_id); 282 | if (registry == nullptr) { 283 | Rf_error("CallbackRegistry does not exist."); 284 | } 285 | return registry->empty(); 286 | } 287 | 288 | 289 | static bool initialized = false; 290 | // [[Rcpp::export]] 291 | void ensureInitialized() { 292 | if (initialized) { 293 | return; 294 | } 295 | REGISTER_MAIN_THREAD() 296 | 297 | // Note that the global registry is not created here, but in R, from the 298 | // .onLoad function. 299 | setCurrentRegistryId(GLOBAL_LOOP); 300 | 301 | // Call the platform-specific initialization for the mechanism that runs the 302 | // event loop when the console is idle. 303 | ensureAutorunnerInitialized(); 304 | initialized = true; 305 | } 306 | 307 | // [[Rcpp::export]] 308 | std::string execLater(Rcpp::Function callback, double delaySecs, int loop_id) { 309 | ASSERT_MAIN_THREAD() 310 | ensureInitialized(); 311 | shared_ptr registry = callbackRegistryTable.getRegistry(loop_id); 312 | if (registry == nullptr) { 313 | Rf_error("CallbackRegistry does not exist."); 314 | } 315 | uint64_t callback_id = doExecLater(registry, callback, delaySecs, true); 316 | 317 | // We have to convert it to a string in order to maintain 64-bit precision, 318 | // since R doesn't support 64 bit integers. 319 | return toString(callback_id); 320 | } 321 | 322 | 323 | 324 | bool cancel(uint64_t callback_id, int loop_id) { 325 | ASSERT_MAIN_THREAD() 326 | shared_ptr registry = callbackRegistryTable.getRegistry(loop_id); 327 | if (registry == nullptr) { 328 | return false; 329 | } 330 | return registry->cancel(callback_id); 331 | } 332 | 333 | // [[Rcpp::export]] 334 | bool cancel(std::string callback_id_s, int loop_id) { 335 | ASSERT_MAIN_THREAD() 336 | uint64_t callback_id; 337 | std::istringstream iss(callback_id_s); 338 | iss >> callback_id; 339 | 340 | // If the input is good (just a number with no other text) then eof will be 341 | // 1 and fail will be 0. 342 | if (! (iss.eof() && !iss.fail())) { 343 | return false; 344 | } 345 | 346 | return cancel(callback_id, loop_id); 347 | } 348 | 349 | 350 | 351 | // [[Rcpp::export]] 352 | double nextOpSecs(int loop_id) { 353 | ASSERT_MAIN_THREAD() 354 | shared_ptr registry = callbackRegistryTable.getRegistry(loop_id); 355 | if (registry == nullptr) { 356 | Rf_error("CallbackRegistry does not exist."); 357 | } 358 | 359 | Optional nextTime = registry->nextTimestamp(); 360 | if (!nextTime.has_value()) { 361 | return R_PosInf; 362 | } else { 363 | Timestamp now; 364 | return nextTime->diff_secs(now); 365 | } 366 | } 367 | 368 | // Schedules a C function to execute on the global loop. Returns callback ID 369 | // on success, or 0 on error. 370 | extern "C" uint64_t execLaterNative(void (*func)(void*), void* data, double delaySecs) { 371 | return execLaterNative2(func, data, delaySecs, GLOBAL_LOOP); 372 | } 373 | 374 | // Schedules a C function to execute on a specific event loop. Returns 375 | // callback ID on success, or 0 on error. 376 | extern "C" uint64_t execLaterNative2(void (*func)(void*), void* data, double delaySecs, int loop_id) { 377 | ensureInitialized(); 378 | return callbackRegistryTable.scheduleCallback(func, data, delaySecs, loop_id); 379 | } 380 | 381 | extern "C" int apiVersion() { 382 | return LATER_DLL_API_VERSION; 383 | } 384 | -------------------------------------------------------------------------------- /src/later.h: -------------------------------------------------------------------------------- 1 | #ifndef _LATER_H_ 2 | #define _LATER_H_ 3 | 4 | #include 5 | #include 6 | #include "callback_registry.h" 7 | 8 | // This should be kept in sync with LATER_H_API_VERSION in 9 | // inst/include/later.h. Whenever the interface between inst/include/later.h 10 | // and the code in src/ changes, these values should be incremented. 11 | #define LATER_DLL_API_VERSION 3 12 | 13 | #define GLOBAL_LOOP 0 14 | 15 | std::shared_ptr getGlobalRegistry(); 16 | 17 | bool execCallbacksForTopLevel(); 18 | bool at_top_level(); 19 | 20 | bool execCallbacks(double timeoutSecs, bool runAll, int loop_id); 21 | bool idle(int loop); 22 | 23 | extern "C" uint64_t execLaterNative(void (*func)(void*), void* data, double secs); 24 | extern "C" uint64_t execLaterNative2(void (*func)(void*), void* data, double secs, int loop_id); 25 | extern "C" int apiVersion(); 26 | 27 | void ensureInitialized(); 28 | // Declare platform-specific functions that are implemented in later_posix.cpp 29 | // and later_win32.cpp. 30 | void ensureAutorunnerInitialized(); 31 | 32 | uint64_t doExecLater(std::shared_ptr callbackRegistry, Rcpp::Function callback, double delaySecs, bool resetTimer); 33 | uint64_t doExecLater(std::shared_ptr callbackRegistry, void (*callback)(void*), void* data, double delaySecs, bool resetTimer); 34 | 35 | #endif // _LATER_H_ 36 | -------------------------------------------------------------------------------- /src/later_posix.cpp: -------------------------------------------------------------------------------- 1 | #ifndef _WIN32 2 | 3 | #include 4 | #include 5 | #include 6 | #include 7 | #include 8 | 9 | #include "later.h" 10 | #include "callback_registry.h" 11 | #include "timer_posix.h" 12 | #include "threadutils.h" 13 | #include "debug.h" 14 | 15 | using namespace Rcpp; 16 | 17 | #define LATER_ACTIVITY 20 18 | #define LATER_DUMMY_ACTIVITY 21 19 | 20 | extern void* R_GlobalContext; 21 | extern void* R_TopLevelContext; 22 | 23 | // Whether we have initialized the input handler. 24 | int initialized = 0; 25 | 26 | // The handles to the read and write ends of a pipe. We use this pipe 27 | // to signal R's input handler callback mechanism that we want to be 28 | // called back. 29 | int pipe_in = -1; 30 | int pipe_out = -1; 31 | 32 | int dummy_pipe_in = -1; 33 | int dummy_pipe_out = -1; 34 | 35 | // Whether the file descriptor is ready for reading, i.e., whether 36 | // the input handler callback is scheduled to be called. We use this 37 | // to avoid unnecessarily writing to the pipe. 38 | bool hot = false; 39 | // This mutex protects reading/writing of `hot` and of reading from/writing to 40 | // the pipe. 41 | Mutex m(tct_mtx_plain); 42 | 43 | // The buffer we're using for the pipe. This doesn't have to be large, 44 | // in theory it only ever holds zero or one byte. 45 | size_t BUF_SIZE = 256; 46 | void *buf; 47 | 48 | void set_fd(bool ready) { 49 | Guard g(&m); 50 | 51 | if (ready != hot) { 52 | if (ready) { 53 | ssize_t cbytes = write(pipe_in, "a", 1); 54 | (void)cbytes; // squelch compiler warning 55 | hot = true; 56 | } else { 57 | if (read(pipe_out, buf, BUF_SIZE) < 0) { 58 | Rf_warningcall_immediate(R_NilValue, "Failed to read out of pipe for later package"); 59 | } 60 | hot = false; 61 | } 62 | } 63 | } 64 | 65 | namespace { 66 | void fd_on() { 67 | set_fd(true); 68 | } 69 | 70 | Timer timer(fd_on); 71 | } // namespace 72 | 73 | class ResetTimerOnExit { 74 | public: 75 | ResetTimerOnExit() { 76 | } 77 | ~ResetTimerOnExit() { 78 | ASSERT_MAIN_THREAD() 79 | // Find the next event in the registry and, if there is one, set the timer. 80 | Optional nextEvent = getGlobalRegistry()->nextTimestamp(); 81 | if (nextEvent.has_value()) { 82 | timer.set(*nextEvent); 83 | } 84 | } 85 | }; 86 | 87 | static void async_input_handler(void *data) { 88 | ASSERT_MAIN_THREAD() 89 | set_fd(false); 90 | 91 | if (!at_top_level()) { 92 | // It's not safe to run arbitrary callbacks when other R code 93 | // is already running. Wait until we're back at the top level. 94 | 95 | // jcheng 2017-08-02: We can't just leave the file descriptor hot and let 96 | // async_input_handler get invoked as fast as possible. Previously we did 97 | // this, but on POSIX systems, it interferes with R_SocketWait. 98 | // https://github.com/r-lib/later/issues/4 99 | // Instead, we set the file descriptor to cold, and tell the timer to fire 100 | // again in a few milliseconds. This should give enough breathing room that 101 | // we don't interfere with the sockets too much. 102 | timer.set(Timestamp(0.032)); 103 | return; 104 | } 105 | 106 | // jcheng 2017-08-01: While callbacks are executing, make the file descriptor 107 | // not-ready so that our input handler is not even called back by R. 108 | // Previously we'd let the input handler run but return quickly, but this 109 | // seemed to cause R_SocketWait to hang (encountered while working with the 110 | // future package, trying to call value(future) with plan(multisession)). 111 | ResetTimerOnExit resetTimerOnExit_scope; 112 | 113 | // This try-catch is meant to be similar to the BEGIN_RCPP and VOID_END_RCPP 114 | // macros. They are needed for two reasons: first, if an exception occurs in 115 | // any of the callbacks, destructors will still execute; and second, if an 116 | // exception (including R-level error) occurs in a callback and it reaches 117 | // the top level in an R input handler, R appears to be unable to handle it 118 | // properly. 119 | // https://github.com/r-lib/later/issues/12 120 | // https://github.com/RcppCore/Rcpp/issues/753 121 | // https://github.com/r-lib/later/issues/31 122 | try { 123 | execCallbacksForTopLevel(); 124 | } 125 | catch(Rcpp::internal::InterruptedException &e) { 126 | DEBUG_LOG("async_input_handler: caught Rcpp::internal::InterruptedException", LOG_INFO); 127 | REprintf("later: interrupt occurred while executing callback.\n"); 128 | } 129 | catch(Rcpp::LongjumpException& e){ 130 | DEBUG_LOG("async_input_handler: caught exception", LOG_INFO); 131 | REprintf("later: exception occurred while executing callback.\n"); 132 | } 133 | catch(std::exception& e){ 134 | DEBUG_LOG("async_input_handler: caught exception", LOG_INFO); 135 | std::string msg = "later: exception occurred while executing callback: \n"; 136 | msg += e.what(); 137 | msg += "\n"; 138 | REprintf("%s", msg.c_str()); 139 | } 140 | catch( ... ){ 141 | REprintf("later: c++ exception (unknown reason) occurred while executing callback.\n"); 142 | } 143 | } 144 | 145 | InputHandler* inputHandlerHandle; 146 | InputHandler* dummyInputHandlerHandle; 147 | 148 | // If the real input handler has been removed, the dummy input handler removes 149 | // itself. The real input handler cannot remove both; otherwise a segfault 150 | // could occur. 151 | static void remove_dummy_handler(void *data) { 152 | ASSERT_MAIN_THREAD() 153 | removeInputHandler(&R_InputHandlers, dummyInputHandlerHandle); 154 | if (dummy_pipe_in > 0) { 155 | close(dummy_pipe_in); 156 | dummy_pipe_in = -1; 157 | } 158 | if (dummy_pipe_out > 0) { 159 | close(dummy_pipe_out); 160 | dummy_pipe_out = -1; 161 | } 162 | } 163 | 164 | // Callback to run in child process after forking. 165 | void child_proc_after_fork() { 166 | ASSERT_MAIN_THREAD() 167 | if (initialized) { 168 | removeInputHandler(&R_InputHandlers, inputHandlerHandle); 169 | 170 | if (pipe_in > 0) { 171 | close(pipe_in); 172 | pipe_in = -1; 173 | } 174 | if (pipe_out > 0) { 175 | close(pipe_out); 176 | pipe_out = -1; 177 | } 178 | 179 | removeInputHandler(&R_InputHandlers, dummyInputHandlerHandle); 180 | if (dummy_pipe_in > 0) { 181 | close(dummy_pipe_in); 182 | dummy_pipe_in = -1; 183 | } 184 | if (dummy_pipe_out > 0) { 185 | close(dummy_pipe_out); 186 | dummy_pipe_out = -1; 187 | } 188 | 189 | initialized = 0; 190 | } 191 | } 192 | 193 | void ensureAutorunnerInitialized() { 194 | if (!initialized) { 195 | buf = malloc(BUF_SIZE); 196 | 197 | int pipes[2]; 198 | if (pipe(pipes)) { 199 | free(buf); 200 | Rf_error("Failed to create pipe"); 201 | return; 202 | } 203 | pipe_out = pipes[0]; 204 | pipe_in = pipes[1]; 205 | 206 | inputHandlerHandle = addInputHandler(R_InputHandlers, pipe_out, async_input_handler, LATER_ACTIVITY); 207 | 208 | // If the R process is forked, make sure that the child process doesn't mess 209 | // with the pipes. This also means that functions scheduled in the child 210 | // process with `later()` will only work if `run_now()` is called. In this 211 | // situation, there's also the danger that a function will be scheduled by 212 | // the parent process and then will be executed in the child process (in 213 | // addition to in the parent process). 214 | // https://github.com/r-lib/later/issues/140 215 | pthread_atfork(NULL, NULL, child_proc_after_fork); 216 | 217 | // Need to add a dummy input handler to avoid segfault when the "real" 218 | // input handler removes the subsequent input handler in the linked list. 219 | // See https://github.com/rstudio/httpuv/issues/78 220 | int dummy_pipes[2]; 221 | if (pipe(dummy_pipes)) { 222 | Rf_error("Failed to create pipe"); 223 | return; 224 | } 225 | dummy_pipe_out = dummy_pipes[0]; 226 | dummy_pipe_in = dummy_pipes[1]; 227 | dummyInputHandlerHandle = addInputHandler(R_InputHandlers, dummy_pipe_out, remove_dummy_handler, LATER_DUMMY_ACTIVITY); 228 | 229 | initialized = 1; 230 | } 231 | } 232 | 233 | void deInitialize() { 234 | ASSERT_MAIN_THREAD() 235 | if (initialized) { 236 | removeInputHandler(&R_InputHandlers, inputHandlerHandle); 237 | if (pipe_in > 0) { 238 | close(pipe_in); 239 | pipe_in = -1; 240 | } 241 | if (pipe_out > 0) { 242 | close(pipe_out); 243 | pipe_out = -1; 244 | } 245 | initialized = 0; 246 | 247 | // Trigger remove_dummy_handler() 248 | // Store `ret` because otherwise it raises a significant warning. 249 | ssize_t ret = write(dummy_pipe_in, "a", 1); 250 | (void)ret; // squelch compiler warning 251 | } 252 | } 253 | 254 | uint64_t doExecLater(std::shared_ptr callbackRegistry, Rcpp::Function callback, double delaySecs, bool resetTimer) { 255 | ASSERT_MAIN_THREAD() 256 | uint64_t callback_id = callbackRegistry->add(callback, delaySecs); 257 | 258 | // The timer needs to be reset only if we're using the global loop, because 259 | // this usage of the timer is relevant only when the event loop is driven by 260 | // R's input handler (at the idle console), and only the global loop is by 261 | // that. 262 | if (resetTimer) 263 | timer.set(*(callbackRegistry->nextTimestamp())); 264 | 265 | return callback_id; 266 | } 267 | 268 | uint64_t doExecLater(std::shared_ptr callbackRegistry, void (*callback)(void*), void* data, double delaySecs, bool resetTimer) { 269 | uint64_t callback_id = callbackRegistry->add(callback, data, delaySecs); 270 | 271 | if (resetTimer) 272 | timer.set(*(callbackRegistry->nextTimestamp())); 273 | 274 | return callback_id; 275 | } 276 | 277 | #endif // ifndef _WIN32 278 | -------------------------------------------------------------------------------- /src/later_win32.cpp: -------------------------------------------------------------------------------- 1 | #ifdef _WIN32 2 | 3 | #include "later.h" 4 | 5 | #include 6 | #include 7 | #include 8 | #define WIN32_LEAN_AND_MEAN 9 | #include 10 | #include "debug.h" 11 | 12 | using namespace Rcpp; 13 | 14 | // Whether we have initialized the message-only window. 15 | int initialized = 0; 16 | 17 | // The handle to the message-only window 18 | HWND hwnd; 19 | 20 | // The ID of the timer 21 | UINT_PTR TIMER_ID = 1; 22 | 23 | // The window message we use to run SetTimer on the main thread 24 | const UINT WM_SETUPTIMER = WM_USER + 101; 25 | 26 | static void setupTimer() { 27 | if (!SetTimer(hwnd, TIMER_ID, USER_TIMER_MINIMUM, NULL)) { 28 | Rf_error("Failed to schedule callback timer"); 29 | } 30 | } 31 | 32 | static bool executeHandlers() { 33 | if (!at_top_level()) { 34 | // It's not safe to run arbitrary callbacks when other R code 35 | // is already running. Wait until we're back at the top level. 36 | return false; 37 | } 38 | 39 | // This try-catch is meant to be similar to the BEGIN_RCPP and VOID_END_RCPP 40 | // macros. They are needed for two reasons: first, if an exception occurs in 41 | // any of the callbacks, destructors will still execute; and second, if an 42 | // exception (including R-level error) occurs in a callback and it reaches 43 | // the top level in an R input handler, R appears to be unable to handle it 44 | // properly. 45 | // https://github.com/r-lib/later/issues/12 46 | // https://github.com/RcppCore/Rcpp/issues/753 47 | // https://github.com/r-lib/later/issues/31 48 | try { 49 | execCallbacksForTopLevel(); 50 | } 51 | catch(Rcpp::internal::InterruptedException &e) { 52 | REprintf("later: interrupt occurred while executing callback.\n"); 53 | } 54 | catch(Rcpp::LongjumpException& e){ 55 | REprintf("later: exception occurred while executing callback.\n"); 56 | } 57 | catch(std::exception& e){ 58 | std::string msg = "later: exception occurred while executing callback: \n"; 59 | msg += e.what(); 60 | msg += "\n"; 61 | REprintf(msg.c_str()); 62 | } 63 | catch( ... ){ 64 | REprintf("later: c++ exception (unknown reason) occurred while executing callback.\n"); 65 | } 66 | 67 | return idle(GLOBAL_LOOP); 68 | } 69 | 70 | LRESULT CALLBACK callbackWndProc(HWND hWnd, UINT message, WPARAM wParam, LPARAM lParam) { 71 | switch (message) { 72 | case WM_TIMER: 73 | if (executeHandlers()) { 74 | KillTimer(hwnd, TIMER_ID); 75 | } 76 | break; 77 | case WM_SETUPTIMER: 78 | setupTimer(); 79 | break; 80 | default: 81 | return DefWindowProc(hWnd, message, wParam, lParam); 82 | } 83 | return 0; 84 | } 85 | 86 | void ensureAutorunnerInitialized() { 87 | if (!initialized) { 88 | static const char* class_name = "R_LATER_WINDOW_CLASS"; 89 | WNDCLASSEX wc = {}; 90 | wc.cbSize = sizeof(WNDCLASSEX); 91 | wc.lpfnWndProc = callbackWndProc; 92 | wc.hInstance = NULL; 93 | wc.lpszClassName = class_name; 94 | if (!RegisterClassEx(&wc)) { 95 | Rf_error("Failed to register window class"); 96 | } 97 | 98 | hwnd = CreateWindowEx(0, class_name, "dummy_name", 0, 0, 0, 0, 0, HWND_MESSAGE, NULL, NULL, NULL); 99 | if (!hwnd) { 100 | Rf_error("Failed to create message-only window"); 101 | } 102 | 103 | initialized = 1; 104 | } 105 | } 106 | 107 | uint64_t doExecLater(std::shared_ptr callbackRegistry, Rcpp::Function callback, double delaySecs, bool resetTimer) { 108 | uint64_t callback_id = callbackRegistry->add(callback, delaySecs); 109 | 110 | if (resetTimer) 111 | setupTimer(); 112 | 113 | return callback_id; 114 | } 115 | 116 | uint64_t doExecLater(std::shared_ptr callbackRegistry, void (*func)(void*), void* data, double delaySecs, bool resetTimer) { 117 | uint64_t callback_id = callbackRegistry->add(func, data, delaySecs); 118 | 119 | if (resetTimer) { 120 | if (GetCurrentThreadId() == GetWindowThreadProcessId(hwnd, NULL)) { 121 | setupTimer(); 122 | } else { 123 | // Not safe to setup the timer from this thread. Instead, send a 124 | // message to the main thread that the timer should be set up. 125 | PostMessage(hwnd, WM_SETUPTIMER, 0, 0); 126 | } 127 | } 128 | 129 | return callback_id; 130 | } 131 | 132 | #endif // ifdef _WIN32 133 | -------------------------------------------------------------------------------- /src/optional.h: -------------------------------------------------------------------------------- 1 | #ifndef _OPTIONAL_H_ 2 | #define _OPTIONAL_H_ 3 | 4 | template 5 | class Optional { 6 | bool has; 7 | T value; 8 | 9 | public: 10 | Optional() : has(false), value() { 11 | } 12 | 13 | Optional(const T& val) : has(true), value(val) { 14 | } 15 | 16 | const T& operator*() const { 17 | return this->value; 18 | } 19 | T& operator*() { 20 | return this->value; 21 | } 22 | T* operator->() { 23 | return &this->value; 24 | } 25 | void operator=(const T& value) { 26 | this->value = value; 27 | this->has = true; 28 | } 29 | 30 | bool has_value() const { 31 | return has; 32 | } 33 | 34 | void reset() { 35 | // Creating a new object may be problematic or expensive for some classes; 36 | // however, for the types we use in later, this is OK. If Optional is used 37 | // for more types in the future, we could switch to a different 38 | // implementation of optional. 39 | this->value = T(); 40 | this->has= false; 41 | } 42 | }; 43 | 44 | #endif // _OPTIONAL_H_ 45 | -------------------------------------------------------------------------------- /src/threadutils.h: -------------------------------------------------------------------------------- 1 | #ifndef _THREADUTILS_H_ 2 | #define _THREADUTILS_H_ 3 | 4 | #include 5 | #include 6 | #include 7 | 8 | #include "tinycthread.h" 9 | #include "timeconv.h" 10 | 11 | class ConditionVariable; 12 | 13 | class Mutex { 14 | friend class ConditionVariable; 15 | tct_mtx_t _m; 16 | 17 | public: 18 | // type must be one of: 19 | // 20 | // * mtx_plain for a simple non-recursive mutex 21 | // * mtx_timed for a non-recursive mutex that supports timeout 22 | // * mtx_try for a non-recursive mutex that supports test and return 23 | // * mtx_plain | mtx_recursive (same as mtx_plain, but recursive) 24 | // * mtx_timed | mtx_recursive (same as mtx_timed, but recursive) 25 | // * mtx_try | mtx_recursive (same as mtx_try, but recursive) 26 | // 27 | // (although mtx_timed seems not to be actually implemented) 28 | Mutex(int type) { 29 | if (tct_mtx_init(&_m, type) != tct_thrd_success) { 30 | throw std::runtime_error("Mutex creation failed"); 31 | } 32 | } 33 | 34 | // Make non-copyable 35 | Mutex(const Mutex&) = delete; 36 | Mutex& operator=(const Mutex&) = delete; 37 | 38 | virtual ~Mutex() { 39 | tct_mtx_destroy(&_m); 40 | } 41 | 42 | void lock() { 43 | if (tct_mtx_lock(&_m) != tct_thrd_success) { 44 | throw std::runtime_error("Mutex failed to lock"); 45 | } 46 | } 47 | 48 | bool tryLock() { 49 | int res = tct_mtx_trylock(&_m); 50 | if (res == tct_thrd_success) { 51 | return true; 52 | } else if (res == tct_thrd_busy) { 53 | return false; 54 | } else { 55 | throw std::runtime_error("Mutex failed to trylock"); 56 | } 57 | } 58 | 59 | void unlock() { 60 | if (tct_mtx_unlock(&_m) != tct_thrd_success) { 61 | throw std::runtime_error("Mutex failed to unlock"); 62 | } 63 | } 64 | }; 65 | 66 | class Guard { 67 | Mutex* _mutex; 68 | 69 | public: 70 | Guard(Mutex* mutex) : _mutex(mutex) { 71 | _mutex->lock(); 72 | } 73 | 74 | // Make non-copyable 75 | Guard(const Guard&) = delete; 76 | Guard& operator=(const Guard&) = delete; 77 | 78 | ~Guard() { 79 | _mutex->unlock(); 80 | } 81 | }; 82 | 83 | class ConditionVariable { 84 | tct_mtx_t* _m; 85 | tct_cnd_t _c; 86 | 87 | public: 88 | ConditionVariable(Mutex& mutex) : _m(&mutex._m) { 89 | // If time_t isn't integral, our addSeconds logic needs to change, 90 | // as it relies on casting to time_t being a truncation. 91 | if (!std::is_integral::value) 92 | throw std::runtime_error("Integral time_t type expected"); 93 | // If time_t isn't signed, our addSeconds logic can't handle 94 | // negative values for secs. 95 | if (!std::is_signed::value) 96 | throw std::runtime_error("Signed time_t type expected"); 97 | 98 | if (tct_cnd_init(&_c) != tct_thrd_success) 99 | throw std::runtime_error("Condition variable failed to initialize"); 100 | } 101 | 102 | // Make non-copyable 103 | ConditionVariable(const ConditionVariable&) = delete; 104 | ConditionVariable& operator=(const ConditionVariable&) = delete; 105 | 106 | virtual ~ConditionVariable() { 107 | tct_cnd_destroy(&_c); 108 | } 109 | 110 | // Unblocks one thread (if any are waiting) 111 | void signal() { 112 | if (tct_cnd_signal(&_c) != tct_thrd_success) 113 | throw std::runtime_error("Condition variable failed to signal"); 114 | } 115 | 116 | // Unblocks all waiting threads 117 | void broadcast() { 118 | if (tct_cnd_broadcast(&_c) != tct_thrd_success) 119 | throw std::runtime_error("Condition variable failed to broadcast"); 120 | } 121 | 122 | void wait() { 123 | if (tct_cnd_wait(&_c, _m) != tct_thrd_success) 124 | throw std::runtime_error("Condition variable failed to wait"); 125 | } 126 | 127 | bool timedwait(double timeoutSecs) { 128 | timespec ts; 129 | if (timespec_get(&ts, TIME_UTC) != TIME_UTC) { 130 | throw std::runtime_error("timespec_get failed"); 131 | } 132 | 133 | ts = addSeconds(ts, timeoutSecs); 134 | 135 | int res = tct_cnd_timedwait(&_c, _m, &ts); 136 | if (res == tct_thrd_success) { 137 | return true; 138 | } else if (res == tct_thrd_timedout) { 139 | return false; 140 | } else { 141 | throw std::runtime_error("Condition variable failed to timedwait"); 142 | } 143 | } 144 | }; 145 | 146 | #endif // _THREADUTILS_H_ 147 | -------------------------------------------------------------------------------- /src/timeconv.h: -------------------------------------------------------------------------------- 1 | #ifndef _LATER_TIMECONV_H_ 2 | #define _LATER_TIMECONV_H_ 3 | 4 | #include 5 | // Some platforms (Win32, previously some Mac versions) use 6 | // tinycthread.h to provide timespec. Whether tinycthread 7 | // defines timespec or not, we want it to be consistent for 8 | // anyone who uses these functions. 9 | #include "tinycthread.h" 10 | 11 | inline timespec addSeconds(const timespec& time, double secs) { 12 | timespec ts = time; 13 | ts.tv_sec += (time_t)secs; 14 | ts.tv_nsec += (secs - (time_t)secs) * 1e9L; 15 | if (ts.tv_nsec < 0) { 16 | ts.tv_nsec += 1e9L; 17 | ts.tv_sec--; 18 | } 19 | if (ts.tv_nsec >= 1e9L) { 20 | ts.tv_nsec -= 1e9L; 21 | ts.tv_sec++; 22 | } 23 | return ts; 24 | } 25 | 26 | #endif // _LATER_TIMECONV_H_ 27 | -------------------------------------------------------------------------------- /src/timer_posix.cpp: -------------------------------------------------------------------------------- 1 | #ifndef _WIN32 2 | 3 | #include 4 | #include 5 | 6 | #include "timer_posix.h" 7 | 8 | int Timer::bg_main_func(void* data) { 9 | reinterpret_cast(data)->bg_main(); 10 | return 0; 11 | } 12 | 13 | void Timer::bg_main() { 14 | Guard guard(&this->mutex); 15 | while (true) { 16 | 17 | // Guarded wait; we can't pass here until either the timer is stopped or we 18 | // have a wait time. 19 | while (!(this->stopped || this->wakeAt.has_value())) { 20 | this->cond.wait(); 21 | } 22 | 23 | // We're stopped; return, which ends the thread. 24 | if (this->stopped) { 25 | return; 26 | } 27 | 28 | // The wake time has been set. There are three possibilities: 29 | // 1. The wake time is in the past. Go ahead and execute now. 30 | // 2. Wait for the wake time, but we're notified before time elapses. 31 | // Start the loop again. 32 | // 3. Wait for the wake time, and time elapses. Go ahead and execute now. 33 | double secs = (*this->wakeAt).diff_secs(Timestamp()); 34 | if (secs > 0) { 35 | bool signalled = this->cond.timedwait(secs); 36 | if (this->stopped) { 37 | return; 38 | } 39 | if (signalled) { 40 | // Time didn't elapse, we were woken up (probably). Start over. 41 | continue; 42 | } 43 | } 44 | 45 | this->wakeAt.reset(); 46 | callback(); 47 | } 48 | } 49 | 50 | Timer::Timer(const std::function& callback) : 51 | callback(callback), mutex(tct_mtx_recursive), cond(mutex), stopped(false) { 52 | } 53 | 54 | Timer::~Timer() { 55 | 56 | // Must stop background thread before cleaning up condition variable and 57 | // mutex. Calling pthread_cond_destroy on a condvar that's being waited 58 | // on results in undefined behavior--on Fedora 25+ it hangs. 59 | if (this->bgthread.has_value()) { 60 | { 61 | Guard guard(&this->mutex); 62 | this->stopped = true; 63 | this->cond.signal(); 64 | } 65 | 66 | tct_thrd_join(*this->bgthread, NULL); 67 | } 68 | } 69 | 70 | void Timer::set(const Timestamp& timestamp) { 71 | Guard guard(&this->mutex); 72 | 73 | // If the thread has not yet been created, created it. 74 | if (!this->bgthread.has_value()) { 75 | tct_thrd_t thread; 76 | tct_thrd_create(&thread, &bg_main_func, this); 77 | this->bgthread = thread; 78 | } 79 | 80 | this->wakeAt = timestamp; 81 | this->cond.signal(); 82 | } 83 | 84 | #endif // _WIN32 85 | -------------------------------------------------------------------------------- /src/timer_posix.h: -------------------------------------------------------------------------------- 1 | #ifndef _TIMER_POSIX_H_ 2 | #define _TIMER_POSIX_H_ 3 | 4 | #ifndef _WIN32 5 | 6 | #include 7 | #include "timestamp.h" 8 | #include "threadutils.h" 9 | #include "optional.h" 10 | 11 | class Timer { 12 | std::function callback; 13 | Mutex mutex; 14 | ConditionVariable cond; 15 | // Stores the handle to a bgthread, which is created upon demand. (Previously 16 | // the thread was created in the constructor, but addressed sanitized (ASAN) 17 | // builds of R would hang when pthread_create was called during dlopen.) 18 | Optional bgthread; 19 | Optional wakeAt; 20 | bool stopped; 21 | 22 | static int bg_main_func(void*); 23 | void bg_main(); 24 | public: 25 | Timer(const std::function& callback); 26 | virtual ~Timer(); 27 | 28 | // Schedules the timer to fire next at the specified time. 29 | // If the timer is currently scheduled to fire, that will 30 | // be overwritten with this one (the timer only tracks one 31 | // timestamp at a time). 32 | void set(const Timestamp& timestamp); 33 | }; 34 | 35 | 36 | #endif // _WIN32 37 | 38 | #endif // _TIMER_POSIX_H_ 39 | -------------------------------------------------------------------------------- /src/timestamp.h: -------------------------------------------------------------------------------- 1 | #ifndef _TIMESTAMP_H_ 2 | #define _TIMESTAMP_H_ 3 | 4 | #include 5 | 6 | // Impl abstract class; implemented by platform-specific classes 7 | class TimestampImpl { 8 | public: 9 | virtual ~TimestampImpl() {} 10 | virtual bool future() const = 0; 11 | virtual bool less(const TimestampImpl* other) const = 0; 12 | virtual bool greater(const TimestampImpl* other) const = 0; 13 | virtual double diff_secs(const TimestampImpl* other) const = 0; 14 | }; 15 | 16 | class Timestamp { 17 | private: 18 | std::shared_ptr p_impl; 19 | 20 | public: 21 | Timestamp(); 22 | Timestamp(double secs); 23 | 24 | // Is this timestamp in the future? 25 | bool future() const { 26 | return p_impl->future(); 27 | } 28 | 29 | // Comparison operators 30 | bool operator<(const Timestamp& other) const { 31 | return p_impl->less(other.p_impl.get()); 32 | } 33 | bool operator>(const Timestamp& other) const { 34 | return p_impl->greater(other.p_impl.get()); 35 | } 36 | 37 | // Diff 38 | double diff_secs(const Timestamp& other) const { 39 | return p_impl->diff_secs(other.p_impl.get()); 40 | } 41 | }; 42 | 43 | #endif // _TIMESTAMP_H_ 44 | -------------------------------------------------------------------------------- /src/timestamp_unix.cpp: -------------------------------------------------------------------------------- 1 | #ifndef _WIN32 2 | 3 | #include 4 | #include "timestamp.h" 5 | #include "timeconv.h" 6 | 7 | void get_current_time(timespec *ts) { 8 | // CLOCK_MONOTONIC ensures that we never get timestamps that go backward in 9 | // time due to clock adjustment. https://github.com/r-lib/later/issues/150 10 | clock_gettime(CLOCK_MONOTONIC, ts); 11 | } 12 | 13 | class TimestampImplPosix : public TimestampImpl { 14 | private: 15 | timespec time; 16 | 17 | public: 18 | TimestampImplPosix() { 19 | get_current_time(&this->time); 20 | } 21 | 22 | TimestampImplPosix(double secs) { 23 | get_current_time(&this->time); 24 | 25 | this->time = addSeconds(this->time, secs); 26 | } 27 | 28 | virtual bool future() const { 29 | timespec now; 30 | get_current_time(&now); 31 | return this->time.tv_sec > now.tv_sec || 32 | (this->time.tv_sec == now.tv_sec && this->time.tv_nsec > now.tv_nsec); 33 | } 34 | 35 | virtual bool less(const TimestampImpl* other) const { 36 | const TimestampImplPosix* other_impl = dynamic_cast(other); 37 | return this->time.tv_sec < other_impl->time.tv_sec || 38 | (this->time.tv_sec == other_impl->time.tv_sec && this->time.tv_nsec < other_impl->time.tv_nsec); 39 | } 40 | 41 | virtual bool greater(const TimestampImpl* other) const { 42 | const TimestampImplPosix* other_impl = dynamic_cast(other); 43 | return this->time.tv_sec > other_impl->time.tv_sec || 44 | (this->time.tv_sec == other_impl->time.tv_sec && this->time.tv_nsec > other_impl->time.tv_nsec); 45 | } 46 | 47 | virtual double diff_secs(const TimestampImpl* other) const { 48 | const TimestampImplPosix* other_impl = dynamic_cast(other); 49 | double sec_diff = this->time.tv_sec - other_impl->time.tv_sec; 50 | sec_diff += (this->time.tv_nsec - other_impl->time.tv_nsec) / 1.0e9; 51 | return sec_diff; 52 | } 53 | }; 54 | 55 | Timestamp::Timestamp() : p_impl(new TimestampImplPosix()) {} 56 | Timestamp::Timestamp(double secs) : p_impl(new TimestampImplPosix(secs)) {} 57 | 58 | #endif // _WIN32 59 | -------------------------------------------------------------------------------- /src/timestamp_win32.cpp: -------------------------------------------------------------------------------- 1 | #ifdef _WIN32 2 | 3 | #include "timestamp.h" 4 | #define WIN32_LEAN_AND_MEAN 5 | #include 6 | 7 | class TimestampImplWin32 : public TimestampImpl { 8 | private: 9 | LARGE_INTEGER performanceCount; 10 | 11 | public: 12 | TimestampImplWin32() { 13 | QueryPerformanceCounter(&this->performanceCount); 14 | } 15 | 16 | TimestampImplWin32(double secs) { 17 | LARGE_INTEGER freq; 18 | QueryPerformanceFrequency(&freq); 19 | QueryPerformanceCounter(&this->performanceCount); 20 | this->performanceCount.QuadPart += static_cast(secs * (double)freq.QuadPart); 21 | } 22 | 23 | virtual bool future() const { 24 | LARGE_INTEGER now; 25 | QueryPerformanceCounter(&now); 26 | return this->performanceCount.QuadPart > now.QuadPart; 27 | } 28 | 29 | virtual bool less(const TimestampImpl* other) const { 30 | const TimestampImplWin32* other_impl = dynamic_cast(other); 31 | return this->performanceCount.QuadPart < other_impl->performanceCount.QuadPart; 32 | } 33 | 34 | virtual bool greater(const TimestampImpl* other) const { 35 | const TimestampImplWin32* other_impl = dynamic_cast(other); 36 | return this->performanceCount.QuadPart > other_impl->performanceCount.QuadPart; 37 | } 38 | 39 | virtual double diff_secs(const TimestampImpl* other) const { 40 | const TimestampImplWin32* other_impl = dynamic_cast(other); 41 | LONGLONG sec_diff = this->performanceCount.QuadPart - other_impl->performanceCount.QuadPart; 42 | 43 | LARGE_INTEGER freq; 44 | QueryPerformanceFrequency(&freq); 45 | 46 | return (double)sec_diff / (double)freq.QuadPart; 47 | } 48 | }; 49 | 50 | Timestamp::Timestamp() : p_impl(new TimestampImplWin32()) {} 51 | Timestamp::Timestamp(double secs) : p_impl(new TimestampImplWin32(secs)) {} 52 | 53 | #endif // WIN32 54 | -------------------------------------------------------------------------------- /src/utils.h: -------------------------------------------------------------------------------- 1 | #ifndef UTILS_H 2 | #define UTILS_H 3 | 4 | #include 5 | #include 6 | 7 | 8 | template 9 | std::string toString(T x) { 10 | std::stringstream ss; 11 | ss << x; 12 | return ss.str(); 13 | } 14 | 15 | #endif 16 | -------------------------------------------------------------------------------- /src/wref.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | 4 | SEXP _later_new_weakref(SEXP x){ 5 | 6 | return R_MakeWeakRef(x, R_NilValue, R_NilValue, FALSE); 7 | 8 | } 9 | 10 | SEXP _later_wref_key(SEXP x){ 11 | 12 | return R_WeakRefKey(x); 13 | 14 | } 15 | -------------------------------------------------------------------------------- /tests/testthat.R: -------------------------------------------------------------------------------- 1 | # See https://github.com/r-lib/testthat/issues/86 2 | Sys.setenv("R_TESTS" = "") 3 | 4 | library(testthat) 5 | library(later) 6 | 7 | DetailedSummaryReporter <- R6::R6Class("DetailedSummaryReporter", inherit = testthat::SummaryReporter, 8 | public = list( 9 | start_test = function(context, test) { 10 | self$cat_tight(" ", test, ": ") 11 | }, 12 | end_test = function(context, test) { 13 | self$cat_line() 14 | }, 15 | start_context = function(context) { 16 | self$cat_tight(context, ":\n") 17 | }, 18 | end_context = function(context) { } 19 | ) 20 | ) 21 | 22 | test_check("later", reporter = DetailedSummaryReporter) 23 | -------------------------------------------------------------------------------- /tests/testthat/test-c-api.R: -------------------------------------------------------------------------------- 1 | context("C++ API") 2 | 3 | test_that("header and DLL API versions match", { 4 | Rcpp::cppFunction( 5 | code = ' 6 | int later_dll_api_version() { 7 | int (*dll_api_version)() = (int (*)()) R_GetCCallable("later", "apiVersion"); 8 | return (*dll_api_version)(); 9 | } 10 | ' 11 | ) 12 | 13 | Rcpp::cppFunction( 14 | depends = 'later', 15 | includes = ' 16 | #include 17 | ', 18 | code = ' 19 | int later_h_api_version() { 20 | return LATER_H_API_VERSION; 21 | } 22 | ' 23 | ) 24 | 25 | expect_identical(later_dll_api_version(), later_h_api_version()) 26 | }) 27 | -------------------------------------------------------------------------------- /tests/testthat/test-cancel.R: -------------------------------------------------------------------------------- 1 | context("test-cancel.R") 2 | 3 | test_that("Cancelling callbacks", { 4 | # Cancel with zero delay 5 | x <- 0 6 | cancel <- later(function() { x <<- x + 1 }) 7 | later(function() { x <<- x + 2 }) 8 | expect_true(cancel()) 9 | run_now() 10 | expect_identical(x, 2) 11 | 12 | # Cancel with zero delay 13 | x <- 0 14 | cancel <- later(function() { x <<- x + 1 }, 1) 15 | run_now(0.25) 16 | expect_true(cancel()) 17 | run_now(1) 18 | expect_identical(x, 0) 19 | 20 | # Make sure a cancelled callback doesn't interfere with others 21 | x <- 0 22 | later(function() { x <<- x + 1 }, 1) 23 | cancel <- later(function() { x <<- x + 2 }, 0.5) 24 | run_now() 25 | expect_true(cancel()) 26 | run_now(2) 27 | expect_identical(x, 1) 28 | }) 29 | 30 | 31 | test_that("Cancelled functions will be GC'd", { 32 | x <- 0 33 | cancel <- later( 34 | local({ 35 | reg.finalizer(environment(), function(e) x <<- x + 1) 36 | function() message("foo") 37 | }) 38 | ) 39 | expect_true(cancel()) 40 | gc() 41 | expect_identical(x, 1) 42 | }) 43 | 44 | 45 | test_that("Cancelling executed or cancelled callbacks has no effect", { 46 | # Cancelling an executed callback 47 | x <- 0 48 | cancel <- later(function() { x <<- x + 1 }) 49 | run_now() 50 | expect_false(cancel()) 51 | run_now() 52 | expect_identical(x, 1) 53 | 54 | # Cancelling twice 55 | x <- 0 56 | cancel <- later(function() { x <<- x + 1 }) 57 | expect_true(cancel()) 58 | expect_false(cancel()) 59 | run_now() 60 | expect_identical(x, 0) 61 | }) 62 | 63 | 64 | test_that("Cancelling callbacks on temporary event loops", { 65 | with_temp_loop({ 66 | # Cancelling an executed callback 67 | x <- 0 68 | cancel <- later(function() { x <<- x + 1 }) 69 | run_now() 70 | expect_false(cancel()) 71 | run_now() 72 | expect_identical(x, 1) 73 | }) 74 | 75 | with_temp_loop({ 76 | # Cancelling twice 77 | x <- 0 78 | cancel <- later(function() { x <<- x + 1 }) 79 | expect_true(cancel()) 80 | expect_false(cancel()) 81 | run_now() 82 | expect_identical(x, 0) 83 | }) 84 | 85 | with_temp_loop({ 86 | # Make sure a cancelled callback doesn't interfere with others 87 | x <- 0 88 | later(function() { x <<- x + 1 }, 1) 89 | cancel <- later(function() { x <<- x + 2 }, 0.5) 90 | run_now() 91 | expect_true(cancel()) 92 | run_now(2) 93 | expect_identical(x, 1) 94 | }) 95 | 96 | # Canceling after an event loop handle has been destroyed: the underlying 97 | # data structure (in C++) will be deleted, along with the callbacks. This is 98 | # true because the loop does not have a parent. 99 | cancel <- NULL 100 | x <- 0 101 | with_temp_loop({ 102 | cancel <- later(function() { x <<- x + 1 }) 103 | }) 104 | expect_false(cancel()) 105 | expect_identical(x, 0) 106 | }) 107 | 108 | 109 | test_that("Cancelling callbacks on persistent private loops without parent", { 110 | l1 <- create_loop(parent = NULL) 111 | l2 <- create_loop(parent = NULL) 112 | 113 | # Cancel from outside with_loop 114 | cancel <- NULL 115 | x <- 0 116 | with_loop(l1, { 117 | cancel <- later(function() { x <<- x + 1 }) 118 | }) 119 | expect_true(cancel()) 120 | expect_false(cancel()) 121 | with_loop(l1, run_now()) 122 | expect_false(cancel()) 123 | expect_identical(x, 0) 124 | 125 | 126 | # Make sure it doesn't interfere with other event loops 127 | with_loop(l1, { 128 | cancel <- later(function() { x <<- x + 1 }) 129 | }) 130 | with_loop(l2, { 131 | later(function() { x <<- x + 2 }) 132 | }) 133 | later(function() { x <<- x + 4 }) 134 | expect_true(cancel()) 135 | with_loop(l1, run_now()) 136 | with_loop(l2, run_now()) 137 | run_now() 138 | expect_identical(x, 6) 139 | 140 | 141 | # Cancelling on an explicitly destroyed loop returns FALSE 142 | l3 <- create_loop(parent = NULL) 143 | cancel <- NULL 144 | x <- 0 145 | with_loop(l3, { 146 | cancel <- later(function() { x <<- x + 1 }) 147 | }) 148 | destroy_loop(l3) 149 | expect_false(cancel()) 150 | expect_identical(x, 0) 151 | }) 152 | 153 | test_that("Cancelling callbacks on persistent private loops with parent", { 154 | # If the loop handle is GC'd but the loop _does have_ a parent, then the 155 | # underlying objects will not be destroyed right away, so the cancel() will 156 | # work. 157 | cancel <- NULL 158 | x <- 0 159 | local({ 160 | l1 <- create_loop(parent = current_loop()) 161 | cancel <<- later(function() { x <<- x + 1 }, loop = l1) 162 | }) 163 | expect_true(cancel()) 164 | expect_false(cancel()) 165 | expect_identical(x, 0) 166 | }) 167 | 168 | test_that("A canceler will not keep loop alive", { 169 | l <- create_loop(parent = NULL) 170 | finalized <- FALSE 171 | 172 | reg.finalizer(l, function(x) finalized <<- TRUE) 173 | cancel <- later(function() 1, loop = l) 174 | rm(l) 175 | gc() 176 | expect_true(finalized) 177 | }) 178 | 179 | test_that("Canceling a callback from another a callback", { 180 | # Canceling a callback from another callback should work. Additionally, the 181 | # altered ordering of callbacks shouldn't prevent other callbacks from 182 | # running. In this test, #1 cancels 2 and 3, but we still expect 4 to run. If 183 | # we used the wrong algorithm for traversing the queue and canceling 184 | # callbacks, it would be possible for the cancellation of 2 and 3 to cause 4 185 | # to not run. This test ensures that we do it the right way. 186 | ran_2 <- FALSE 187 | ran_3 <- FALSE 188 | ran_4 <- FALSE 189 | with_temp_loop({ 190 | cancel_1 <- later(function() { cancel_2(); cancel_3() }) 191 | cancel_2 <- later(function() { ran_2 <<- TRUE }) 192 | cancel_3 <- later(function() { ran_3 <<- TRUE }) 193 | later(function() { ran_4 <<- TRUE }) 194 | run_now() 195 | }) 196 | 197 | expect_false(ran_2) 198 | expect_false(ran_3) 199 | expect_true(ran_4) 200 | }) 201 | -------------------------------------------------------------------------------- /tests/testthat/test-later-fd.R: -------------------------------------------------------------------------------- 1 | context("test-later-fd.R") 2 | 3 | test_that("later_fd", { 4 | skip_if_not_installed("nanonext") 5 | 6 | result <- NULL 7 | callback <- function(x) result <<- x 8 | s1 <- nanonext::socket(listen = "inproc://nanonext") 9 | on.exit(close(s1)) 10 | s2 <- nanonext::socket(dial = "inproc://nanonext") 11 | on.exit(close(s2), add = TRUE) 12 | fd1 <- nanonext::opt(s1, "recv-fd") 13 | fd2 <- nanonext::opt(s2, "recv-fd") 14 | 15 | # timeout 16 | later_fd(callback, c(fd1, fd2), timeout = 0) 17 | run_now(1) 18 | expect_equal(result, c(FALSE, FALSE)) 19 | later_fd(callback, c(fd1, fd2), exceptfds = c(fd1, fd2), timeout = 0) 20 | run_now(1) 21 | expect_equal(result, c(FALSE, FALSE, FALSE, FALSE)) 22 | 23 | # cancellation 24 | result <- NULL 25 | cancel <- later_fd(callback, c(fd1, fd2), timeout = 0.2) 26 | expect_type(cancel, "closure") 27 | expect_true(cancel()) 28 | Sys.sleep(0.25) 29 | expect_false(cancel()) 30 | expect_invisible(cancel()) 31 | run_now() 32 | expect_null(result) 33 | 34 | # timeout (> 1 loop) 35 | later_fd(callback, c(fd1, fd2), timeout = 1.1) 36 | run_now(1.3) 37 | expect_equal(result, c(FALSE, FALSE)) 38 | 39 | # fd1 ready 40 | later_fd(callback, c(fd1, fd2), timeout = 0.9) 41 | res <- nanonext::send(s2, "msg") 42 | run_now(1) 43 | expect_equal(result, c(TRUE, FALSE)) 44 | 45 | # both fd1, fd2 ready 46 | res <- nanonext::send(s1, "msg") 47 | Sys.sleep(0.1) 48 | later_fd(callback, c(fd1, fd2), timeout = 1) 49 | run_now(1) 50 | expect_equal(result, c(TRUE, TRUE)) 51 | 52 | # no exceptions 53 | later_fd(callback, c(fd1, fd2), exceptfds = c(fd1, fd2), timeout = -0.1) 54 | run_now(1) 55 | expect_equal(result, c(TRUE, TRUE, FALSE, FALSE)) 56 | 57 | # fd2 ready 58 | res <- nanonext::recv(s1) 59 | later_fd(callback, c(fd1, fd2), timeout = 1L) 60 | run_now(1) 61 | expect_equal(result, c(FALSE, TRUE)) 62 | 63 | # fd2 invalid 64 | res <- nanonext::recv(s2) 65 | later_fd(callback, c(fd1, fd2), exceptfds = c(fd1, fd2), timeout = 0.1) 66 | close(s2) 67 | run_now(1) 68 | expect_length(result, 4L) 69 | 70 | # both fd1, fd2 invalid 71 | close(s1) 72 | later_fd(callback, c(fd1, fd2), c(fd1, fd2), timeout = 0) 73 | run_now(1) 74 | expect_equal(result, c(NA, NA, NA, NA)) 75 | 76 | # no fds supplied 77 | later_fd(callback, timeout = -1) 78 | run_now(1) 79 | expect_equal(result, logical()) 80 | 81 | on.exit() 82 | 83 | }) 84 | 85 | test_that("loop_empty() reflects later_fd callbacks", { 86 | skip_if_not_installed("nanonext") 87 | 88 | s1 <- nanonext::socket(listen = "inproc://nanotest2") 89 | on.exit(close(s1)) 90 | s2 <- nanonext::socket(dial = "inproc://nanotest2") 91 | on.exit(close(s2), add = TRUE) 92 | 93 | fd1 <- nanonext::opt(s1, "recv-fd") 94 | 95 | expect_true(loop_empty()) 96 | 97 | cancel <- later_fd(~{}, fd1) 98 | expect_false(loop_empty()) 99 | cancel() 100 | Sys.sleep(1.25) # check for cancellation happens every ~1 sec 101 | expect_true(loop_empty()) 102 | 103 | later_fd(~{}, fd1, timeout = 0) 104 | expect_false(loop_empty()) 105 | run_now(1) 106 | expect_true(loop_empty()) 107 | 108 | }) 109 | 110 | test_that("later_fd() errors when passed destroyed loops", { 111 | 112 | loop <- create_loop() 113 | destroy_loop(loop) 114 | expect_error(later_fd(identity, loop = loop), "CallbackRegistry does not exist") 115 | 116 | }) 117 | -------------------------------------------------------------------------------- /tests/testthat/test-private-loops.R: -------------------------------------------------------------------------------- 1 | context("test-private-loops.R") 2 | 3 | describe("Private event loop", { 4 | it("changes current_loop()", { 5 | expect_identical(current_loop(), global_loop()) 6 | 7 | with_temp_loop({ 8 | expect_false(identical(current_loop(), global_loop())) 9 | }) 10 | }) 11 | 12 | it("runs only its own tasks", { 13 | x <- 0 14 | later(~{x <<- 1}, 0) 15 | with_temp_loop({ 16 | expect_true(loop_empty()) 17 | 18 | later(~{x <<- 2}) 19 | run_now() 20 | 21 | expect_identical(x, 2) 22 | 23 | run_now(loop = global_loop()) 24 | expect_identical(x, 1) 25 | }) 26 | }) 27 | }) 28 | 29 | 30 | 31 | test_that("Private event loops", { 32 | l <- create_loop(parent = NULL) 33 | x <- 0 34 | 35 | expect_true(exists_loop(l)) 36 | 37 | with_loop(l, { 38 | later(function() x <<- x + 1 ) 39 | run_now() 40 | }) 41 | expect_equal(x, 1) 42 | 43 | with_loop(l, { 44 | later(function() x <<- x + 1 ) 45 | run_now() 46 | 47 | later(function() x <<- x + 1 ) 48 | later(function() x <<- x + 1 ) 49 | }) 50 | expect_equal(x, 2) 51 | 52 | with_loop(l, run_now()) 53 | expect_equal(x, 4) 54 | 55 | destroy_loop(l) 56 | expect_false(exists_loop(l)) 57 | 58 | # Can't run later-y things with destroyed loop 59 | expect_error(with_loop(l, later(function() message("foo")))) 60 | expect_error(with_loop(l, run_now())) 61 | 62 | # GC with functions in destroyed loops, even if callback isn't executed. 63 | l <- create_loop(parent = NULL) 64 | x <- 0 65 | gc() 66 | with_loop(l, { 67 | later( 68 | local({ 69 | reg.finalizer(environment(), function(e) x <<-x + 1) 70 | function() message("foo") 71 | }) 72 | ) 73 | }) 74 | gc() 75 | expect_identical(x, 0) 76 | 77 | destroy_loop(l) 78 | gc() 79 | expect_identical(x, 1) 80 | 81 | 82 | # A GC'd loop object will cause its queue to be deleted, which will allow GC 83 | # of any resources 84 | l <- create_loop(parent = NULL) 85 | x <- 0 86 | gc() 87 | with_loop(l, { 88 | later( 89 | local({ 90 | reg.finalizer(environment(), function(e) x <<-x + 1) 91 | function() message("foo") 92 | }) 93 | ) 94 | }) 95 | gc() 96 | expect_identical(x, 0) 97 | 98 | # Delete the reference to the loop, and GC. This causes the queue to be 99 | # deleted, which removes references to items in the queue. However, the items 100 | # in the queue won't be GC'd yet. (At least not as of R 3.5.2.) 101 | rm(l) 102 | gc() 103 | expect_identical(x, 0) 104 | 105 | # A second GC triggers the finalizer for an item that was in the queue. 106 | gc() 107 | expect_identical(x, 1) 108 | 109 | 110 | # Can't destroy global loop 111 | expect_error(destroy_loop(global_loop())) 112 | }) 113 | 114 | 115 | test_that("Temporary event loops", { 116 | l <- NULL 117 | x <- 0 118 | with_temp_loop({ 119 | l <- current_loop() 120 | later(function() x <<- x + 1 ) 121 | run_now() 122 | }) 123 | 124 | expect_false(exists_loop(l)) 125 | expect_error(with_loop(l, { 126 | later(function() x <<- x + 1 ) 127 | run_now() 128 | })) 129 | 130 | # Test GC 131 | # Make sure that items captured in later callbacks are GC'd after the callback 132 | # is executed. 133 | x <- 0 134 | with_temp_loop({ 135 | later( 136 | local({ 137 | reg.finalizer(environment(), function(e) x <<-x + 1) 138 | function() 1 139 | }) 140 | ) 141 | gc() 142 | run_now() 143 | }) 144 | expect_identical(x, 0) 145 | gc() 146 | expect_identical(x, 1) 147 | 148 | # Test that objects are GC'd after loop is destroyed, even if callback hasn't 149 | # been executed. 150 | x <- 0 151 | with_temp_loop({ 152 | later( 153 | local({ 154 | reg.finalizer(environment(), function(e) x <<-x + 1) 155 | function() 1 156 | }) 157 | ) 158 | run_now() 159 | 160 | later( 161 | local({ 162 | e <- environment() 163 | reg.finalizer(environment(), function(e) x <<-x + 1) 164 | function() 1 165 | }) 166 | ) 167 | gc() 168 | }) 169 | expect_identical(x, 1) 170 | gc() 171 | expect_identical(x, 2) 172 | }) 173 | 174 | test_that("Destroying loop and loop ID", { 175 | l <- create_loop() 176 | expect_true(is.integer(l$id)) 177 | expect_true(destroy_loop(l)) 178 | expect_false(exists_loop(l)) 179 | 180 | # Should return false on subsequent calls to destroy_loop() 181 | expect_false(destroy_loop(l)) 182 | # Destroying a second time shouldn't cause warnings. 183 | expect_silent(destroy_loop(l)) 184 | }) 185 | 186 | test_that("Can't destroy current loop", { 187 | errored <- FALSE 188 | with_temp_loop({ 189 | later(function() { 190 | # We can't do expect_error in a later() callback, so use a tryCatch 191 | # instead to check that an error occurs. 192 | tryCatch( 193 | destroy_loop(current_loop()), 194 | error = function(e) { errored <<- TRUE } 195 | ) 196 | }) 197 | run_now() 198 | }) 199 | 200 | expect_true(errored) 201 | }) 202 | 203 | test_that("Can't GC current loop", { 204 | collected <- FALSE 205 | l <- create_loop() 206 | reg.finalizer(l, function(x) { collected <<- TRUE }) 207 | with_loop(l, { 208 | rm(l, inherits = TRUE) 209 | gc() 210 | gc() 211 | }) 212 | expect_false(collected) 213 | gc() 214 | expect_true(collected) 215 | }) 216 | 217 | 218 | test_that("When auto-running a child loop, it will be reported as current_loop()", { 219 | l <- create_loop(parent = global_loop()) 220 | x <- NULL 221 | later(function() { x <<- current_loop() }, loop = l) 222 | run_now(loop = global_loop()) 223 | expect_identical(x, l) 224 | }) 225 | 226 | 227 | test_that("CallbackRegistry exists until its callbacks are run", { 228 | # If the R loop handle object is GC'd, it doesn't necessarily destroy the 229 | # underlying CallbackRegistry (in C++). The CallbackRegistry is only destroyed 230 | # when the R loop handle is GC'd AND the CallbackRegistry contains no more 231 | # callbacks. 232 | x <- 0 233 | callback <- function() { x <<- x + 1 } 234 | local({ 235 | l <- create_loop() 236 | later(callback, loop = l) 237 | }) 238 | gc() 239 | run_now() 240 | expect_identical(x, 1) 241 | }) 242 | 243 | test_that("Auto-running grandchildren loops", { 244 | l1_ran <- FALSE 245 | l11_ran <- FALSE 246 | l12_ran <- FALSE 247 | l13_ran <- FALSE 248 | l2_ran <- FALSE 249 | l21_ran <- FALSE 250 | l22_ran <- FALSE 251 | l23_ran <- FALSE 252 | 253 | l1 <- create_loop() 254 | l2 <- create_loop(parent = NULL) 255 | 256 | # l1 should auto-run, along with l11 and l12. l13 should not, because it has 257 | # no parent. 258 | with_loop(l1, { 259 | later(function() l1_ran <<- TRUE) 260 | l11 <- create_loop() 261 | l12 <- create_loop() 262 | l13 <- create_loop(parent = NULL) 263 | later(function() l11_ran <<- TRUE, loop = l11) 264 | later(function() l12_ran <<- TRUE, loop = l12) 265 | later(function() l13_ran <<- TRUE, loop = l13) 266 | }) 267 | 268 | # None of these should auto-run, because l2 has no parent. 269 | with_loop(l2, { 270 | later(function() l2_ran <<- TRUE) 271 | l21 <- create_loop() 272 | l22 <- create_loop() 273 | l23 <- create_loop(parent = NULL) 274 | later(function() l21_ran <<- TRUE, loop = l21) 275 | later(function() l22_ran <<- TRUE, loop = l22) 276 | later(function() l23_ran <<- TRUE, loop = l23) 277 | }) 278 | 279 | run_now() 280 | expect_true(l1_ran) 281 | expect_true(l11_ran) 282 | expect_true(l12_ran) 283 | expect_false(l13_ran) 284 | expect_false(l2_ran) 285 | expect_false(l21_ran) 286 | expect_false(l22_ran) 287 | expect_false(l23_ran) 288 | }) 289 | 290 | test_that("Grandchildren loops whose parent is destroyed should not autorun", { 291 | l_ran <- 0 292 | l1_ran <- 0 293 | l <- create_loop() 294 | 295 | with_loop(l, { 296 | later(function() l_ran <<- l_ran + 1) 297 | l1 <- create_loop() 298 | later(function() l1_ran <<- l1_ran + 1, loop = l1) 299 | }) 300 | 301 | notify_r_ref_deleted(l) 302 | run_now() 303 | # l will run, because the underlying registry exists until empty. It also 304 | # causes l1 to run. 305 | expect_identical(l_ran, 1) 306 | expect_identical(l1_ran, 1) 307 | expect_false(exists_loop(l)) 308 | # l1 should still exist because we still have a reference to it. 309 | expect_true(exists_loop(l1)) 310 | 311 | # Schedule another function that we don't expect to actually run. 312 | # Use finalizer to keep 313 | l1_finalized <- FALSE 314 | later(local({ 315 | reg.finalizer(environment(), function(e) l1_finalized <<- TRUE) 316 | function() l1_ran <<- l1_ran + 1 317 | }), 318 | loop = l1 319 | ) 320 | run_now() 321 | # l1 won't run again 322 | expect_identical(l1_ran, 1) 323 | expect_true(exists_loop(l1)) 324 | expect_false(l1_finalized) 325 | # If the reference is lost (like when the loop handle is GC'd) l1 will take 326 | # effect immediately. 327 | expect_true(notify_r_ref_deleted(l1)) 328 | expect_false(exists_loop(l1)) 329 | gc() # Make the finalizer run 330 | expect_true(l1_finalized) 331 | }) 332 | 333 | 334 | test_that("Removing parent loop allows loop to be deleted", { 335 | # Create parent loop, then create a child loop, then add a finalizer to a 336 | # callback (actually, the env for the callback) in the child loop. 337 | l <- create_loop() 338 | l1 <- create_loop(parent = l) 339 | 340 | x <- 0 341 | with_loop(l1, { 342 | later( 343 | local({ 344 | reg.finalizer(environment(), function(e) x <<-x + 1) 345 | function() NULL 346 | }) 347 | ) 348 | }) 349 | 350 | # Removing the ref to the child should NOT cause the finalizer to run -- the 351 | # loop won't actually be destroyed because it (A) has a parent AND (B) has a 352 | # callback. notify_r_ref_deleted(l1) 353 | rm(l1) 354 | gc() 355 | gc() 356 | expect_identical(x, 0) 357 | 358 | # If we destroy the parent loop, then the finalizer will be called, because 359 | # even though the child loop has a callback, it no longer has a parent. 360 | # Because both the handle and its parent have been GC'd, there's no way to run 361 | # callbacks in the child, so the internal representation of the child loop can 362 | # be deleted, along with all the callbacks it contains. 363 | rm(l) 364 | # Use 2 GC's because the first causes the loops to be GC'd; the second causes 365 | # the function that was queued in a loop to be GC'd. 366 | gc() 367 | gc() 368 | expect_identical(x, 1) 369 | }) 370 | 371 | test_that("Interrupt while running in private loop won't result in stuck loop", { 372 | l <- create_loop() 373 | later(function() { rlang::interrupt() }, loop = l) 374 | tryCatch({ 375 | run_now(loop = l) 376 | }, interrupt = function(e) NULL) 377 | expect_identical(current_loop(), global_loop()) 378 | 379 | tryCatch({ 380 | with_loop(l, { 381 | rlang::interrupt() 382 | }) 383 | }, interrupt = function(e) NULL) 384 | expect_identical(current_loop(), global_loop()) 385 | }) 386 | 387 | 388 | test_that("list_queue", { 389 | l <- create_loop(parent = NULL) 390 | q <- NULL 391 | f <- function() 1 # A dummy function 392 | 393 | with_loop(l, { 394 | later(f) 395 | q <- list_queue() 396 | }) 397 | expect_equal(length(q), 1) 398 | expect_identical(q[[1]]$callback, f) 399 | 400 | with_loop(l, { 401 | run_now() 402 | q <- list_queue() 403 | }) 404 | expect_equal(length(q), 0) 405 | 406 | with_loop(l, { 407 | later(f) 408 | later(f) 409 | later(sum) 410 | q <- list_queue() 411 | }) 412 | expect_equal(length(q), 3) 413 | expect_identical(q[[1]]$callback, f) 414 | expect_identical(q[[2]]$callback, f) 415 | expect_identical(q[[3]]$callback, sum) 416 | 417 | # Empty the queue by calling run now. Also test calling list_queue by passing 418 | # in a loop handle. 419 | with_loop(l, run_now()) 420 | q <- list_queue(l) 421 | expect_equal(length(q), 0) 422 | }) 423 | -------------------------------------------------------------------------------- /tests/testthat/test-run_now.R: -------------------------------------------------------------------------------- 1 | context("test-run_now.R") 2 | 3 | jitter <- 0.017*2 # Compensate for imprecision in system timer 4 | 5 | test_that("run_now waits and returns FALSE if no tasks", { 6 | x <- system.time({ 7 | result <- later::run_now(0.5) 8 | }) 9 | expect_gte(as.numeric(x[["elapsed"]]), 0.5 - jitter) 10 | expect_identical(result, FALSE) 11 | 12 | x <- system.time({ 13 | result <- later::run_now(3) 14 | }) 15 | expect_gte(as.numeric(x[["elapsed"]]), 3 - jitter) 16 | expect_identical(result, FALSE) 17 | }) 18 | 19 | test_that("run_now returns immediately after executing a task", { 20 | x <- system.time({ 21 | later::later(~{}, 0) 22 | result <- later::run_now(2) 23 | }) 24 | expect_lt(as.numeric(x[["elapsed"]]), 0.25) 25 | expect_identical(result, TRUE) 26 | }) 27 | 28 | test_that("run_now executes all scheduled tasks, not just one", { 29 | later::later(~{}, 0) 30 | later::later(~{}, 0) 31 | result1 <- later::run_now() 32 | result2 <- later::run_now() 33 | expect_identical(result1, TRUE) 34 | expect_identical(result2, FALSE) 35 | }) 36 | 37 | test_that("run_now executes just one scheduled task, if requested", { 38 | result1 <- later::run_now() 39 | expect_identical(result1, FALSE) 40 | 41 | later::later(~{}, 0) 42 | later::later(~{}, 0) 43 | 44 | result2 <- later::run_now(all = FALSE) 45 | expect_identical(result2, TRUE) 46 | 47 | result3 <- later::run_now(all = FALSE) 48 | expect_identical(result3, TRUE) 49 | 50 | result4 <- later::run_now() 51 | expect_identical(result4, FALSE) 52 | }) 53 | 54 | test_that("run_now doesn't go past a failed task", { 55 | later::later(~stop("boom"), 0) 56 | later::later(~{}, 0) 57 | expect_error(later::run_now()) 58 | expect_true(later::run_now()) 59 | }) 60 | 61 | test_that("run_now wakes up when a background thread calls later()", { 62 | # Skip due to false positives on UBSAN 63 | skip_if(using_ubsan()) 64 | 65 | env <- new.env() 66 | Rcpp::sourceCpp(system.file("bgtest.cpp", package = "later"), env = env) 67 | # The background task sleeps 68 | env$launchBgTask(1) 69 | 70 | x <- system.time({ 71 | result <- later::run_now(3) 72 | }) 73 | # Wait for up to 1.5 seconds (for slow systems) 74 | expect_lt(as.numeric(x[["elapsed"]]), 1.5) 75 | expect_true(result) 76 | }) 77 | 78 | test_that("When callbacks have tied timestamps, they respect order of creation", { 79 | # Skip due to false positives on UBSAN 80 | skip_if(using_ubsan()) 81 | 82 | expect_error(testCallbackOrdering(), NA) 83 | 84 | Rcpp::sourceCpp(code = ' 85 | #include 86 | #include 87 | 88 | void* max_seen = 0; 89 | 90 | void callback(void* data) { 91 | if (data < max_seen) { 92 | Rf_error("Bad ordering detected"); 93 | } 94 | max_seen = data; 95 | } 96 | 97 | // [[Rcpp::depends(later)]] 98 | // [[Rcpp::export]] 99 | void checkLaterOrdering() { 100 | max_seen = 0; 101 | for (size_t i = 0; i < 10000; i++) { 102 | later::later(callback, (void*)i, 0); 103 | } 104 | } 105 | ') 106 | checkLaterOrdering(); while (!later::loop_empty()) later::run_now() 107 | }) 108 | 109 | 110 | test_that("Callbacks cannot affect the caller", { 111 | # This is based on a pattern used in the callCC function. Normally, simply 112 | # touching `throw` will cause the expression to be evaluated and f() to return 113 | # early. (This test does not involve later.) 114 | f <- function() { 115 | delayedAssign("throw", return(100)) 116 | g <- function() { throw } 117 | g() 118 | return(200) 119 | } 120 | expect_equal(f(), 100) 121 | 122 | 123 | # When later runs callbacks, it wraps the call in R_ToplevelExec(), which 124 | # creates a boundary on the call stack that the early return can't cross. 125 | f <- function() { 126 | delayedAssign("throw", return(100)) 127 | later(function() { throw }) 128 | 129 | run_now(1) 130 | return(200) 131 | } 132 | # jcheng 2024-10-24: Apparently this works now, maybe because having 133 | # RCPP_USING_UNWIND_PROTECT means we don't need to use R_ToplevelExec to call 134 | # callbacks? 135 | # expect_error(f()) 136 | expect_identical(f(), 100) 137 | 138 | 139 | # In this case, f() should return normally, and then when g() causes later to 140 | # run the callback with `throw`, it should be an error -- there's no function 141 | # to return from because it (f()) already returned. 142 | f <- function() { 143 | delayedAssign("throw", return(100)) 144 | later(function() { throw }, 0.5) 145 | return(200) 146 | } 147 | g <- function() { 148 | run_now(1) 149 | } 150 | expect_equal(f(), 200) 151 | expect_error(g()) 152 | }) 153 | 154 | 155 | 156 | test_that("interrupt and exception handling, R", { 157 | # ======================================================= 158 | # Errors and interrupts in R callbacks 159 | # ======================================================= 160 | 161 | # R error 162 | error_obj <- FALSE 163 | tryCatch( 164 | { 165 | later(function() { stop("oopsie") }) 166 | run_now() 167 | }, 168 | error = function(e) { 169 | error_obj <<- e 170 | } 171 | ) 172 | expect_true(grepl("oopsie", error_obj$message)) 173 | 174 | # interrupt 175 | interrupted <- FALSE 176 | tryCatch( 177 | { 178 | later(function() {rlang::interrupt(); Sys.sleep(100) }) 179 | run_now() 180 | }, 181 | interrupt = function(e) { 182 | interrupted <<- TRUE 183 | } 184 | ) 185 | expect_true(interrupted) 186 | }) 187 | 188 | test_that("interrupt and exception handling, C++", { 189 | # Skip as cpp_error(4) test seen producing error on some platforms on rhub 190 | skip_on_cran() 191 | # Skip due to false positives on UBSAN 192 | skip_if(using_ubsan()) 193 | # Skip on Windows i386 because of known bad behavior 194 | if (R.version$os == "mingw32" && R.version$arch == "i386") { 195 | skip("C++ exceptions in later callbacks are known bad on Windows i386") 196 | } 197 | 198 | # ======================================================= 199 | # Exceptions in C++ callbacks 200 | # ======================================================= 201 | 202 | # In these tests, in C++, later schedules a C++ callback in which an 203 | # exception is thrown or interrupt occurs. 204 | # 205 | # Some of these callbacks in turn call R functions. 206 | 207 | Rcpp::cppFunction( 208 | depends = "later", 209 | includes = ' 210 | #include 211 | #include 212 | #include 213 | #include 214 | #include 215 | 216 | void oof(void* data) { 217 | int* v = (int*)data; 218 | int value = *v; 219 | delete v; 220 | 221 | if (value == 1) { 222 | throw std::runtime_error("This is a C++ exception."); 223 | 224 | } else if (value == 2) { 225 | // Throw an arbitrary object 226 | throw std::string(); 227 | 228 | } else if (value == 3) { 229 | // Interrupt the interpreter 230 | Rf_onintr(); 231 | } else if (value == 4) { 232 | // Calls R function via Rcpp, which interrupts. 233 | // sleeps. 234 | Function("r_interrupt")(); 235 | 236 | } else if (value == 5) { 237 | // Calls R function via Rcpp which calls stop(). 238 | Function("r_error")(); 239 | 240 | } else if (value == 6) { 241 | // Calls the `r_error` function via R\'s C API instead of Rcpp. 242 | SEXP e; 243 | PROTECT(e = Rf_lang1(Rf_install("r_error"))); 244 | 245 | Rf_eval(e, R_GlobalEnv); 246 | 247 | UNPROTECT(1); 248 | } 249 | } 250 | ', 251 | code = ' 252 | void cpp_error(int value) { 253 | int* v = new int(value); 254 | later::later(oof, v, 0); 255 | } 256 | ' 257 | ) 258 | 259 | # cpp_error() searches in the global environment for these R functions, so we 260 | # need to define them there. 261 | .GlobalEnv$r_interrupt <- function() { 262 | rlang::interrupt() 263 | } 264 | .GlobalEnv$r_error <- function() { 265 | stop("oopsie") 266 | } 267 | on.exit(rm(r_interrupt, r_error, envir = .GlobalEnv), add = TRUE) 268 | 269 | errored <- FALSE 270 | tryCatch( 271 | { cpp_error(1); run_now() }, 272 | error = function(e) errored <<- TRUE 273 | ) 274 | expect_true(errored) 275 | 276 | errored <- FALSE 277 | tryCatch( 278 | { cpp_error(2); run_now() }, 279 | error = function(e) errored <<- TRUE 280 | ) 281 | expect_true(errored) 282 | 283 | errored <- FALSE 284 | tryCatch( 285 | { cpp_error(5); run_now() }, 286 | error = function(e) errored <<- TRUE 287 | ) 288 | expect_true(errored) 289 | 290 | errored <- FALSE 291 | tryCatch( 292 | { cpp_error(6); run_now() }, 293 | error = function(e) errored <<- TRUE 294 | ) 295 | expect_true(errored) 296 | 297 | interrupted <- FALSE 298 | tryCatch( 299 | { cpp_error(3); run_now() }, 300 | interrupt = function(e) interrupted <<- TRUE 301 | ) 302 | expect_true(interrupted) 303 | 304 | interrupted <- FALSE 305 | tryCatch( 306 | { cpp_error(4); run_now() }, 307 | interrupt = function(e) interrupted <<- TRUE 308 | ) 309 | expect_true(interrupted) 310 | }) 311 | -------------------------------------------------------------------------------- /vignettes/later-cpp.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Using later from C++" 3 | author: "Joe Cheng" 4 | date: "`r Sys.Date()`" 5 | output: rmarkdown::html_vignette 6 | vignette: > 7 | %\VignetteIndexEntry{Using later from C++} 8 | %\VignetteEngine{knitr::rmarkdown} 9 | %\VignetteEncoding{UTF-8} 10 | --- 11 | 12 | # Using later from C++ 13 | 14 | You can call `later::later` from C++ code in your own packages, to cause your own C-style functions to be called back. This is safe to call from either the main R thread or a different thread; in both cases, your callback will be invoked from the main R thread. 15 | 16 | To use the C++ interface, you'll need to: 17 | 18 | * Add `later` to your `DESCRIPTION` file, under both `LinkingTo` and `Imports` 19 | * Make sure that your `NAMESPACE` file has an `import(later)` entry. If your package uses roxygen2, you can do this by adding the following lines to any file under `R/`: 20 | ``` 21 | #' @import later 22 | NULL 23 | ``` 24 | * Add `#include ` to the top of each C++ file that uses the below APIs. 25 | 26 | ## Executing a C function later 27 | 28 | The `later::later` function is accessible from `later_api.h` and its prototype looks like this: 29 | 30 | ```cpp 31 | void later(void (*func)(void*), void* data, double secs) 32 | ``` 33 | 34 | The first argument is a pointer to a function that takes one `void*` argument and returns void. The second argument is a `void*` that will be passed to the function when it's called back. And the third argument is the number of seconds to wait (at a minimum) before invoking. In all cases, the function will be invoked on the R thread, when no user R code is executing. 35 | 36 | ## Background tasks 37 | 38 | This package also offers a higher-level C++ helper class called `later::BackgroundTask`, to make it easier to execute tasks on a background thread. It takes care of launching the background thread for you, and returning control back to the R thread at a later point; you're responsible for providing the actual code that executes on the background thread, as well as code that executes on the R thread before and after the background task completes. 39 | 40 | Its public/protected interface looks like this: 41 | 42 | ```cpp 43 | class BackgroundTask { 44 | 45 | public: 46 | BackgroundTask(); 47 | virtual ~BackgroundTask(); 48 | 49 | // Start executing the task 50 | void begin(); 51 | 52 | protected: 53 | // The task to be executed on the background thread. 54 | // Neither the R runtime nor any R data structures may be 55 | // touched from the background thread; any values that need 56 | // to be passed into or out of the Execute method must be 57 | // included as fields on the Task subclass object. 58 | virtual void execute() = 0; 59 | 60 | // A short task that runs on the main R thread after the 61 | // background task has completed. It's safe to access the 62 | // R runtime and R data structures from here. 63 | virtual void complete() = 0; 64 | } 65 | ``` 66 | 67 | Create your own subclass, implementing a custom constructor plus the `execute` and `complete` methods. 68 | 69 | It's critical that the code in your `execute` method not mutate any R data structures, call any R code, or cause any R allocations, as it will execute in a background thread where such operations are unsafe. You can, however, perform such operations in the constructor (assuming you perform construction only from the main R thread) and `complete` method. Pass values between the constructor and methods using fields. 70 | 71 | ```rcpp 72 | #include 73 | #include 74 | 75 | class MyTask : public later::BackgroundTask { 76 | public: 77 | MyTask(Rcpp::NumericVector vec) : 78 | inputVals(Rcpp::as >(vec)) { 79 | } 80 | 81 | protected: 82 | void execute() { 83 | double sum = 0; 84 | for (std::vector::const_iterator it = inputVals.begin(); 85 | it != inputVals.end(); 86 | it++) { 87 | 88 | sum += *it; 89 | } 90 | result = sum / inputVals.size(); 91 | } 92 | 93 | void complete() { 94 | Rprintf("Result is %f\n", result); 95 | } 96 | 97 | private: 98 | std::vector inputVals; 99 | double result; 100 | }; 101 | ``` 102 | 103 | To run the task, `new` up your subclass and call `begin()`, e.g. `(new MyTask(vec))->begin()`. There's no need to keep track of the pointer; the task object will delete itself when the task is complete. 104 | 105 | ```r 106 | // [[Rcpp::export]] 107 | void asyncMean(Rcpp::NumericVector data) { 108 | (new MyTask(data))->begin(); 109 | } 110 | ``` 111 | 112 | It's not very useful to execute tasks on background threads if you can't get access to the results back in R. We'll soon be introducing a complementary R package that provides a suitable "promise" or "future" abstraction. 113 | --------------------------------------------------------------------------------