- single evaluate::evaluate

- mask environment for qenv
- remove semicolon from the code

Author: gogonzo

R/qenv-class.R

@@ -31,11 +31,19 @@ setMethod(
   "initialize",
   "qenv",
   function(.Object, .xData, code = list(), ...) { # nolint: object_name.
+    mask_env <- new.env(parent = parent.env(.GlobalEnv))
+    mask_env$library <- function(...) {
+      x <- library(...)
+      if (!identical(parent.env(mask_env), parent.env(.GlobalEnv))) {
+        parent.env(mask_env) <- parent.env(.GlobalEnv)
+      }
+      invisible(x)
+    }
     new_xdata <- if (rlang::is_missing(.xData)) {
-      new.env(parent = parent.env(.GlobalEnv))
+      new.env(parent = mask_env)
     } else {
       checkmate::assert_environment(.xData)
-      rlang::env_clone(.xData, parent = parent.env(.GlobalEnv))
+      rlang::env_clone(.xData, parent = mask_env)
     }
     lockEnvironment(new_xdata, bindings = TRUE)
 

R/qenv-eval_code.R

@@ -44,56 +44,45 @@ setMethod("eval_code", signature = c(object = "qenv.error"), function(object, co
   if (identical(trimws(code), "") || length(code) == 0) {
     return(object)
   }
+  code <- paste(split_code(code), collapse = "\n")
+
+  object@.xData <- rlang::env_clone(object@.xData, parent = parent.env(object@.xData))
   parsed_code <- parse(text = code, keep.source = TRUE)
-  object@.xData <- rlang::env_clone(object@.xData, parent = parent.env(.GlobalEnv))
-  if (length(parsed_code) == 0) {
-    # empty code, or just comments
-    attr(code, "dependency") <- extract_dependency(parsed_code) # in case comment contains @linksto tag
-    object@code <- c(object@code, stats::setNames(list(code), sample.int(.Machine$integer.max, size = 1)))
-    return(object)
-  }
-  code_split <- split_code(paste(code, collapse = "\n"))
 
-  for (i in seq_along(code_split)) {
-    current_code <- code_split[[i]]
-    current_call <- parse(text = current_code, keep.source = TRUE)
-    x <- evaluate::evaluate(
-      current_code,
-      envir = object@.xData,
-      stop_on_error = 1,
-      output_handler = evaluate::new_output_handler(value = identity)
-    )
+  out <- evaluate::evaluate(
+    code,
+    envir = object@.xData,
+    stop_on_error = 1,
+    output_handler = evaluate::new_output_handler(value = identity)
+  )
 
-    e <- Filter(function(e) inherits(e, "error"), x)
-    if (length(e)) {
-      return(
-        errorCondition(
-          message = sprintf(
-            "%s \n when evaluating qenv code:\n%s",
-            cli::ansi_strip(conditionMessage(e[[1]])),
-            current_code
-          ),
-          class = c("qenv.error", "try-error", "simpleError"),
-          trace = unlist(c(object@code, list(current_code)))
+  new_code <- list()
+  for (this in out) {
+    if (inherits(this, "source")) {
+      this_code <- gsub("\n$", "", this$src)
+      attr(this_code, "dependency") <- extract_dependency(parse(text = this_code))
+      new_code <- c(new_code, stats::setNames(list(this_code), sample.int(.Machine$integer.max, size = 1)))
+    } else {
+      last_code <- new_code[[length(new_code)]]
+      if (inherits(this, "error")) {
+        return(
+          errorCondition(
+            message = sprintf(
+              "%s \n when evaluating qenv code:\n%s",
+              cli::ansi_strip(conditionMessage(this)),
+              last_code
+            ),
+            class = c("qenv.error", "try-error", "simpleError"),
+            trace = unlist(c(object@code, list(new_code)))
+          )
         )
-      )
+      }
+      attr(last_code, "outputs") <- c(attr(last_code, "outputs"), list(this))
+      new_code[[length(new_code)]] <- last_code
     }
-    if (!identical(parent.env(object@.xData), parent.env(.GlobalEnv))) {
-      # needed to make sure that @.xData is always a sibling of .GlobalEnv
-      # could be changed when any new package is added to search path (through library or require call)
-      parent.env(object@.xData) <- parent.env(.GlobalEnv)
-    }
-
-    attributes(current_code) <- Filter(
-      length,
-      list(
-        dependency = extract_dependency(current_call),
-        outputs = x[-1]
-      )
-    )
-    object@code <- c(object@code, stats::setNames(list(current_code), sample.int(.Machine$integer.max, size = 1)))
   }
 
+  object@code <- c(object@code, new_code)
   lockEnvironment(object@.xData, bindings = TRUE)
   object
 }