From f91403a82fc97a74995981225be09d9fd47a20c6 Mon Sep 17 00:00:00 2001 From: Tomasz Kalinowski Date: Wed, 24 Jun 2026 14:49:32 -0400 Subject: [PATCH 1/2] Keep S7 := ahead of competing search-path exports --- NEWS.md | 1 + R/compatibility.R | 65 ++++++++++++++++++++++++++++ R/zzz.R | 7 ++-- tests/testthat/test-bind.R | 86 ++++++++++++++++++++++++++++++++++++++ 4 files changed, 155 insertions(+), 4 deletions(-) diff --git a/NEWS.md b/NEWS.md index 6c34bdccb..eb578c58b 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 other attached packages that export `:=`, such as rlang or data.table, without emitting attach-time masking messages. * 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). * Errors thrown by S7 now report the function where they occurred, making it easier to track down the source of a problem (#646). * `class_POSIXct` uses the `tzone` attribute (not `tz`), and allows it to be absent (#401). diff --git a/R/compatibility.R b/R/compatibility.R index b7421ee9b..cafe004c1 100644 --- a/R/compatibility.R +++ b/R/compatibility.R @@ -7,6 +7,71 @@ activate_backward_compatiblility <- function() { invisible() } +activate_attach_compatibility <- function(pkgname) { + if (getRversion() >= "4.3.0" && !search_has_bind_conflict(pkgname)) { + return(invisible()) + } + + env <- as.environment(paste0("package:", pkgname)) + env[[".conflicts.OK"]] <- TRUE + invisible() +} + +search_has_bind_conflict <- function(pkgname) { + pkg <- paste0("package:", pkgname) + env <- as.environment(pkg) + bind <- env[[":="]] + where <- setdiff(search(), c(pkg, "Autoloads", "CheckExEnv")) + + for (pos in where) { + other <- as.environment(pos) + if (!exists(":=", envir = other, inherits = FALSE)) { + next + } + + other_bind <- other[[":="]] + if (is.function(other_bind) && !identical(other_bind, bind)) { + return(TRUE) + } + } + + FALSE +} + +activate_bind_compatibility <- function() { + conflictRules <- get0("conflictRules", envir = baseenv(), inherits = FALSE) + if (is.null(conflictRules)) { + return(invisible()) + } + + for (package in packages_exporting_bind()) { + rule <- conflictRules(package) + conflictRules( + package, + mask.ok = rule$mask.ok, + exclude = union(rule$exclude, ":=") + ) + } + + invisible() +} + +packages_exporting_bind <- function(lib.loc = .libPaths()) { + paths <- unlist( + lapply(lib.loc, list.dirs, recursive = FALSE, full.names = TRUE), + use.names = FALSE + ) + paths <- paths[file.exists(file.path(paths, "Meta", "nsInfo.rds"))] + + exports_bind <- vapply( + file.path(paths, "Meta", "nsInfo.rds"), + function(path) ":=" %in% readRDS(path)$exports, + logical(1) + ) + + setdiff(unique(basename(paths)[exports_bind]), "S7") +} + #' @aliases @ #' @usage NULL #' @rawNamespace if (getRversion() < "4.3.0") export(`@`) diff --git a/R/zzz.R b/R/zzz.R index 5b9bc2fef..2e039e35f 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -131,14 +131,13 @@ methods::setOldClass(c("S7_method", "function", "S7_object")) # hooks ------------------------------------------------------------------- .onAttach <- function(libname, pkgname) { - env <- as.environment(paste0("package:", pkgname)) - if (getRversion() < "4.3.0") { - env[[".conflicts.OK"]] <- TRUE - } + activate_bind_compatibility() + activate_attach_compatibility(pkgname) } .onLoad <- function(...) { activate_backward_compatiblility() + activate_bind_compatibility() on_load_define_environment() on_load_define_S7_generic() diff --git a/tests/testthat/test-bind.R b/tests/testthat/test-bind.R index c9d1920d3..e44109d63 100644 --- a/tests/testthat/test-bind.R +++ b/tests/testthat/test-bind.R @@ -42,3 +42,89 @@ test_that(":= validates its inputs", { foo := no_name() }) }) + +test_that("S7 := wins search-path conflicts without attach warnings", { + skip_if(quick_test()) + + tmp_lib <- local_libpath() + install.packages( + pkgs = normalizePath(test_path("..", "..")), + lib = tmp_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" + ) + ) + + alias_pkg <- tempfile("aliasbind") + dir.create(file.path(alias_pkg, "R"), recursive = TRUE) + writeLines( + c( + "Package: aliasbind", + "Version: 0.0.0", + "Title: Alias Bind", + "Description: Test package exporting a conflicting bind operator.", + "License: MIT", + "Encoding: UTF-8" + ), + file.path(alias_pkg, "DESCRIPTION") + ) + writeLines('export(":=")', file.path(alias_pkg, "NAMESPACE")) + writeLines( + c( + "`:=` <- function(lhs, rhs) {", + ' "aliasbind"', + "}" + ), + file.path(alias_pkg, "R", "bind.R") + ) + quick_install(alias_pkg, tmp_lib) + + check_order <- function(order) { + expect_no_error(callr::r( + function(order) { + messages <- character() + warnings <- character() + + withCallingHandlers( + { + if (identical(order, "S7-first")) { + library(S7) + library(aliasbind) + } else { + library(aliasbind) + library(S7) + } + }, + packageStartupMessage = function(cnd) { + messages <<- c(messages, conditionMessage(cnd)) + invokeRestart("muffleMessage") + }, + warning = function(cnd) { + warnings <<- c(warnings, conditionMessage(cnd)) + invokeRestart("muffleWarning") + } + ) + + stopifnot(exprs = { + identical(get(":=", mode = "function"), S7::`:=`) + !any(grepl(":=", messages, fixed = TRUE)) + !any(grepl(":=", warnings, fixed = TRUE)) + }) + }, + args = list(order = order) + )) + } + + check_order("S7-first") + check_order("alias-first") +}) From bdaee293c831eba4688a52b186049c25be38fe43 Mon Sep 17 00:00:00 2001 From: Tomasz Kalinowski Date: Wed, 24 Jun 2026 14:51:42 -0400 Subject: [PATCH 2/2] Use existing bind-exporting packages in conflict tests --- R/compatibility.R | 18 +-------------- tests/testthat/test-bind.R | 47 ++++++++++++++------------------------ 2 files changed, 18 insertions(+), 47 deletions(-) diff --git a/R/compatibility.R b/R/compatibility.R index cafe004c1..a67f24bb8 100644 --- a/R/compatibility.R +++ b/R/compatibility.R @@ -44,7 +44,7 @@ activate_bind_compatibility <- function() { return(invisible()) } - for (package in packages_exporting_bind()) { + for (package in c("data.table", "rlang")) { rule <- conflictRules(package) conflictRules( package, @@ -56,22 +56,6 @@ activate_bind_compatibility <- function() { invisible() } -packages_exporting_bind <- function(lib.loc = .libPaths()) { - paths <- unlist( - lapply(lib.loc, list.dirs, recursive = FALSE, full.names = TRUE), - use.names = FALSE - ) - paths <- paths[file.exists(file.path(paths, "Meta", "nsInfo.rds"))] - - exports_bind <- vapply( - file.path(paths, "Meta", "nsInfo.rds"), - function(path) ":=" %in% readRDS(path)$exports, - logical(1) - ) - - setdiff(unique(basename(paths)[exports_bind]), "S7") -} - #' @aliases @ #' @usage NULL #' @rawNamespace if (getRversion() < "4.3.0") export(`@`) diff --git a/tests/testthat/test-bind.R b/tests/testthat/test-bind.R index e44109d63..06228f81e 100644 --- a/tests/testthat/test-bind.R +++ b/tests/testthat/test-bind.R @@ -65,33 +65,18 @@ test_that("S7 := wins search-path conflicts without attach warnings", { ) ) - alias_pkg <- tempfile("aliasbind") - dir.create(file.path(alias_pkg, "R"), recursive = TRUE) - writeLines( - c( - "Package: aliasbind", - "Version: 0.0.0", - "Title: Alias Bind", - "Description: Test package exporting a conflicting bind operator.", - "License: MIT", - "Encoding: UTF-8" - ), - file.path(alias_pkg, "DESCRIPTION") - ) - writeLines('export(":=")', file.path(alias_pkg, "NAMESPACE")) - writeLines( - c( - "`:=` <- function(lhs, rhs) {", - ' "aliasbind"', - "}" - ), - file.path(alias_pkg, "R", "bind.R") - ) - quick_install(alias_pkg, tmp_lib) + 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") - check_order <- function(order) { + check_order <- function(package, order) { expect_no_error(callr::r( - function(order) { + function(package, order) { messages <- character() warnings <- character() @@ -99,9 +84,9 @@ test_that("S7 := wins search-path conflicts without attach warnings", { { if (identical(order, "S7-first")) { library(S7) - library(aliasbind) + library(package, character.only = TRUE) } else { - library(aliasbind) + library(package, character.only = TRUE) library(S7) } }, @@ -121,10 +106,12 @@ test_that("S7 := wins search-path conflicts without attach warnings", { !any(grepl(":=", warnings, fixed = TRUE)) }) }, - args = list(order = order) + args = list(package = package, order = order) )) } - check_order("S7-first") - check_order("alias-first") + for (package in packages) { + check_order(package, "S7-first") + check_order(package, "alias-first") + } })