Merged origin/main into main

NEWS.md

@@ -11,6 +11,9 @@
 
 ## Features and fixes
 
+* `modify()`, `modify2()`, and `modify_if()` now correctly handle `NULL`s
+  in replacement values (#655, #746, #753).
+
 * `every()` and `some()` now properly check the return value of their
   predicate function. It must now return a `TRUE`, `FALSE`, or `NA`.
 
@@ -25,7 +28,6 @@
 
 * purrr is now licensed as MIT (#805).
 
-
 # purrr 0.3.4
 
 * Fixed issue in `list_modify()` that prevented lists from being

R/modify.R

@@ -136,7 +136,7 @@ modify.default <- function(.x, .f, ...) {
   .f <- as_mapper(.f, ...)
 
   for (i in seq_along(.x)) {
-    .x[[i]] <- .f(.x[[i]], ...)
+    list_slice2(.x, i) <- .f(.x[[i]], ...)
   }
 
   .x
@@ -156,13 +156,13 @@ modify_if.default <- function(.x, .p, .f, ..., .else = NULL) {
 
   .f <- as_mapper(.f, ...)
   for (i in index[sel]) {
-    .x[[i]] <- .f(.x[[i]], ...)
+    list_slice2(.x, i) <- .f(.x[[i]], ...)
   }
 
   if (!is_null(.else)) {
     .else <- as_mapper(.else, ...)
     for (i in index[!sel]) {
-      .x[[i]] <- .else(.x[[i]], ...)
+      list_slice2(.x, i) <- .else(.x[[i]], ...)
     }
   }
 
@@ -336,7 +336,7 @@ modify2.default <- function(.x, .y, .f, ...) {
   .y <- args[[2]]
 
   for (i in seq_along(.x)) {
-    .x[[i]] <- .f(.x[[i]], .y[[i]], ...)
+    list_slice2(.x, i) <- .f(.x[[i]], .y[[i]], ...)
   }
 
   .x
@@ -473,3 +473,12 @@ inv_which <- function(x, sel) {
     stop("unrecognised index type", call. = FALSE)
   }
 }
+
+`list_slice2<-` <- function(x, i, value) {
+  if (is.null(value)) {
+    x[i] <- list(NULL)
+  } else {
+    x[[i]] <- value
+  }
+  x
+}

R/output.R

@@ -107,12 +107,12 @@ auto_browse <- function(.f) {
         # 1: h(simpleError(msg, call))
         # 2: .handleSimpleError(function (e)  <...>
         # 3: stop(...)
-        frame <- ctxt_frame(4)
+        frame <- sys.frame(4)
         browse_in_frame(frame)
       },
       warning = function(e) {
         if (getOption("warn") >= 2) {
-          frame <- ctxt_frame(7)
+          frame <- sys.frame(7)
           browse_in_frame(frame)
         }
       },
@@ -126,15 +126,15 @@ auto_browse <- function(.f) {
 browse_in_frame <- function(frame) {
   # ESS should problably set `.Platform$GUI == "ESS"`
   # In the meantime, check that ESSR is attached
-  if (is_scoped("ESSR")) {
+  if (is_attached("ESSR")) {
     # Workaround ESS issue
-    with_env(frame$env, on.exit({
+    with_env(frame, on.exit({
       browser()
       NULL
     }))
     return_from(frame)
   } else {
-    eval_bare(quote(browser()), env = frame$env)
+    eval_bare(quote(browser()), env = frame)
   }
 }
 

tests/testthat/test-modify.R

@@ -90,6 +90,22 @@ test_that("`.else` modifies false elements", {
   expect_identical(modify_if(iris, is.factor, as.character, .else = as.integer), exp)
 })
 
+test_that("modify family preserves NULLs", {
+  l <- list(a = 1, b = NULL, c = 3)
+  expect_equal(modify(l, identity), l)
+  expect_equal(modify_at(l, "b", identity), l)
+  expect_equal(modify_if(l, is.null, identity), l)
+  expect_equal(
+    modify(l, ~ if (!is.null(.x)) .x + .y, 10),
+    list(a = 11, b = NULL, c = 13)
+  )
+  expect_equal(
+    modify_if(list(1, 2), ~ .x == 2, ~NULL),
+    list(1, NULL)
+  )
+})
+
+
 # modify_depth ------------------------------------------------------------
 
 test_that("modify_depth modifies values at specified depth", {
@@ -138,3 +154,12 @@ test_that("modify_at() can use tidyselect", {
   two <- modify_at(mtcars, vars(tidyselect::contains("cyl")), as.character)
   expect_bare(two$cyl, "character")
 })
+
+test_that("modify_depth() treats NULLs correctly", {
+  ll <- list(a = NULL, b = list(b1 = NULL, b2 = "hello"))
+  expect_equal(modify_depth(ll, .depth = 2, identity, .ragged = TRUE), ll)
+  expect_equal(
+    modify_depth(ll, .depth = 2, is.character, .ragged = TRUE),
+    list(a = NULL, b = list(b1 = FALSE, b2 = TRUE))
+  )
+})