Fixes integer shorthand regression

R/qenv-eval_code.R

@@ -5,7 +5,9 @@
 #' Thus, if the `qenv` had been instantiated empty, contents of the environment are always a result of the stored code.
 #'
 #' @param object (`qenv`)
-#' @param code (`character` or `language`) code to evaluate. If `character`, comments are retained.
+#' @param code (`character`, `language` or `expression`) code to evaluate.
+#' It is possible to preserve original formatting of the `code` by providing a `character` or an
+#' `expression` being a result of `parse(keep.source = TRUE)`.
 #'
 #' @return
 #' `eval_code` returns a `qenv` object with `expr` evaluated or `qenv.error` if evaluation fails.
@@ -14,6 +16,7 @@
 #' # evaluate code in qenv
 #' q <- qenv()
 #' q <- eval_code(q, "a <- 1")
+#' q <- eval_code(q, "b <- 2L # with comment")
 #' q <- eval_code(q, quote(library(checkmate)))
 #' q <- eval_code(q, expression(assert_number(a)))
 #'
@@ -100,7 +103,7 @@ setMethod("eval_code", signature = c("qenv", "expression"), function(object, cod
   if (length(srcref)) {
     eval_code(object, code = paste(attr(code, "wholeSrcref"), collapse = "\n"))
   } else {
-    eval_code(object, code = paste(lang2calls(code), collapse = "\n"))
+    Reduce(eval_code, init = object, x = code)
   }
 })
 

tests/testthat/test-qenv_eval_code.R

@@ -1,13 +1,13 @@
 testthat::test_that("eval_code evaluates the code in the qenvs environment", {
   q <- qenv()
-  q1 <- eval_code(q, quote(iris1 <- iris))
-  q2 <- eval_code(q1, quote(b <- nrow(iris1)))
-  testthat::expect_identical(q2$b, 150L)
+  q1 <- eval_code(q, quote(a <- 1L))
+  q2 <- eval_code(q1, quote(b <- 1))
+  testthat::expect_equal(q2, list2env(list(a = 1L, b = 1)))
 })
 
 testthat::test_that("eval_code locks the environment", {
   q <- eval_code(qenv(), quote(iris1 <- iris))
-  testthat::expect_true(environmentIsLocked(q@.xData))
+  testthat::expect_true(environmentIsLocked(q))
 })
 
 testthat::test_that("eval_code doesn't have access to environment where it's called", {
@@ -36,21 +36,29 @@ testthat::test_that("getting object from the package namespace works even if lib
 testthat::test_that("eval_code works with character", {
   q1 <- eval_code(qenv(), "a <- 1")
   testthat::expect_identical(get_code(q1), "a <- 1")
-  testthat::expect_equal(q1@.xData, list2env(list(a = 1)))
+  testthat::expect_equal(q1, list2env(list(a = 1)))
 })
 
 testthat::test_that("eval_code works with expression", {
-  q1 <- eval_code(qenv(), as.expression(quote(a <- 1)))
+  q1 <- eval_code(qenv(), expression(a <- 1, b <- 2))
+  testthat::expect_identical(get_code(q1), "a <- 1\nb <- 2")
+  testthat::expect_equal(q1, list2env(list(a = 1, b = 2)))
+})
 
-  testthat::expect_identical(get_code(q1), "a <- 1")
-  testthat::expect_equal([email protected], list2env(list(a = 1)))
+testthat::test_that("eval_code preserves original formatting when `srcref` is present in the expression", {
+  code <- "# comment
+  a <- 1L"
+  expr <- parse(text = code, keep.source = TRUE)
+  q1 <- eval_code(qenv(), expr)
+  testthat::expect_identical(get_code(q1), code)
+  testthat::expect_equal(q1, list2env(list(a = 1L)))
 })
 
 testthat::test_that("eval_code works with quoted", {
   q1 <- eval_code(qenv(), quote(a <- 1))
 
   testthat::expect_identical(get_code(q1), "a <- 1")
-  testthat::expect_equal(q1@.xData, list2env(list(a = 1)))
+  testthat::expect_equal(q1, list2env(list(a = 1)))
 })
 
 testthat::test_that("eval_code works with quoted code block", {
@@ -66,7 +74,7 @@ testthat::test_that("eval_code works with quoted code block", {
     get_code(q1),
     c("a <- 1\nb <- 2")
   )
-  testthat::expect_equal(q1@.xData, list2env(list(a = 1, b = 2)))
+  testthat::expect_equal(q1, list2env(list(a = 1, b = 2)))
 })
 
 testthat::test_that("eval_code fails with unquoted expression", {
@@ -172,3 +180,8 @@ 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")
+})

tests/testthat/test-qenv_within.R

@@ -64,10 +64,17 @@ testthat::test_that("styling of input code does not impact evaluation results",
 
 
 # return value ----
-testthat::test_that("within.qenv renturns a `qenv` where `@.xData` is a deep copy of that in `data`", {
+testthat::test_that("within.qenv empty call doesn't change qenv object", {
   q <- qenv()
   q <- within(qenv(), i <- iris)
   qq <- within(q, {})
+  testthat::expect_identical(q, qq)
+})
+
+testthat::test_that("within.qenv renturns a `qenv` where `@.xData` is a deep copy of that in `data`", {
+  q <- qenv()
+  q <- within(qenv(), i <- iris)
+  qq <- within(q, i)
   testthat::expect_equal([email protected], [email protected])
   testthat::expect_false(identical([email protected], [email protected]))
 })