Skip to content

Commit 318a54b

Browse files
hadleyhadley
authored
Upkeep 2025-07 (#2154)
* `use_lifecycle()` * `use_latest_dependencies()` * Use purrr standalone file (#1753) * Use `withr::defer()` instead of `on.exit()`
1 parent a012eef commit 318a54b

34 files changed

+403
-91
lines changed

‎DESCRIPTION‎

Lines changed: 13 additions & 13 deletions
Original file line numberDiff line numberDiff line change
@@ -17,23 +17,23 @@ BugReports: https://github.com/r-lib/testthat/issues
1717
Depends:
1818
R (>= 4.1.0)
1919
Imports:
20-
brio (>= 1.1.3),
21-
callr (>= 3.7.3),
22-
cli (>= 3.6.1),
23-
desc (>= 1.4.2),
24-
evaluate (>= 1.0.1),
25-
jsonlite (>= 1.8.7),
26-
lifecycle (>= 1.0.3),
20+
brio (>= 1.1.5),
21+
callr (>= 3.7.6),
22+
cli (>= 3.6.5),
23+
desc (>= 1.4.3),
24+
evaluate (>= 1.0.4),
25+
jsonlite (>= 2.0.0),
26+
lifecycle (>= 1.0.4),
2727
magrittr (>= 2.0.3),
2828
methods,
29-
pkgload (>= 1.3.2.1),
29+
pkgload (>= 1.4.0),
3030
praise (>= 1.0.0),
31-
processx (>= 3.8.2),
32-
ps (>= 1.7.5),
33-
R6 (>= 2.5.1),
34-
rlang (>= 1.1.1),
31+
processx (>= 3.8.6),
32+
ps (>= 1.9.1),
33+
R6 (>= 2.6.1),
34+
rlang (>= 1.1.6),
3535
utils,
36-
waldo (>= 0.6.0),
36+
waldo (>= 0.6.2),
3737
withr (>= 3.0.2)
3838
Suggests:
3939
covr,

‎NAMESPACE‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -228,5 +228,6 @@ import(rlang)
228228
importFrom(R6,R6Class)
229229
importFrom(brio,readLines)
230230
importFrom(brio,writeLines)
231+
importFrom(lifecycle,deprecated)
231232
importFrom(magrittr,"%>%")
232233
useDynLib(testthat, .registration = TRUE)

‎R/deprec-condition.R‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -129,7 +129,7 @@ capture_warnings <- function(code, ignore_deprecation = FALSE) {
129129
}
130130

131131
get_messages <- function(x) {
132-
vapply(x, cnd_message, FUN.VALUE = character(1))
132+
map_chr(x, cnd_message)
133133
}
134134

135135
#' Is an error informative?

‎R/import-standalone-purrr.R‎

Lines changed: 246 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,246 @@
1+
# Standalone file: do not edit by hand
2+
# Source: https://github.com/r-lib/rlang/blob/HEAD/R/standalone-purrr.R
3+
# Generated by: usethis::use_standalone("r-lib/rlang", "purrr")
4+
# ----------------------------------------------------------------------
5+
#
6+
# ---
7+
# repo: r-lib/rlang
8+
# file: standalone-purrr.R
9+
# last-updated: 2023-02-23
10+
# license: https://unlicense.org
11+
# imports: rlang
12+
# ---
13+
#
14+
# This file provides a minimal shim to provide a purrr-like API on top of
15+
# base R functions. They are not drop-in replacements but allow a similar style
16+
# of programming.
17+
#
18+
# ## Changelog
19+
#
20+
# 2023-02-23:
21+
# * Added `list_c()`
22+
#
23+
# 2022-06-07:
24+
# * `transpose()` is now more consistent with purrr when inner names
25+
# are not congruent (#1346).
26+
#
27+
# 2021-12-15:
28+
# * `transpose()` now supports empty lists.
29+
#
30+
# 2021-05-21:
31+
# * Fixed "object `x` not found" error in `imap()` (@mgirlich)
32+
#
33+
# 2020-04-14:
34+
# * Removed `pluck*()` functions
35+
# * Removed `*_cpl()` functions
36+
# * Used `as_function()` to allow use of `~`
37+
# * Used `.` prefix for helpers
38+
#
39+
# nocov start
40+
41+
map <- function(.x, .f, ...) {
42+
.f <- as_function(.f, env = global_env())
43+
lapply(.x, .f, ...)
44+
}
45+
walk <- function(.x, .f, ...) {
46+
map(.x, .f, ...)
47+
invisible(.x)
48+
}
49+
50+
map_lgl <- function(.x, .f, ...) {
51+
.rlang_purrr_map_mold(.x, .f, logical(1), ...)
52+
}
53+
map_int <- function(.x, .f, ...) {
54+
.rlang_purrr_map_mold(.x, .f, integer(1), ...)
55+
}
56+
map_dbl <- function(.x, .f, ...) {
57+
.rlang_purrr_map_mold(.x, .f, double(1), ...)
58+
}
59+
map_chr <- function(.x, .f, ...) {
60+
.rlang_purrr_map_mold(.x, .f, character(1), ...)
61+
}
62+
.rlang_purrr_map_mold <- function(.x, .f, .mold, ...) {
63+
.f <- as_function(.f, env = global_env())
64+
out <- vapply(.x, .f, .mold, ..., USE.NAMES = FALSE)
65+
names(out) <- names(.x)
66+
out
67+
}
68+
69+
map2 <- function(.x, .y, .f, ...) {
70+
.f <- as_function(.f, env = global_env())
71+
out <- mapply(.f, .x, .y, MoreArgs = list(...), SIMPLIFY = FALSE)
72+
if (length(out) == length(.x)) {
73+
set_names(out, names(.x))
74+
} else {
75+
set_names(out, NULL)
76+
}
77+
}
78+
map2_lgl <- function(.x, .y, .f, ...) {
79+
as.vector(map2(.x, .y, .f, ...), "logical")
80+
}
81+
map2_int <- function(.x, .y, .f, ...) {
82+
as.vector(map2(.x, .y, .f, ...), "integer")
83+
}
84+
map2_dbl <- function(.x, .y, .f, ...) {
85+
as.vector(map2(.x, .y, .f, ...), "double")
86+
}
87+
map2_chr <- function(.x, .y, .f, ...) {
88+
as.vector(map2(.x, .y, .f, ...), "character")
89+
}
90+
imap <- function(.x, .f, ...) {
91+
map2(.x, names(.x) %||% seq_along(.x), .f, ...)
92+
}
93+
94+
pmap <- function(.l, .f, ...) {
95+
.f <- as.function(.f)
96+
args <- .rlang_purrr_args_recycle(.l)
97+
do.call(
98+
"mapply",
99+
c(
100+
FUN = list(quote(.f)),
101+
args,
102+
MoreArgs = quote(list(...)),
103+
SIMPLIFY = FALSE,
104+
USE.NAMES = FALSE
105+
)
106+
)
107+
}
108+
.rlang_purrr_args_recycle <- function(args) {
109+
lengths <- map_int(args, length)
110+
n <- max(lengths)
111+
112+
stopifnot(all(lengths == 1L | lengths == n))
113+
to_recycle <- lengths == 1L
114+
args[to_recycle] <- map(args[to_recycle], function(x) rep.int(x, n))
115+
116+
args
117+
}
118+
119+
keep <- function(.x, .f, ...) {
120+
.x[.rlang_purrr_probe(.x, .f, ...)]
121+
}
122+
discard <- function(.x, .p, ...) {
123+
sel <- .rlang_purrr_probe(.x, .p, ...)
124+
.x[is.na(sel) | !sel]
125+
}
126+
map_if <- function(.x, .p, .f, ...) {
127+
matches <- .rlang_purrr_probe(.x, .p)
128+
.x[matches] <- map(.x[matches], .f, ...)
129+
.x
130+
}
131+
.rlang_purrr_probe <- function(.x, .p, ...) {
132+
if (is_logical(.p)) {
133+
stopifnot(length(.p) == length(.x))
134+
.p
135+
} else {
136+
.p <- as_function(.p, env = global_env())
137+
map_lgl(.x, .p, ...)
138+
}
139+
}
140+
141+
compact <- function(.x) {
142+
.x[as.logical(lengths(.x))]
143+
}
144+
145+
transpose <- function(.l) {
146+
if (!length(.l)) {
147+
return(.l)
148+
}
149+
150+
inner_names <- names(.l[[1]])
151+
152+
if (is.null(inner_names)) {
153+
fields <- seq_along(.l[[1]])
154+
} else {
155+
fields <- set_names(inner_names)
156+
.l <- map(.l, function(x) {
157+
if (is.null(names(x))) {
158+
set_names(x, inner_names)
159+
} else {
160+
x
161+
}
162+
})
163+
}
164+
165+
# This way missing fields are subsetted as `NULL` instead of causing
166+
# an error
167+
.l <- map(.l, as.list)
168+
169+
map(fields, function(i) {
170+
map(.l, .subset2, i)
171+
})
172+
}
173+
174+
every <- function(.x, .p, ...) {
175+
.p <- as_function(.p, env = global_env())
176+
177+
for (i in seq_along(.x)) {
178+
if (!rlang::is_true(.p(.x[[i]], ...))) return(FALSE)
179+
}
180+
TRUE
181+
}
182+
some <- function(.x, .p, ...) {
183+
.p <- as_function(.p, env = global_env())
184+
185+
for (i in seq_along(.x)) {
186+
if (rlang::is_true(.p(.x[[i]], ...))) return(TRUE)
187+
}
188+
FALSE
189+
}
190+
negate <- function(.p) {
191+
.p <- as_function(.p, env = global_env())
192+
function(...) !.p(...)
193+
}
194+
195+
reduce <- function(.x, .f, ..., .init) {
196+
f <- function(x, y) .f(x, y, ...)
197+
Reduce(f, .x, init = .init)
198+
}
199+
reduce_right <- function(.x, .f, ..., .init) {
200+
f <- function(x, y) .f(y, x, ...)
201+
Reduce(f, .x, init = .init, right = TRUE)
202+
}
203+
accumulate <- function(.x, .f, ..., .init) {
204+
f <- function(x, y) .f(x, y, ...)
205+
Reduce(f, .x, init = .init, accumulate = TRUE)
206+
}
207+
accumulate_right <- function(.x, .f, ..., .init) {
208+
f <- function(x, y) .f(y, x, ...)
209+
Reduce(f, .x, init = .init, right = TRUE, accumulate = TRUE)
210+
}
211+
212+
detect <- function(.x, .f, ..., .right = FALSE, .p = is_true) {
213+
.p <- as_function(.p, env = global_env())
214+
.f <- as_function(.f, env = global_env())
215+
216+
for (i in .rlang_purrr_index(.x, .right)) {
217+
if (.p(.f(.x[[i]], ...))) {
218+
return(.x[[i]])
219+
}
220+
}
221+
NULL
222+
}
223+
detect_index <- function(.x, .f, ..., .right = FALSE, .p = is_true) {
224+
.p <- as_function(.p, env = global_env())
225+
.f <- as_function(.f, env = global_env())
226+
227+
for (i in .rlang_purrr_index(.x, .right)) {
228+
if (.p(.f(.x[[i]], ...))) {
229+
return(i)
230+
}
231+
}
232+
0L
233+
}
234+
.rlang_purrr_index <- function(x, right = FALSE) {
235+
idx <- seq_along(x)
236+
if (right) {
237+
idx <- rev(idx)
238+
}
239+
idx
240+
}
241+
242+
list_c <- function(x) {
243+
inject(c(!!!x))
244+
}
245+
246+
# nocov end

‎R/mock.R‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -40,7 +40,7 @@ with_mock <- function(..., .env = topenv()) {
4040
mock_funs <- lapply(dots[!code_pos], eval, parent.frame())
4141
mocks <- extract_mocks(mock_funs, .env = .env)
4242

43-
on.exit(lapply(mocks, reset_mock), add = TRUE)
43+
withr::defer(lapply(mocks, reset_mock))
4444
lapply(mocks, set_mock)
4545

4646
# Evaluate the code
@@ -60,7 +60,7 @@ local_mock <- function(..., .env = topenv(), .local_envir = parent.frame()) {
6060

6161
mocks <- extract_mocks(list(...), .env = .env)
6262
on_exit <- bquote(
63-
on.exit(lapply(.(mocks), .(reset_mock)), add = TRUE),
63+
withr::defer(lapply(.(mocks), .(reset_mock))),
6464
)
6565

6666
lapply(mocks, set_mock)

‎R/parallel-taskq.R‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -99,7 +99,7 @@ task_q <- R6::R6Class(
9999
}
100100
msg
101101
})
102-
results <- results[!vapply(results, is.null, logical(1))]
102+
results <- results[!map_lgl(results, is.null)]
103103

104104
private$schedule()
105105
if (is.finite(timeout)) {

‎R/reporter-debug.R‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -13,7 +13,7 @@ DebugReporter <- R6::R6Class(
1313
if (!expectation_success(result) && !is.null(result$start_frame)) {
1414
if (sink_number() > 0) {
1515
sink(self$out)
16-
on.exit(sink(), add = TRUE)
16+
withr::defer(sink())
1717
}
1818

1919
recover2(
@@ -53,7 +53,7 @@ recover2 <- function(start_frame = 1L, end_frame = sys.nframe()) {
5353

5454
if (.isMethodsDispatchOn()) {
5555
tState <- tracingState(FALSE)
56-
on.exit(tracingState(tState))
56+
withr::defer(tracingState(tState))
5757
}
5858
from <- min(end_frame, length(calls))
5959

‎R/reporter-list.R‎

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -188,10 +188,10 @@ summarize_one_test_results <- function(test) {
188188
nb_tests <- length(test_results)
189189
}
190190

191-
nb_passed <- sum(vapply(test_results, expectation_success, logical(1)))
192-
nb_skipped <- sum(vapply(test_results, expectation_skip, logical(1)))
193-
nb_failed <- sum(vapply(test_results, expectation_failure, logical(1)))
194-
nb_warning <- sum(vapply(test_results, expectation_warning, logical(1)))
191+
nb_passed <- sum(map_lgl(test_results, expectation_success))
192+
nb_skipped <- sum(map_lgl(test_results, expectation_skip))
193+
nb_failed <- sum(map_lgl(test_results, expectation_failure))
194+
nb_warning <- sum(map_lgl(test_results, expectation_warning))
195195
}
196196

197197
context <- if (length(test$context) > 0) test$context else ""

‎R/reporter-progress.R‎

Lines changed: 2 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -306,7 +306,7 @@ ProgressReporter <- R6::R6Class(
306306
self$rule()
307307

308308
issues <- issues$as_list()
309-
summary <- vapply(issues, issue_summary, FUN.VALUE = character(1))
309+
summary <- map_chr(issues, issue_summary)
310310
self$cat_tight(paste(summary, collapse = "\n\n"))
311311

312312
self$cat_line()
@@ -374,12 +374,7 @@ CompactProgressReporter <- R6::R6Class(
374374
self$cat_line()
375375

376376
issues <- self$ctxt_issues$as_list()
377-
summary <- vapply(
378-
issues,
379-
issue_summary,
380-
rule = TRUE,
381-
FUN.VALUE = character(1)
382-
)
377+
summary <- map_chr(issues, issue_summary, rule = TRUE)
383378
self$cat_tight(paste(summary, collapse = "\n\n"))
384379

385380
self$cat_line()

‎R/reporter-stop.R‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -51,7 +51,7 @@ StopReporter <- R6::R6Class(
5151
return()
5252
}
5353

54-
messages <- vapply(failures, issue_summary, rule = TRUE, character(1))
54+
messages <- map_chr(failures, issue_summary, rule = TRUE)
5555
if (length(messages) > 0) {
5656
self$cat_line(messages, "\n")
5757
}

0 commit comments

Comments
 (0)