From c1c3fa4d3afdbf6ae472c27ee46771c584f8f60d Mon Sep 17 00:00:00 2001
From: Joe Cheng <joe@rstudio.com>
Date: Thu, 17 Dec 2015 11:13:33 -0800
Subject: [PATCH] Fix a couple of req edge cases

---
 R/utils.R               | 14 ++++++++------
 inst/tests/test-utils.R | 13 +++++++++++++
 2 files changed, 21 insertions(+), 6 deletions(-)

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", {