diff --git a/NEWS.md b/NEWS.md index 8614a11a..4377a476 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,6 +1,7 @@ # S7 (development version) * New `:=` operator creates and names an object in one step, so `Foo := new_class()` is equivalent to `Foo <- new_class(name = "Foo")` (#658). +* The `:=` operator now stays ahead of rlang and data.table regardless of attachment order, without emitting `:=` masking messages (#697). * The class object that S7 stores on each instance now lives in the `_S7_class` attribute (previously `S7_class`), moving it into the `_`-prefixed namespace reserved for S7 internals so it can't collide with a user-defined property. Objects created by an older version of S7 (e.g. serialised to disk or baked into another package's lazy-load database) continue to work, as S7 falls back to the old attribute name when reading them (#677). * S7 and S4 now interoperate through inheritance. `new_class()` can use an S4 class as a parent, mapping S4 slots to S7 properties and registering the class with S4 automatically. Conversely, `S4_register()` registers an S7 class with S4, and `S4_contains()` returns an S4 class name suitable for `methods::setClass(contains = )`, exposing stored S7 properties as S4 slots for S4 subclasses. This support includes S4 initialization and validity integration, and S4/internal generic registration where needed; see `vignette("compatibility")` for caveats (#456). * Errors thrown by S7 now report the function where they occurred, making it easier to track down the source of a problem (#646). diff --git a/R/compatibility.R b/R/compatibility.R index 52f80ef4..923d53b5 100644 --- a/R/compatibility.R +++ b/R/compatibility.R @@ -7,6 +7,60 @@ activate_backward_compatiblility <- function() { invisible() } +bind_conflict_packages <- c("data.table", "rlang") + +set_attached_bind <- function(env, value) { + get("unlockBinding", baseenv())(":=", env) + defer(lockBinding(":=", env)) + env[[":="]] <- value +} + +activate_bind_compatibility <- function() { + for (package in bind_conflict_packages) { + # These rules are session-wide. If S7 is detached, a package attached + # later may remain without its error-only := export on the search path. + rule <- conflictRules(package) + conflictRules( + package, + mask.ok = rule$mask.ok, + exclude = union(rule$exclude, ":=") + ) + + attached <- paste0("package:", package) + if (!attached %in% search()) { + next + } + + env <- as.environment(attached) + if ( + exists(":=", envir = env, inherits = FALSE) && + identical(env[[":="]], getExportedValue(package, ":=")) + ) { + # These exports are erroring sentinels for package-specific NSE syntax. + # An identical binding is not reported as a conflict by library(). + set_attached_bind(env, `:=`) + } + } + + invisible() +} + +restore_attached_bindings <- function() { + for (package in bind_conflict_packages) { + attached <- paste0("package:", package) + if (!attached %in% search()) { + next + } + + env <- as.environment(attached) + if (identical(env[[":="]], `:=`)) { + set_attached_bind(env, getExportedValue(package, ":=")) + } + } + + invisible() +} + #' @aliases @ #' @usage NULL #' @rawNamespace if (getRversion() < "4.3.0") export(`@`) diff --git a/R/zzz.R b/R/zzz.R index a9794809..6dab9068 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -132,12 +132,19 @@ methods::setOldClass(c("S7_method", "function", "S7_object")) # hooks ------------------------------------------------------------------- .onAttach <- function(libname, pkgname) { - env <- as.environment(paste0("package:", pkgname)) + activate_bind_compatibility() + if (getRversion() < "4.3.0") { - env[[".conflicts.OK"]] <- TRUE + # S7_at already supplies @ without conflicting with base::@. + env <- as.environment(paste0("package:", pkgname)) + rm(list = "@", envir = env) } } +.onDetach <- function(...) { + restore_attached_bindings() +} + .onLoad <- function(...) { activate_backward_compatiblility() diff --git a/tests/testthat/helper.R b/tests/testthat/helper.R index c8be317e..24512ae8 100644 --- a/tests/testthat/helper.R +++ b/tests/testthat/helper.R @@ -126,6 +126,40 @@ local_libpath <- function(frame = parent.frame()) { lib } +# Install the development S7 into a session-scoped library (built once per +# test process) and prepend that library to .libPaths() until `frame` exits. +local_dev_S7_lib <- local({ + lib <- NULL + function(frame = parent.frame()) { + if (is.null(lib)) { + dir.create(new_lib <- tempfile("S7-dev-lib-")) + install.packages( + pkgs = normalizePath(test_path("..", "..")), + lib = new_lib, + repos = NULL, + type = "source", + quiet = TRUE, + INSTALL_opts = c( + "--data-compress=none", + "--no-byte-compile", + "--no-data", + "--no-demo", + "--no-docs", + "--no-help", + "--no-html", + "--use-vanilla" + ) + ) + lib <<- new_lib + } + + old <- .libPaths() + .libPaths(c(lib, old)) + defer(.libPaths(old), frame = frame) + lib + } +}) + # Install the package at `path` into `lib`, attach it, and detach (and unload) # it when `frame` exits. The package name is taken from `basename(path)`. local_install_and_attach <- function(path, lib, frame = parent.frame()) { diff --git a/tests/testthat/test-bind.R b/tests/testthat/test-bind.R index c9d1920d..8ac33142 100644 --- a/tests/testthat/test-bind.R +++ b/tests/testthat/test-bind.R @@ -42,3 +42,112 @@ test_that(":= validates its inputs", { foo := no_name() }) }) + +test_that("S7 := wins without hiding unrelated attach conflicts", { + skip_if(quick_test()) + + packages <- c("data.table", "rlang") + packages <- packages[vapply( + packages, + requireNamespace, + logical(1), + quietly = TRUE + )] + skip_if(length(packages) == 0, "rlang and data.table are not installed") + + local_dev_S7_lib() + + check_order <- function(package, order) { + output <- callr::r( + function(package, order) { + if (identical(order, "package-first")) { + package_bind <- getExportedValue(package, ":=") + attach( + list(as_class = function(...) NULL), + name = "shadow", + warn.conflicts = FALSE + ) + library(package, character.only = TRUE) + } + + messages <- character() + warnings <- character() + + withCallingHandlers( + { + if (identical(order, "S7-first")) { + library(S7) + library(package, character.only = TRUE) + } else { + library(S7) + } + }, + packageStartupMessage = function(cnd) { + messages <<- c(messages, conditionMessage(cnd)) + invokeRestart("muffleMessage") + }, + warning = function(cnd) { + warnings <<- c(warnings, conditionMessage(cnd)) + invokeRestart("muffleWarning") + } + ) + + stopifnot(identical(get(":=", mode = "function"), S7::`:=`)) + + if (identical(order, "package-first")) { + stopifnot(identical(getExportedValue(package, ":="), package_bind)) + detach("package:S7") + stopifnot(identical( + get(":=", mode = "function"), + package_bind + )) + } + + list(messages = messages, warnings = warnings) + }, + args = list(package = package, order = order) + ) + + expect_no_match(output$messages, ":=", fixed = TRUE) + expect_no_match(output$warnings, ":=", fixed = TRUE) + if (identical(order, "package-first")) { + expect_match(output$messages, "as_class", all = FALSE) + } + } + + for (package in packages) { + check_order(package, "S7-first") + check_order(package, "package-first") + } +}) + +test_that("loading S7 does not affect := when S7 is not attached", { + skip_if(quick_test()) + + packages <- c("data.table", "rlang") + packages <- packages[vapply( + packages, + requireNamespace, + logical(1), + quietly = TRUE + )] + skip_if(length(packages) == 0, "rlang and data.table are not installed") + + local_dev_S7_lib() + + for (package in packages) { + expect_no_error(callr::r( + function(package) { + loadNamespace("S7") + library(package, character.only = TRUE) + stopifnot( + identical( + get(":=", mode = "function"), + getExportedValue(package, ":=") + ) + ) + }, + args = list(package = package) + )) + } +}) diff --git a/vignettes/packages.Rmd b/vignettes/packages.Rmd index 64361f4f..e8a779d5 100644 --- a/vignettes/packages.Rmd +++ b/vignettes/packages.Rmd @@ -26,6 +26,16 @@ library(S7) First, add `S7` to the `Imports` field of your `DESCRIPTION`. We then recommend importing all S7 functions into your package `NAMESPACE` with `import(S7)`, or, if you're using roxygen2, `@import S7`. +If your package also imports rlang or data.table, import `:=` from only S7. Otherwise, R warns that one import replaces the other when it loads your package. For example, to import all of rlang except `:=` with roxygen2: + +``` r +#' @import S7 +#' @import rlang, except = ":=" +NULL +``` + +Use the same `except` argument when importing data.table. + Next, create a `zzz.R` with a `.onLoad()` that calls `S7_on_load()`, an `.onUnload()` that calls `S7_on_unload()`, and a top-level call to `S7_on_build()`: ```{r}