fix: problems with check

Author: averissimo

DESCRIPTION

@@ -53,6 +53,7 @@ Language: en-US
 Roxygen: list(markdown = TRUE)
 RoxygenNote: 7.3.2
 Collate:
+    'qenv-c.R'
     'qenv-class.R'
     'qenv-errors.R'
     'qenv-concat.R'

R/qenv-c.R

@@ -0,0 +1,93 @@
+#' If two `qenv` can be joined
+#'
+#' Checks if two `qenv` objects can be combined.
+#' For more information, please see [`join`]
+#' @param x (`qenv`)
+#' @param y (`qenv`)
+#' @return `TRUE` if able to join or `character` used to print error message.
+#' @keywords internal
+.check_joinable <- function(x, y) {
+  checkmate::assert_class(x, "qenv")
+  checkmate::assert_class(y, "qenv")
+
+  common_names <- intersect(rlang::env_names(x@.xData), rlang::env_names(y@.xData))
+  is_overwritten <- vapply(common_names, function(el) {
+    !identical(get(el, x@.xData), get(el, y@.xData))
+  }, logical(1))
+  if (any(is_overwritten)) {
+    return(
+      paste(
+        "Not possible to join qenv objects if anything in their environment has been modified.\n",
+        "Following object(s) have been modified:\n - ",
+        paste(common_names[is_overwritten], collapse = "\n - ")
+      )
+    )
+  }
+
+  shared_ids <- intersect(x@id, y@id)
+  if (length(shared_ids) == 0) {
+    return(TRUE)
+  }
+
+  shared_in_x <- match(shared_ids, x@id)
+  shared_in_y <- match(shared_ids, y@id)
+
+  # indices of shared ids should be 1:n in both slots
+  if (identical(shared_in_x, shared_in_y) && identical(shared_in_x, seq_along(shared_ids))) {
+    TRUE
+  } else if (!identical(shared_in_x, shared_in_y)) {
+    paste(
+      "The common shared code of the qenvs does not occur in the same position in both qenv objects",
+      "so they cannot be joined together as it's impossible to determine the evaluation's order.",
+      collapse = ""
+    )
+  } else {
+    paste(
+      "There is code in the qenv objects before their common shared code",
+      "which means these objects cannot be joined.",
+      collapse = ""
+    )
+  }
+}
+
+#' @export
+c.qenv.error <- function(...) {
+  rlang::list2(...)[[1]]
+}
+
+#' @export
+c.qenv <- function(...) {
+  dots <- rlang::list2(...)
+  if (!checkmate::test_list(dots[-1], types = c("qenv", "qenv.error"))) {
+    return(NextMethod(c, dots[[1]]))
+  }
+
+  first_non_qenv_ix <- which.min(vapply(dots, inherits, what = "qenv", logical(1)))
+  if (first_non_qenv_ix > 1) {
+    return(dots[[first_non_qenv_ix]])
+  }
+
+  Reduce(
+    x = dots[-1],
+    init = dots[[1]],
+    f = function(x, y) {
+      join_validation <- .check_joinable(x, y)
+
+      # join expressions
+      if (!isTRUE(join_validation)) {
+        stop(join_validation)
+      }
+
+      id_unique <- !y@id %in% x@id
+      x@id <- c(x@id, y@id[id_unique])
+      x@code <- c(x@code, y@code[id_unique])
+      x@warnings <- c(x@warnings, y@warnings[id_unique])
+      x@messages <- c(x@messages, y@messages[id_unique])
+
+      # insert (and overwrite) objects from y to x
+      x@.xData <- rlang::env_clone(x@.xData, parent = parent.env(.GlobalEnv))
+      rlang::env_coalesce(env = x@.xData, from = y@.xData)
+      x
+    }
+  )
+}

R/qenv-constructor.R

@@ -12,7 +12,7 @@
 #'
 #' @name qenv
 #'
-#' @return Returns a `qenv` object.
+#' @return `qenv` returns a `qenv` object.
 #'
 #' @seealso [`base::within()`], [`get_var()`], [`get_env()`], [`get_warnings()`], [`join()`], [`concat()`]
 #' @examples

R/qenv-get_code.R

@@ -1,20 +1,11 @@
 #' @name qenv-inheritted
 #' @rdname qenv
 #'
-#' @param x (`qenv`) object.
-#' @param name (`character`) name of object.
-#' @param pos,envir,all.names,pattern,sorted see [ls()] function for details.
-#'
-#' @usage x[[name]]
-#' x$name
-#' names(x)
-#' ls(name, pos = -1L, envir = as.environment(pos),
-#'    all.names = FALSE, pattern, sorted = TRUE)
-#'
 #' @details
+#'
 #' `x[[name]]`, `x$name` and `get(name, x)` are generic \R operators to access the objects in the environment.
 #' See [`[[`] for more details.
-#' `names(x)` and `ls(x)` calls on the `qenv` object and will list all objects in the environment.
+#' `names(x)` calls on the `qenv` object and will list all objects in the environment.
 #'
 #' @return `[[`, `$` and `get` return the value of the object named `name` in the `qenv` object.
 #' @return `names` return a character vector of all the names of the objects in the `qenv` object.
@@ -31,7 +22,6 @@
 #' names(q)
 NULL
 
-
 #' Get code from `qenv`
 #'
 #' @details

R/qenv-get_var.R

@@ -46,10 +46,7 @@ setMethod("get_var", signature = c("qenv.error", "ANY"), function(object, var) {
   ))
 })
 
-setMethod("[[", signature = c("qenv", "ANY"), function(x, i) {
-  get_var(x, i)
-})
-
+#' @rdname get_var
 #' @export
 `[[.qenv.error` <- function(x, i) {
   stop(errorCondition(

R/qenv-join.R

@@ -153,97 +153,3 @@ setMethod("join", signature = c("qenv.error", "ANY"), function(x, y) {
   lifecycle::deprecate_soft("0.5.1", "join()", "c()")
   x
 })
-
-#' If two `qenv` can be joined
-#'
-#' Checks if two `qenv` objects can be combined.
-#' For more information, please see [`join`]
-#' @param x (`qenv`)
-#' @param y (`qenv`)
-#' @return `TRUE` if able to join or `character` used to print error message.
-#' @keywords internal
-.check_joinable <- function(x, y) {
-  checkmate::assert_class(x, "qenv")
-  checkmate::assert_class(y, "qenv")
-
-  common_names <- intersect(rlang::env_names(x@.xData), rlang::env_names(y@.xData))
-  is_overwritten <- vapply(common_names, function(el) {
-    !identical(get(el, x@.xData), get(el, y@.xData))
-  }, logical(1))
-  if (any(is_overwritten)) {
-    return(
-      paste(
-        "Not possible to join qenv objects if anything in their environment has been modified.\n",
-        "Following object(s) have been modified:\n - ",
-        paste(common_names[is_overwritten], collapse = "\n - ")
-      )
-    )
-  }
-
-  shared_ids <- intersect(x@id, y@id)
-  if (length(shared_ids) == 0) {
-    return(TRUE)
-  }
-
-  shared_in_x <- match(shared_ids, x@id)
-  shared_in_y <- match(shared_ids, y@id)
-
-  # indices of shared ids should be 1:n in both slots
-  if (identical(shared_in_x, shared_in_y) && identical(shared_in_x, seq_along(shared_ids))) {
-    TRUE
-  } else if (!identical(shared_in_x, shared_in_y)) {
-    paste(
-      "The common shared code of the qenvs does not occur in the same position in both qenv objects",
-      "so they cannot be joined together as it's impossible to determine the evaluation's order.",
-      collapse = ""
-    )
-  } else {
-    paste(
-      "There is code in the qenv objects before their common shared code",
-      "which means these objects cannot be joined.",
-      collapse = ""
-    )
-  }
-}
-
-#' @export
-c.qenv.error <- function(...) {
-  rlang::list2(...)[[1]]
-}
-
-#' @export
-c.qenv <- function(...) {
-  dots <- rlang::list2(...)
-  if (!checkmate::test_list(dots[-1], types = c("qenv", "qenv.error"))) {
-    return(NextMethod(c, dots[[1]]))
-  }
-
-  first_non_qenv_ix <- which.min(vapply(dots, inherits, what = "qenv", logical(1)))
-  if (first_non_qenv_ix > 1) {
-    return(dots[[first_non_qenv_ix]])
-  }
-
-  Reduce(
-    x = dots[-1],
-    init = dots[[1]],
-    f = function(x, y) {
-      join_validation <- .check_joinable(x, y)
-
-      # join expressions
-      if (!isTRUE(join_validation)) {
-        stop(join_validation)
-      }
-
-      id_unique <- !y@id %in% x@id
-      x@id <- c(x@id, y@id[id_unique])
-      x@code <- c(x@code, y@code[id_unique])
-      x@warnings <- c(x@warnings, y@warnings[id_unique])
-      x@messages <- c(x@messages, y@messages[id_unique])
-
-      # insert (and overwrite) objects from y to x
-      x@.xData <- rlang::env_clone(x@.xData, parent = parent.env(.GlobalEnv))
-      rlang::env_coalesce(env = x@.xData, from = y@.xData)
-      x
-    }
-  )
-}

man/dot-check_joinable.Rd

@@ -16,6 +16,7 @@ testthat::test_that("get_var, `$` and `[[` return object from qenv environment",
   testthat::expect_equal(q$x, 1)
 })
 
+
 testthat::test_that("get_var, `$` and `[[` return NULL if object not in qenv environment", {
   q <- eval_code(qenv(), quote(x <- 1))
   q <- eval_code(q, quote(y <- 5 * x))
@@ -24,7 +25,6 @@ testthat::test_that("get_var, `$` and `[[` return NULL if object not in qenv env
   testthat::expect_message(get_var(q, "z"), "object 'z' not found")
 
   testthat::expect_null(q[["w"]])
-  testthat::expect_message(q[["w"]], "object 'w' not found")
   testthat::expect_null(q$w)
 })