From 2d3fd81c0e3ed3516f79c3e6f2aea15389b34378 Mon Sep 17 00:00:00 2001
From: Dawid Kaledkowski <dawid.kaledkowski@gmail.com>
Date: Tue, 3 Jun 2025 12:57:25 +0200
Subject: [PATCH 1/5] Improvements (i hope so)

---
 R/qenv-eval_code.R                   | 31 ++++++++++++++++------------
 R/qenv-within.R                      | 13 +++---------
 man/eval_code.Rd                     |  1 +
 tests/testthat/test-qenv_eval_code.R | 21 +++++++++----------
 tests/testthat/test-qenv_within.R    |  5 +++++
 5 files changed, 37 insertions(+), 34 deletions(-)

diff --git a/R/qenv-eval_code.R b/R/qenv-eval_code.R
index 91a89923a..847134f1e 100644
--- a/R/qenv-eval_code.R
+++ b/R/qenv-eval_code.R
@@ -25,12 +25,17 @@
 #' q <- eval_code(q, expression(assert_number(a)))
 #'
 #' @aliases eval_code,qenv-method
+#' @aliases eval_code,qenv.error-method
 #'
 #' @export
-setGeneric("eval_code", function(object, code, cache = FALSE, ...) standardGeneric("eval_code"))
+setGeneric("eval_code", function(object, code, cache = FALSE, callback, ...) standardGeneric("eval_code"))
 
 setMethod("eval_code", signature = c(object = "qenv"), function(object, code, cache = FALSE, ...) {
-  code <- .preprocess_code(code) # preprocess code to ensure it is a character vector
+  if (!is.language(code) && !is.character(code)) {
+    stop("eval_code accepts code being language or character")
+  }
+  code <- .preprocess_code(code)
+  # preprocess code to ensure it is a character vector
   .eval_code(object = object, code = code, cache = cache, ...)
 })
 
@@ -38,6 +43,9 @@ setMethod("eval_code", signature = c(object = "qenv.error"), function(object, co
 
 #' @keywords internal
 .eval_code <- function(object, code, cache = FALSE, ...) {
+  if (identical(code, "")) {
+    return(object)
+  }
   parsed_code <- parse(text = code, keep.source = TRUE)
   object@.xData <- rlang::env_clone(object@.xData, parent = parent.env(.GlobalEnv))
   if (length(parsed_code) == 0) {
@@ -100,17 +108,14 @@ setMethod("eval_code", signature = c(object = "qenv.error"), function(object, co
 }
 
 setGeneric(".preprocess_code", function(code) standardGeneric(".preprocess_code"))
-setMethod(".preprocess_code", signature = c("ANY"), function(code) paste(code, collapse = "\n"))
-setMethod(".preprocess_code", signature = c("language"), function(code) {
-  paste(
-    vapply(lang2calls(code), deparse1, collapse = "\n", character(1L)),
-    collapse = "\n"
-  )
-})
-setMethod(".preprocess_code", signature = c("expression"), function(code) {
-  if (length(attr(code, "wholeSrcref")) == 0L) {
-    paste(lang2calls(code), collapse = "\n")
-  } else {
+setMethod(".preprocess_code", signature = c("character"), function(code) paste(code, collapse = "\n"))
+setMethod(".preprocess_code", signature = c("ANY"), function(code) {
+  if (is.expression(code) && length(attr(code, "wholeSrcref"))) {
     paste(attr(code, "wholeSrcref"), collapse = "\n")
+  } else {
+    paste(
+      vapply(lang2calls(code), deparse1, collapse = "\n", character(1L)),
+      collapse = "\n"
+    )
   }
 })
diff --git a/R/qenv-within.R b/R/qenv-within.R
index ef68da14b..739464a1c 100644
--- a/R/qenv-within.R
+++ b/R/qenv-within.R
@@ -48,20 +48,13 @@
 #' @export
 #'
 within.qenv <- function(data, expr, ...) {
-  expr <- substitute(expr)
+  expr <- as.expression(substitute(expr))
   extras <- list(...)
 
-  # Add braces for consistency.
-  if (!identical(as.list(expr)[[1L]], as.symbol("{"))) {
-    expr <- call("{", expr)
-  }
-
-  calls <- as.list(expr)[-1]
-
   # Inject extra values into expressions.
-  calls <- lapply(calls, function(x) do.call(substitute, list(x, env = extras)))
+  calls <- lapply(expr, function(x) do.call(substitute, list(x, env = extras)))
 
-  eval_code(object = data, code = as.expression(calls))
+  eval_code(object = data, code = as.expression(calls), ...)
 }
 
 
diff --git a/man/eval_code.Rd b/man/eval_code.Rd
index 347fe0047..8c697e40f 100644
--- a/man/eval_code.Rd
+++ b/man/eval_code.Rd
@@ -3,6 +3,7 @@
 \name{eval_code}
 \alias{eval_code}
 \alias{eval_code,qenv-method}
+\alias{eval_code,qenv.error-method}
 \alias{within.qenv}
 \title{Evaluate code in \code{qenv}}
 \usage{
diff --git a/tests/testthat/test-qenv_eval_code.R b/tests/testthat/test-qenv_eval_code.R
index 689ee170b..b16ddbdf6 100644
--- a/tests/testthat/test-qenv_eval_code.R
+++ b/tests/testthat/test-qenv_eval_code.R
@@ -45,6 +45,11 @@ testthat::test_that("eval_code works with expression", {
   testthat::expect_equal(q1, list2env(list(a = 1, b = 2)))
 })
 
+testthat::test_that("eval_code ignores empty code", {
+  q <- qenv()
+  testthat::expect_identical(q, eval_code(q, ""))
+})
+
 testthat::test_that("eval_code preserves original formatting when `srcref` is present in the expression", {
   code <- "# comment
   a <- 1L"
@@ -77,12 +82,11 @@ testthat::test_that("eval_code works with quoted code block", {
   testthat::expect_equal(q1, list2env(list(a = 1, b = 2)))
 })
 
-testthat::test_that("eval_code fails with unquoted expression", {
-  b <- 3
-  testthat::expect_error(
-    eval_code(qenv(), a <- b),
-    "unable to find an inherited method for function .eval_code. for signature"
-  )
+testthat::test_that("eval_code fails with code not being language nor character", {
+  msg <- "eval_code accepts code being language or character"
+  testthat::expect_error(eval_code(qenv(), NULL), msg)
+  testthat::expect_error(eval_code(qenv(), 1), msg)
+  testthat::expect_error(eval_code(qenv(), list()), msg)
 })
 
 testthat::test_that("an error when calling eval_code returns a qenv.error object which has message and trace", {
@@ -182,8 +186,3 @@ testthat::test_that("comments passed alone to eval_code that contain @linksto ta
     "x"
   )
 })
-
-testthat::test_that("Code executed with integer shorthand (1L) is the same as original", {
-  q <- within(qenv(), a <- 1L)
-  testthat::expect_identical(get_code(q), "a <- 1L")
-})
diff --git a/tests/testthat/test-qenv_within.R b/tests/testthat/test-qenv_within.R
index 9853b4608..14a311a38 100644
--- a/tests/testthat/test-qenv_within.R
+++ b/tests/testthat/test-qenv_within.R
@@ -149,3 +149,8 @@ testthat::describe("within run with `=`", {
     testthat::expect_equal(q$i, 1)
   })
 })
+
+testthat::test_that("Code executed with integer shorthand (1L) is the same as original", {
+  q <- within(qenv(), a <- 1L)
+  testthat::expect_identical(get_code(q), "a <- 1L")
+})

From ab512920099b73b9334655cae0589a8c6a449810 Mon Sep 17 00:00:00 2001
From: Dawid Kaledkowski <dawid.kaledkowski@gmail.com>
Date: Tue, 3 Jun 2025 13:00:03 +0200
Subject: [PATCH 2/5] no callback (sorry)

---
 R/qenv-eval_code.R | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/R/qenv-eval_code.R b/R/qenv-eval_code.R
index 847134f1e..e53b2cf23 100644
--- a/R/qenv-eval_code.R
+++ b/R/qenv-eval_code.R
@@ -28,7 +28,7 @@
 #' @aliases eval_code,qenv.error-method
 #'
 #' @export
-setGeneric("eval_code", function(object, code, cache = FALSE, callback, ...) standardGeneric("eval_code"))
+setGeneric("eval_code", function(object, code, cache = FALSE, ...) standardGeneric("eval_code"))
 
 setMethod("eval_code", signature = c(object = "qenv"), function(object, code, cache = FALSE, ...) {
   if (!is.language(code) && !is.character(code)) {

From f491c9c1409e07d294672db5318fa304095e4980 Mon Sep 17 00:00:00 2001
From: Dawid Kaledkowski <dawid.kaledkowski@gmail.com>
Date: Tue, 3 Jun 2025 19:23:33 +0200
Subject: [PATCH 3/5] suggestion

---
 R/qenv-within.R | 6 ++++--
 1 file changed, 4 insertions(+), 2 deletions(-)

diff --git a/R/qenv-within.R b/R/qenv-within.R
index 739464a1c..48409fe71 100644
--- a/R/qenv-within.R
+++ b/R/qenv-within.R
@@ -53,8 +53,10 @@ within.qenv <- function(data, expr, ...) {
 
   # Inject extra values into expressions.
   calls <- lapply(expr, function(x) do.call(substitute, list(x, env = extras)))
-
-  eval_code(object = data, code = as.expression(calls), ...)
+  do.call(
+    eval_code,
+    modifyList(list(...), list(object = data, code = as.expression(calls)))
+  )
 }
 
 

From 15f2f8e5c073b201395d2de3a2f98430e41f9e35 Mon Sep 17 00:00:00 2001
From: Dawid Kaledkowski <dawid.kaledkowski@gmail.com>
Date: Tue, 3 Jun 2025 19:28:46 +0200
Subject: [PATCH 4/5] reuse existing

---
 R/qenv-within.R | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/R/qenv-within.R b/R/qenv-within.R
index 48409fe71..edcc0bb9a 100644
--- a/R/qenv-within.R
+++ b/R/qenv-within.R
@@ -55,7 +55,7 @@ within.qenv <- function(data, expr, ...) {
   calls <- lapply(expr, function(x) do.call(substitute, list(x, env = extras)))
   do.call(
     eval_code,
-    modifyList(list(...), list(object = data, code = as.expression(calls)))
+    modifyList(extras, list(object = data, code = as.expression(calls)))
   )
 }
 

From e5d78bc2e84820b00d6ad2b3a1d04b864ae03159 Mon Sep 17 00:00:00 2001
From: Dawid Kaledkowski <dawid.kaledkowski@gmail.com>
Date: Wed, 4 Jun 2025 09:11:54 +0200
Subject: [PATCH 5/5] fix checks (prefix modifyList)

---
 R/qenv-within.R | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/R/qenv-within.R b/R/qenv-within.R
index edcc0bb9a..33b8ebdcd 100644
--- a/R/qenv-within.R
+++ b/R/qenv-within.R
@@ -55,7 +55,7 @@ within.qenv <- function(data, expr, ...) {
   calls <- lapply(expr, function(x) do.call(substitute, list(x, env = extras)))
   do.call(
     eval_code,
-    modifyList(extras, list(object = data, code = as.expression(calls)))
+    utils::modifyList(extras, list(object = data, code = as.expression(calls)))
   )
 }
 
