feat: qenv constructor improvement

Author: averissimo

R/qenv-class.R

@@ -28,14 +28,43 @@ setClass(
 setMethod(
   "initialize",
   "qenv",
-  function(.Object, .xData = new.env(parent = parent.env(.GlobalEnv)), ...) { # nolint: object_name.
-    # .xData needs to be unnamed as the `.environment` constructure requires 1
-    # unnamed formal argument. See methods::findMethods("initialize")$.environment
-    .Object <- methods::callNextMethod(.Object, .xData, ...) # nolint: object_name.
+  function(.Object, # nolint: object_name.
+           .xData, # nolint: object_name.
+           code = character(0L),
+           warnings = rep("", length(code)),
+           messages = rep("", length(code)),
+           id = integer(0L),
+           ...) {
+    # # Pre-process parameters to ensure they are ready to be used by parent constructors
+    stopifnot("`code` must be a character or language object." = any(is.language(code), is.character(code)))
 
-    checkmate::assert_environment(.xData)
-    lockEnvironment(.xData, bindings = TRUE)
-    .Object@.xData <- .xData # nolint: object_name.
+    if (is.language(code)) {
+      code <- paste(lang2calls(code), collapse = "\n")
+    }
+    if (length(code)) {
+      code <- paste(code, collapse = "\n")
+    }
+
+    if (length(id) == 0L) {
+      id <- sample.int(.Machine$integer.max, size = length(code))
+    }
+
+    new_xdata <- if (rlang::is_missing(.xData)) {
+      new.env(parent = parent.env(.GlobalEnv))
+    } else {
+      checkmate::assert_environment(.xData)
+      rlang::env_clone(.xData, parent = parent.env(.GlobalEnv))
+    }
+    lockEnvironment(new_xdata, bindings = TRUE)
+
+    # .xData needs to be unnamed as the `.environment` constructor allows at
+    # most 1 unnamed formal argument of class `environment`.
+    # See methods::findMethods("initialize")$.environment
+    .Object <- methods::callNextMethod( # nolint: object_name.
+      # Mandatory use of `xData` to build a correct [email protected]
+      .Object, new_xdata,
+      code = code, messages = messages, warnings = warnings, id = id, ...
+    )
 
     .Object
   }

tests/testthat/test-qenv-class.R

@@ -17,4 +17,8 @@ testthat::describe("methods::new(qenv)", {
   testthat::it("throws error when .xData is not an environment", {
     expect_error(methods::new("qenv", .xData = 2), "Must be an environment, not 'double'\\.")
   })
+
+  testthat::it("throws error when code is not language or character object", {
+    expect_error(methods::new("qenv", code = 2), "`code` must be a character or language object\\.")
+  })
 })

tests/testthat/test-qenv_eval_code.R

@@ -2,7 +2,7 @@ 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(get_var(q2, "b"), 150L)
+  testthat::expect_identical(q2$b, 150L)
 })
 
 testthat::test_that("eval_code doesn't have access to environment where it's called", {

tests/testthat/test-qenv_join.R

@@ -85,15 +85,15 @@ testthat::test_that("Not possible to join qenvs which share some code when one o
   q1 <- eval_code(q1, quote(iris2 <- iris))
   q2 <- eval_code(q2, quote(mtcars1 <- head(mtcars)))
 
-  testthat::expect_error(join(q1, q2))
+  testthat::expect_error(c(q1, q2))
 })
 
 testthat::test_that("qenv objects are mergeable if they don't share any code (identified by id)", {
   q1 <- eval_code(qenv(), code = quote(a1 <- 1))
   q2 <- eval_code(qenv(), code = quote(a1 <- 1))
   testthat::expect_true(.check_joinable(q1, q2))
 
-  cq <- join(q1, q2)
+  cq <- c(q1, q2)
   testthat::expect_s4_class(cq, "qenv")
   testthat::expect_equal(cq@.xData, list2env(list(a1 = 1)))
   testthat::expect_identical(cq@code, c("a1 <- 1", "a1 <- 1"))