diff --git a/R/utils.R b/R/utils.R index 563252659..05e86c6e1 100644 --- a/R/utils.R +++ b/R/utils.R @@ -1056,14 +1056,16 @@ need <- function(expr, message = paste(label, "must be provided"), label) { #' #' @export req <- function(...) { - dots <- eval(substitute(alist(...))) + first <- NULL dotloop(function(item) { if (!isTruthy(item)) stopWithCondition("validation", "") + if (is.null(first)) + first <<- list(item) }, ...) - if (!missing(..1)) - ..1 + if (!is.null(first)) + first[[1]] else invisible() } @@ -1073,10 +1075,10 @@ req <- function(...) { # is discarded, and only invisible() is returned from dotloop. # # Can be used to facilitate short-circuit eval on dots. -dotloop <- function(fun_, ..., env_ = parent.frame(1)) { +dotloop <- function(fun_, ...) { dots <- eval(substitute(alist(...))) - for (qexpr in dots) { - fun_(eval(qexpr, env_)) + for (i in seq_along(dots)) { + fun_(eval(as.symbol(paste0("..", i)), environment())) } invisible() } diff --git a/inst/tests/test-utils.R b/inst/tests/test-utils.R index 7f27a08d3..73c10ca1c 100644 --- a/inst/tests/test-utils.R +++ b/inst/tests/test-utils.R @@ -98,6 +98,19 @@ test_that("req works", { value <- 0 expect_error(req(NULL, value <- 1)) expect_equal(value, 0) + + # first argument is evaluated exactly once + value <- 0 + req(value <- value + 1) + expect_equal(value, 1) + + # correct environment is used + req2 <- function(...) { + req(...) + } + value <- 0 + req2(value <- value + 1) + expect_equal(value, 1) }) test_that("anyUnnamed works as expected", {