From 99ebe965aeb362af80da2ea66b1c19a1e66bf258 Mon Sep 17 00:00:00 2001
From: m7pr <marcin.kosinski.mk1@roche.com>
Date: Wed, 23 Oct 2024 12:11:26 +0200
Subject: [PATCH 01/98] proposition of the implementation

---
 DESCRIPTION     |  1 +
 NAMESPACE       |  1 +
 R/qenv-subset.R | 52 +++++++++++++++++++++++++++++++++++++++++++++++++
 man/qenv.Rd     | 18 ++++++++++++++---
 4 files changed, 69 insertions(+), 3 deletions(-)
 create mode 100644 R/qenv-subset.R

diff --git a/DESCRIPTION b/DESCRIPTION
index cfa144a2..e998f4ec 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -64,6 +64,7 @@ Collate:
     'qenv-get_warnings.R'
     'qenv-join.R'
     'qenv-show.R'
+    'qenv-subset.R'
     'qenv-within.R'
     'teal.code-package.R'
     'utils-get_code_dependency.R'
diff --git a/NAMESPACE b/NAMESPACE
index e2d189a6..d6472510 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -13,6 +13,7 @@ export(get_warnings)
 export(join)
 export(new_qenv)
 export(qenv)
+export(subset)
 exportClasses(qenv)
 exportMethods(show)
 importFrom(lifecycle,badge)
diff --git a/R/qenv-subset.R b/R/qenv-subset.R
new file mode 100644
index 00000000..be2d426b
--- /dev/null
+++ b/R/qenv-subset.R
@@ -0,0 +1,52 @@
+#' Subset `qenv`
+#'
+#' @details
+#' Subset objects in `qenv` environment and limit the code to the necessary to build limited objects.
+#'
+#' @param object (`qenv`)
+#' @param names (`character`) names of objects included in `qenv` to subset
+#'
+#' @return
+#' `qenv` object
+#'
+#' @examples
+#' q <- qenv()
+#' q <- eval_code(q, "a <- 1;b<-2")
+#' q <- subset(q, "a")
+#'
+#' @name subset
+#' @rdname qenv
+#' @aliases subset,qenv-method
+#' @aliases subset,qenv.error,ANY-method
+#'
+#' @export
+setGeneric("subset", function(object, names) standardGeneric("subset"))
+
+setMethod("subset", signature = c("qenv"), function(object, names) {
+  # based on https://github.com/insightsengineering/teal/blob/a1087d2d3ff0c62393c3d5277cd5f184d543e2d9/R/teal_data_utils.R#L41-L64
+  checkmate::assert_class(names, "character")
+  names_in_env <- intersect(names, ls(get_env(object)))
+  if (!length(names_in_env)) {
+    return(qenv())
+  }
+
+  new_qenv <- qenv()
+  new_qenv@env <- list2env(mget(x = names_in_env, envir = get_env(object)))
+  new_qenv@code <- get_code(object, names = names_in_env)
+  # Question: what about @id, @warnings, @messages?
+  # Currently:
+  # > new_qenv@id
+  # integer(0)
+  # > new_qenv@warnings
+  # character(0)
+  # > new_qenv@messages
+  # character(0)
+  new_qenv
+
+})
+
+
+setMethod("subset", signature = c("qenv.error", "ANY"), function(object, names) {
+  object
+})
+
diff --git a/man/qenv.Rd b/man/qenv.Rd
index 4d382246..84ad3305 100644
--- a/man/qenv.Rd
+++ b/man/qenv.Rd
@@ -1,6 +1,6 @@
 % Generated by roxygen2: do not edit by hand
 % Please edit documentation in R/qenv-constructor.R, R/qenv-eval_code.R,
-%   R/qenv-get_code.R, R/qenv-within.R
+%   R/qenv-get_code.R, R/qenv-subset.R, R/qenv-within.R
 \name{qenv}
 \alias{qenv}
 \alias{new_qenv}
@@ -17,6 +17,9 @@
 \alias{get_code}
 \alias{get_code,qenv-method}
 \alias{get_code,qenv.error-method}
+\alias{subset}
+\alias{subset,qenv-method}
+\alias{subset,qenv.error,ANY-method}
 \alias{within.qenv}
 \title{Code tracking with \code{qenv} object}
 \usage{
@@ -28,6 +31,8 @@ eval_code(object, code)
 
 get_code(object, deparse = TRUE, names = NULL, ...)
 
+subset(object, names)
+
 \method{within}{qenv}(data, expr, ...)
 }
 \arguments{
@@ -40,8 +45,7 @@ Environment being a result of the \code{code} evaluation.}
 
 \item{deparse}{(\code{logical(1)}) flag specifying whether to return code as \code{character} or \code{expression}.}
 
-\item{names}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} (\code{character}) vector of object names to return the code for.
-For more details see the "Extracting dataset-specific code" section.}
+\item{names}{(\code{character}) names of objects included in \code{qenv} to subset}
 
 \item{...}{see \code{Details}}
 
@@ -56,6 +60,8 @@ For more details see the "Extracting dataset-specific code" section.}
 
 \code{get_code} returns the traced code (from \verb{@code} slot) in the form specified by \code{deparse}.
 
+\code{qenv} object
+
 \code{within} returns a \code{qenv} object with \code{expr} evaluated or \code{qenv.error} if evaluation fails.
 }
 \description{
@@ -75,6 +81,8 @@ Thus, if the \code{qenv} had been instantiated empty, contents of the environmen
 
 \code{get_code} retrieves the code stored in the \code{qenv}. \code{...} passes arguments to methods.
 
+Subset objects in \code{qenv} environment and limit the code to the necessary to build limited objects.
+
 \code{within} is a convenience function for evaluating inline code inside the environment of a \code{qenv}.
 It is a method for the \code{base} generic that wraps \code{eval_code} to provide a simplified way of passing code.
 \code{within} accepts only inline expressions (both simple and compound) and allows for injecting values into \code{expr}
@@ -186,6 +194,10 @@ q <- qenv()
 q <- eval_code(q, code = c("a <- 1", "b <- 2"))
 get_code(q, names = "a")
 
+q <- qenv()
+q <- eval_code(q, "a <- 1;b<-2")
+q <- subset(q, "a")
+
 # evaluate code using within
 q <- qenv()
 q <- within(q, {

From 4b2b2fb22d0552ddabff672f5f46cc21775bae8a Mon Sep 17 00:00:00 2001
From: m7pr <marcin.kosinski.mk1@roche.com>
Date: Thu, 24 Oct 2024 14:38:50 +0200
Subject: [PATCH 02/98] let qenv, eval_code and get_code work on @code that has
 length as the number of calls in @code

---
 NEWS.md                       |  2 ++
 R/qenv-eval_code.R            | 20 +++++++++++---------
 R/qenv-get_code.R             | 11 ++++++-----
 R/qenv-subset.R               | 23 ++++++++++-------------
 R/utils-get_code_dependency.R | 23 ++++++++++++++++++++++-
 5 files changed, 51 insertions(+), 28 deletions(-)

diff --git a/NEWS.md b/NEWS.md
index 1d49c5ba..ade6c9eb 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -4,6 +4,8 @@
 
 * `get_code()` was extended with `names` parameter and allows the code extraction to be limited to objects stored in
 `qenv` but limited to `names`.
+* `eval_code(qenv, code)` analyzes code by single calls and returns `@id`, `@code`, `@messages`, `@warnings` fields of
+the length of calls included in `code`.
 
 # teal.code 0.5.0
 
diff --git a/R/qenv-eval_code.R b/R/qenv-eval_code.R
index 25af3571..5f7d2d14 100644
--- a/R/qenv-eval_code.R
+++ b/R/qenv-eval_code.R
@@ -28,18 +28,20 @@
 setGeneric("eval_code", function(object, code) standardGeneric("eval_code"))
 
 setMethod("eval_code", signature = c("qenv", "character"), function(object, code) {
-  id <- sample.int(.Machine$integer.max, size = 1)
+  parsed_code <- parse(text = code, keep.source = TRUE)
+  comments <- extract_comments(parsed_code)
+  id <- sample.int(.Machine$integer.max, size = length(parsed_code))
 
   object@id <- c(object@id, id)
   object@env <- rlang::env_clone(object@env, parent = parent.env(.GlobalEnv))
-  code <- paste(code, collapse = "\n")
-  object@code <- c(object@code, code)
+  object@code <- c(object@code, trimws(paste(as.character(parsed_code), comments)))
 
-  current_warnings <- ""
-  current_messages <- ""
+  current_warnings <- rep("", length(parsed_code))
+  current_messages <- rep("", length(parsed_code))
 
-  parsed_code <- parse(text = code, keep.source = TRUE)
-  for (single_call in parsed_code) {
+
+  for (i in 1:length(parsed_code)) {
+    single_call <- parsed_code[i]
     # Using withCallingHandlers to capture warnings and messages.
     # Using tryCatch to capture the error and abort further evaluation.
     x <- withCallingHandlers(
@@ -66,11 +68,11 @@ setMethod("eval_code", signature = c("qenv", "character"), function(object, code
         }
       ),
       warning = function(w) {
-        current_warnings <<- paste0(current_warnings, .ansi_strip(sprintf("> %s\n", conditionMessage(w))))
+        current_warnings[i] <<- .ansi_strip(sprintf("> %s\n", conditionMessage(w)))
         invokeRestart("muffleWarning")
       },
       message = function(m) {
-        current_messages <<- paste0(current_messages, .ansi_strip(sprintf("> %s", conditionMessage(m))))
+        current_messages[i] <<- .ansi_strip(sprintf("> %s", conditionMessage(m)))
         invokeRestart("muffleMessage")
       }
     )
diff --git a/R/qenv-get_code.R b/R/qenv-get_code.R
index cc88d633..ba90c786 100644
--- a/R/qenv-get_code.R
+++ b/R/qenv-get_code.R
@@ -124,11 +124,12 @@ setMethod("get_code", signature = "qenv", function(object, deparse = TRUE, names
   }
 
   if (deparse) {
-    if (length(code) == 0) {
-      code
-    } else {
-      paste(code, collapse = "\n")
-    }
+    # if (length(code) == 0) {
+    #   code
+    # } else {
+    #   paste(code, collapse = "\n")
+    # }
+    code
   } else {
     parse(text = paste(c("{", code, "}"), collapse = "\n"), keep.source = TRUE)
   }
diff --git a/R/qenv-subset.R b/R/qenv-subset.R
index be2d426b..7bff50f4 100644
--- a/R/qenv-subset.R
+++ b/R/qenv-subset.R
@@ -30,21 +30,18 @@ setMethod("subset", signature = c("qenv"), function(object, names) {
     return(qenv())
   }
 
-  new_qenv <- qenv()
-  new_qenv@env <- list2env(mget(x = names_in_env, envir = get_env(object)))
-  new_qenv@code <- get_code(object, names = names_in_env)
-  # Question: what about @id, @warnings, @messages?
-  # Currently:
-  # > new_qenv@id
-  # integer(0)
-  # > new_qenv@warnings
-  # character(0)
-  # > new_qenv@messages
-  # character(0)
-  new_qenv
+  limited_code <- get_code(object, names = names_in_env)
+  indexes <- which(object@code %in% limited_code)
 
-})
+  object@env <- list2env(mget(x = names_in_env, envir = get_env(object)))
+  object@code <- limited_code
+  object@id <- object@id[indexes]
+  object@warnings <- object@warnings[indexes]
+  object@messages <- object@messages[indexes]
+
+  object
 
+})
 
 setMethod("subset", signature = c("qenv.error", "ANY"), function(object, names) {
   object
diff --git a/R/utils-get_code_dependency.R b/R/utils-get_code_dependency.R
index a38b19bc..2f69950b 100644
--- a/R/utils-get_code_dependency.R
+++ b/R/utils-get_code_dependency.R
@@ -44,6 +44,7 @@ get_code_dependency <- function(code, names, check_names = TRUE) {
   pd <- utils::getParseData(code)
   pd <- normalize_pd(pd)
   calls_pd <- extract_calls(pd)
+  comments <- extract_comments(code)
 
   if (check_names) {
     # Detect if names are actually in code.
@@ -64,7 +65,8 @@ get_code_dependency <- function(code, names, check_names = TRUE) {
 
   lib_ind <- detect_libraries(calls_pd)
 
-  as.character(code[sort(unique(c(lib_ind, ind)))])
+  code_ids <- sort(unique(c(lib_ind, ind)))
+  trimws(paste(as.character(code[code_ids]), comments[code_ids]))
 }
 
 #' Locate function call token
@@ -451,3 +453,22 @@ normalize_pd <- function(pd) {
 
   pd
 }
+
+#' Extract comments from parsed code
+#'
+#' @param parsed_code `expression`, result of `parse()` function
+#'
+#' @return `character` vector of length of `parsed_code` with comments included in `parsed_code`
+#' @keywords internal
+#' @noRd
+extract_comments <- function(parsed_code) {
+  get_comments <- function(call) {
+    comment <- call[call$token == "COMMENT", "text"]
+    if (length(comment) == 0) "" else comment
+  }
+  unlist(lapply(
+    extract_calls(utils::getParseData(parsed_code)),
+    get_comments
+  ))
+}
+

From 2eab6d3f810cde866e7a0e3c93a508288f4cea92 Mon Sep 17 00:00:00 2001
From: m7pr <marcin.kosinski.mk1@roche.com>
Date: Thu, 24 Oct 2024 14:38:59 +0200
Subject: [PATCH 03/98] adjust tests

---
 tests/testthat/test-qenv_eval_code.R    |   8 +-
 tests/testthat/test-qenv_get_code.R     | 158 +++++++++---------------
 tests/testthat/test-qenv_get_warnings.R |  14 +--
 tests/testthat/test-qenv_join.R         |   8 +-
 tests/testthat/test-qenv_subset.R       |  45 +++++++
 tests/testthat/test-qenv_within.R       |  14 +--
 6 files changed, 121 insertions(+), 126 deletions(-)
 create mode 100644 tests/testthat/test-qenv_subset.R

diff --git a/tests/testthat/test-qenv_eval_code.R b/tests/testthat/test-qenv_eval_code.R
index 12a2a7a0..4d4fc8d6 100644
--- a/tests/testthat/test-qenv_eval_code.R
+++ b/tests/testthat/test-qenv_eval_code.R
@@ -70,7 +70,7 @@ testthat::test_that("eval_code works with quoted code block", {
 
   testthat::expect_equal(
     q1@code,
-    "a <- 1\nb <- 2"
+    c("a <- 1", "b <- 2")
   )
   testthat::expect_equal(q1@env, list2env(list(a = 1, b = 2)))
 })
@@ -88,7 +88,7 @@ testthat::test_that("an error when calling eval_code returns a qenv.error object
     unname(q$trace),
     c("x <- 1", "y <- 2", "z <- w * x")
   )
-  testthat::expect_equal(q$message, "object 'w' not found \n when evaluating qenv code:\nz <- w * x")
+  testthat::expect_equal(q$message, "object 'w' not found \n when evaluating qenv code:\nexpression(z <- w * x)")
 })
 
 testthat::test_that("a warning when calling eval_code returns a qenv object which has warnings", {
@@ -97,13 +97,13 @@ testthat::test_that("a warning when calling eval_code returns a qenv object whic
   testthat::expect_s4_class(q, "qenv")
   testthat::expect_equal(
     q@warnings,
-    c("", paste(rep("> \"ff\" is not a graphical parameter\n", 4), collapse = ""))
+    c("", "> \"ff\" is not a graphical parameter\n")
   )
 })
 
 testthat::test_that("eval_code with a vector of code produces one warning element per code element", {
   q <- eval_code(qenv(), c("x <- 1", "y <- 1", "warning('warn1')"))
-  testthat::expect_equal(c("> warn1\n"), q@warnings)
+  testthat::expect_equal(c("", "", "> warn1\n"), q@warnings)
 })
 
 
diff --git a/tests/testthat/test-qenv_get_code.R b/tests/testthat/test-qenv_get_code.R
index 0f9aedf9..0533d481 100644
--- a/tests/testthat/test-qenv_get_code.R
+++ b/tests/testthat/test-qenv_get_code.R
@@ -2,10 +2,10 @@ testthat::test_that("get_code returns code (character by default) of qenv object
   q <- qenv() |>
     eval_code(quote(x <- 1)) |>
     eval_code(quote(y <- x))
-  testthat::expect_equal(get_code(q), paste(c("x <- 1", "y <- x"), collapse = "\n"))
+  testthat::expect_equal(get_code(q), c("x <- 1", "y <- x"))
 })
 
-testthat::test_that("get_code returns code elements being code-blocks as character(1)", {
+testthat::test_that("get_code handles code elements being code-blocks", {
   q <- qenv()
   q <- eval_code(q, quote(x <- 1))
   q <- eval_code(
@@ -15,7 +15,7 @@ testthat::test_that("get_code returns code elements being code-blocks as charact
       z <- 5
     })
   )
-  testthat::expect_equal(get_code(q), paste(c("x <- 1", "y <- x\nz <- 5"), collapse = "\n"))
+  testthat::expect_equal(get_code(q), c("x <- 1", "y <- x", "z <- 5"))
 })
 
 testthat::test_that("get_code returns expression of qenv object if deparse = FALSE", {
@@ -41,7 +41,7 @@ testthat::test_that("get_code called with qenv.error returns error with trace in
   testthat::expect_equal(class(code), c("validation", "try-error", "simpleError", "error", "condition"))
   testthat::expect_equal(
     code$message,
-    "object 'v' not found \n when evaluating qenv code:\nw <- v\n\ntrace: \n x <- 1\n y <- x\n w <- v\n"
+    "object 'v' not found \n when evaluating qenv code:\nexpression(w <- v)\n\ntrace: \n x <- 1\n y <- x\n w <- v\n"
   )
 })
 
@@ -55,7 +55,7 @@ testthat::test_that("handles empty @code slot", {
   )
   testthat::expect_identical(
     get_code(eval_code(qenv(), code = ""), names = "a"),
-    ""
+    character(0)
   )
 })
 
@@ -120,7 +120,7 @@ testthat::test_that("extracts the code without downstream usage", {
   )
 })
 
-testthat::test_that("works for datanames of length > 1", {
+testthat::test_that("works for names of length > 1", {
   code <- c(
     "a <- 1",
     "b <- 2"
@@ -128,7 +128,7 @@ testthat::test_that("works for datanames of length > 1", {
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
     get_code(q, names = c("a", "b")),
-    paste(code, collapse = "\n")
+    code
   )
 })
 
@@ -151,15 +151,15 @@ testthat::test_that("does not fall into a loop", {
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
     get_code(q, names = "a"),
-    paste(code, collapse = "\n")
+    code
   )
   testthat::expect_identical(
     get_code(q, names = "b"),
-    paste(code[1:2], collapse = "\n")
+    code[1:2]
   )
   testthat::expect_identical(
     get_code(q, names = "c"),
-    paste(code[1:3], collapse = "\n")
+    code[1:3]
   )
 })
 
@@ -173,7 +173,7 @@ testthat::test_that("extracts code of a parent binding but only those evaluated
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
     get_code(q, names = "b"),
-    paste("a <- 1", "b <- a", sep = "\n")
+    c("a <- 1", "b <- a")
   )
 })
 
@@ -186,7 +186,7 @@ testthat::test_that("extracts the code of a parent binding if used as an arg in
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
     get_code(q, names = "b"),
-    paste("a <- 1", "b <- identity(x = a)", sep = "\n")
+    c("a <- 1", "b <- identity(x = a)")
   )
 })
 
@@ -199,7 +199,7 @@ testthat::test_that("extracts the code when using <<-", {
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
     get_code(q, names = "b"),
-    paste("a <- 1", "b <- a", "b <<- b + 2", sep = "\n")
+    c("a <- 1", "b <- a", "b <<- b + 2")
   )
 })
 
@@ -212,11 +212,11 @@ testthat::test_that("detects every assign calls even if not evaluated, if there
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
     get_code(q, names = "b"),
-    paste("b <- 2", "eval(expression({\n    b <- b + 2\n}))", sep = "\n")
+    c("b <- 2", "eval(expression({\n    b <- b + 2\n}))")
   )
 })
 
-testthat::test_that("returns result of length 1 for non-empty input", {
+testthat::test_that("returns result of length 1 for non-empty input and deparse = FALSE", {
   q1 <- qenv()
   q1 <- within(q1, {
     a <- 1
@@ -225,7 +225,6 @@ testthat::test_that("returns result of length 1 for non-empty input", {
   })
 
   testthat::expect_length(get_code(q1, deparse = FALSE), 1)
-  testthat::expect_length(get_code(q1, deparse = TRUE), 1)
 })
 
 testthat::test_that("does not break if code is separated by ;", {
@@ -235,7 +234,7 @@ testthat::test_that("does not break if code is separated by ;", {
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
     get_code(q, names = "a"),
-    gsub(";", "\n", code, fixed = TRUE)
+    c("a <- 1", "a <- a + 1")
   )
 })
 
@@ -261,7 +260,7 @@ testthat::test_that("does not break if object is used in a function on lhs", {
   q <- eval_code(qenv(), code = code)
   testthat::expect_identical(
     get_code(q, names = "iris"),
-    paste(code[c(1, 3)], collapse = "\n")
+    code[c(1, 3)]
   )
 })
 
@@ -276,7 +275,7 @@ testthat::test_that(
     q <- eval_code(qenv(), code = code)
     testthat::expect_identical(
       get_code(q, names = "x"),
-      paste(code, collapse = "\n")
+      code
     )
   }
 )
@@ -296,21 +295,20 @@ testthat::test_that("extracts the code for assign() where \"x\" is a literal str
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
     get_code(q, names = "b"),
-    paste("assign(\"b\", 5)", "b <- b + 2", sep = "\n")
+    c("assign(\"b\", 5)", "b <- b + 2")
   )
   testthat::expect_identical(
     get_code(q, names = "c"),
-    paste(
+    c(
       "assign(\"b\", 5)",
       "assign(value = 7, x = \"c\")",
       "b <- b + 2",
-      "c <- b",
-      sep = "\n"
+      "c <- b"
     )
   )
   testthat::expect_identical(
     get_code(q, names = "d"),
-    paste("assign(value = 15, x = \"d\")", "d <- d * 2", sep = "\n")
+    c("assign(value = 15, x = \"d\")", "d <- d * 2")
   )
 })
 
@@ -324,7 +322,7 @@ testthat::test_that("extracts the code for assign() where \"x\" is variable", {
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
     get_code(q, names = "b"),
-    paste(code, collapse = "\n")
+    code
   )
 })
 
@@ -341,7 +339,7 @@ testthat::test_that("works for assign() detection no matter how many parametrers
 
   testthat::expect_identical(
     get_code(q, names = "y"),
-    paste(code, collapse = "\n")
+    code
   )
 })
 
@@ -357,7 +355,7 @@ testthat::test_that("detects function usage of the assignment operator", {
 
   testthat::expect_identical(
     get_code(q, names = "y"),
-    paste(c(code[1], "y <- x"), collapse = "\n")
+    c(code[1], "y <- x")
   )
   testthat::expect_identical(
     get_code(q2, names = "y"),
@@ -380,7 +378,7 @@ testthat::test_that("get_code does not break if @linksto is put in the last line
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
     get_code(q, names = "x"),
-    paste(gsub(" #@linksto x", "", code, fixed = TRUE), collapse = "\n")
+    code
   )
 })
 
@@ -392,7 +390,7 @@ testthat::test_that("@linksto makes a line being returned for an affected bindin
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
     get_code(q, names = "b"),
-    paste("a <- 1", "b <- 2", sep = "\n")
+    c("a <- 1 # @linksto b", "b <- 2")
   )
 })
 
@@ -407,7 +405,7 @@ testthat::test_that(
     q <- eval_code(qenv(), code)
     testthat::expect_identical(
       get_code(q, names = "b"),
-      paste("a <- 1", "b <- 2", sep = "\n")
+      code
     )
   }
 )
@@ -416,7 +414,7 @@ testthat::test_that(
   "lines affecting parent evaluated after co-occurrence are not included in output when using @linksto",
   {
     code <- c(
-      "a <- 1 ",
+      "a <- 1",
       "b <- 2 # @linksto a",
       "a <- a + 1",
       "b <- b + 1"
@@ -424,11 +422,11 @@ testthat::test_that(
     q <- eval_code(qenv(), code)
     testthat::expect_identical(
       get_code(q, names = "a"),
-      paste("a <- 1", "b <- 2", "a <- a + 1", sep = "\n")
+      code[1:3]
     )
     testthat::expect_identical(
       get_code(q, names = "b"),
-      paste("b <- 2", "b <- b + 1", sep = "\n")
+      code[c(2, 4)]
     )
   }
 )
@@ -436,21 +434,16 @@ testthat::test_that(
 testthat::test_that(
   "@linksto gets extracted if it's a side-effect on a dependent object (even of a dependent object)",
   {
-    code <- "
-      iris[1:5, ] -> iris2
-      iris_head <- head(iris) # @linksto iris3
-      iris3 <- iris_head[1, ] # @linksto iris2
-      classes <- lapply(iris2, class)
-    "
+    code <- c(
+      "iris[1:5, ] -> iris2",
+      "iris_head <- head(iris) # @linksto iris3",
+      "iris3 <- iris_head[1, ] # @linksto iris2",
+      "classes <- lapply(iris2, class)"
+    )
     q <- eval_code(qenv(), code)
     testthat::expect_identical(
       get_code(q, names = "classes"),
-      paste("iris2 <- iris[1:5, ]",
-        "iris_head <- head(iris)",
-        "iris3 <- iris_head[1, ]",
-        "classes <- lapply(iris2, class)",
-        sep = "\n"
-      )
+      c("iris2 <- iris[1:5, ]", code[2:4])
     )
   }
 )
@@ -499,7 +492,7 @@ testthat::test_that("ignores occurrence in a function definition if there is mul
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
     get_code(q, names = "b"),
-    "b <- 2\nb <- b + 1"
+    code[c(1, 3)]
   )
   testthat::expect_identical(
     get_code(q, names = "foo"),
@@ -533,7 +526,7 @@ testthat::test_that("does not ignore occurrence in function body if object exsit
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
     get_code(q, names = "b"),
-    paste(code, sep = "\n")
+    code
   )
 })
 
@@ -563,7 +556,7 @@ testthat::test_that("detects occurrence of the function object", {
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
     get_code(q, names = "b"),
-    paste("a <- 1", "b <- 2", "foo <- function(b) {\n    b <- b + 2\n}", "b <- foo(a)", sep = "\n")
+    c("a <- 1", "b <- 2", "foo <- function(b) {\n    b <- b + 2\n}", "b <- foo(a)")
   )
 })
 
@@ -576,7 +569,7 @@ testthat::test_that("detects occurrence of a function definition when a formal i
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
     get_code(q, names = "a"),
-    paste("x <- 1", "foo <- function(foo = 1) \"text\"", "a <- foo(x)", sep = "\n")
+    c("x <- 1", "foo <- function(foo = 1) \"text\"", "a <- foo(x)")
   )
 })
 
@@ -593,7 +586,8 @@ testthat::test_that("detects occurrence of a function definition with a @linksto
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
     get_code(q, names = "x"),
-    "foo <- function() {\n    env <- parent.frame()\n    env$x <- 0\n}\nfoo()"
+    c("foo <- function() {\n    env <- parent.frame()\n    env$x <- 0\n}",
+      "foo() # @linksto x")
   )
 })
 # $ ---------------------------------------------------------------------------------------------------------------
@@ -613,13 +607,7 @@ testthat::test_that("understands $ usage and do not treat rhs of $ as objects (o
   )
   testthat::expect_identical(
     get_code(q, names = "a"),
-    paste("x <- data.frame(a = 1:3)",
-      "a <- data.frame(y = 1:3)",
-      "a$x <- a$y",
-      "a$x <- a$x + 2",
-      "a$x <- x$a",
-      sep = "\n"
-    )
+    code
   )
 })
 
@@ -632,7 +620,7 @@ testthat::test_that("detects cooccurrence properly even if all objects are on lh
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
     get_code(q, names = "b"),
-    paste(code, collapse = "\n")
+    code
   )
 })
 
@@ -652,23 +640,11 @@ testthat::test_that("understands @ usage and do not treat rhs of @ as objects (o
   q@code <- code # we don't use eval_code so the code is not run
   testthat::expect_identical(
     get_code(q, names = "x"),
-    paste(
-      'setClass("aclass", slots = c(a = "numeric", x = "numeric", y = "numeric"))',
-      'x <- new("aclass", a = 1:3, x = 1:3, y = 1:3)',
-      sep = "\n"
-    )
+    gsub("'", "\"", code[1:2], fixed = TRUE)
   )
   testthat::expect_identical(
     get_code(q, names = "a"),
-    paste(
-      'setClass("aclass", slots = c(a = "numeric", x = "numeric", y = "numeric"))',
-      'x <- new("aclass", a = 1:3, x = 1:3, y = 1:3)',
-      'a <- new("aclass", a = 1:3, x = 1:3, y = 1:3)',
-      "a@x <- a@y",
-      "a@x <- a@x + 2",
-      "a@x <- x@a",
-      sep = "\n"
-    )
+    gsub("'", "\"", code, fixed = TRUE)
   )
 })
 
@@ -687,12 +663,7 @@ testthat::test_that("library() and require() are always returned", {
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
     get_code(q, names = "x"),
-    paste(
-      "require(dplyr)",
-      "library(lifecycle)",
-      "x <- 5",
-      sep = "\n"
-    )
+    code[c(2, 3, 4)]
   )
 })
 
@@ -710,13 +681,7 @@ testthat::test_that("data() call is returned when data name is provided as is",
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
     get_code(q, names = "x"),
-    paste(
-      "require(dplyr)",
-      "library(lifecycle)",
-      "data(iris, envir = environment())",
-      "x <- iris",
-      sep = "\n"
-    )
+    code[-1]
   )
 })
 
@@ -731,13 +696,7 @@ testthat::test_that("data() call is returned when data name is provided as a cha
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
     get_code(q, names = "z"),
-    paste(
-      "require(dplyr)",
-      "library(lifecycle)",
-      "data(\"mtcars\")",
-      "z <- mtcars",
-      sep = "\n"
-    )
+    gsub("'", "\"", code[-1], fixed = TRUE)
   )
 })
 
@@ -784,8 +743,7 @@ testthat::describe("Backticked symbol", {
 
     testthat::expect_identical(
       get_code(td, names = "iris_ds"),
-      paste(
-        sep = "\n",
+      c(
         "`_add_column_` <- function(lhs, rhs) cbind(lhs, rhs)",
         "iris_ds <- `_add_column_`(iris, data.frame(new_col = \"new column\"))"
       )
@@ -803,8 +761,7 @@ testthat::describe("Backticked symbol", {
 
     testthat::expect_identical(
       get_code(td, names = "iris_ds"),
-      paste(
-        sep = "\n",
+      c(
         "`add column` <- function(lhs, rhs) cbind(lhs, rhs)",
         "iris_ds <- `add column`(iris, data.frame(new_col = \"new column\"))"
       )
@@ -822,8 +779,7 @@ testthat::describe("Backticked symbol", {
 
     testthat::expect_identical(
       get_code(td, names = "iris_ds"),
-      paste(
-        sep = "\n",
+      c(
         "add_column <- function(lhs, rhs) cbind(lhs, rhs)",
         "iris_ds <- add_column(iris, data.frame(new_col = \"new column\"))"
       )
@@ -843,8 +799,7 @@ testthat::describe("Backticked symbol", {
     # correctly.
     testthat::expect_identical(
       get_code(td, names = "iris_ds"),
-      paste(
-        sep = "\n",
+      c(
         "`%add_column%` <- function(lhs, rhs) cbind(lhs, rhs)",
         "iris_ds <- iris %add_column% data.frame(new_col = \"new column\")"
       )
@@ -864,8 +819,7 @@ testthat::describe("Backticked symbol", {
     # correctly.
     testthat::expect_identical(
       get_code(td, names = "iris_ds"),
-      paste(
-        sep = "\n",
+      c(
         "`%add_column%` <- function(lhs, rhs) cbind(lhs, rhs)",
         "iris_ds <- iris %add_column% data.frame(new_col = \"new column\")"
       )
diff --git a/tests/testthat/test-qenv_get_warnings.R b/tests/testthat/test-qenv_get_warnings.R
index 5f286b85..7d2ee762 100644
--- a/tests/testthat/test-qenv_get_warnings.R
+++ b/tests/testthat/test-qenv_get_warnings.R
@@ -28,7 +28,7 @@ testthat::test_that("get_warnings accepts a qenv object with 2 warnings", {
     eval_code(bquote(warning("This is a warning 1!"))) %>%
     eval_code(bquote(warning("This is a warning 2!")))
   testthat::expect_identical(
-    get_warnings(q),
+    get_warnings(q), #TODO fix
     paste0(
       "~~~ Warnings ~~~\n\n> This is a warning 1!\nwhen running code:\nwarning(\"This is a warning 1!\")",
       "\n\n> This is a warning 2!\nwhen running code:\nwarning(\"This is a warning 2!\")\n\n",
@@ -42,14 +42,10 @@ testthat::test_that("get_warnings accepts a qenv object with a single eval_code
     warning("This is a warning 1!")
     warning("This is a warning 2!")
   }))
-  testthat::expect_identical(
+  testthat::expect_identical( #TODO fix
     get_warnings(q),
-    paste0(
-      "~~~ Warnings ~~~\n\n",
-      "> This is a warning 1!\n> This is a warning 2!\nwhen running code:\n",
-      "warning(\"This is a warning 1!\")\nwarning(\"This is a warning 2!\")\n\n",
-      "~~~ Trace ~~~\n\n",
-      "warning(\"This is a warning 1!\")\nwarning(\"This is a warning 2!\")"
+    c("~~~ Warnings ~~~\n\n> This is a warning 1!\nwhen running code:\nwarning(\"This is a warning 1!\")\n\n> This is a warning 2!\nwhen running code:\nwarning(\"This is a warning 2!\")\n\n~~~ Trace ~~~\n\nwarning(\"This is a warning 1!\")",
+      "~~~ Warnings ~~~\n\n> This is a warning 1!\nwhen running code:\nwarning(\"This is a warning 1!\")\n\n> This is a warning 2!\nwhen running code:\nwarning(\"This is a warning 2!\")\n\n~~~ Trace ~~~\n\nwarning(\"This is a warning 2!\")"
     )
   )
 })
@@ -59,7 +55,7 @@ testthat::test_that("get_warnings accepts a qenv object with 1 warning eval_code
     eval_code(bquote("x <- 1")) %>%
     eval_code(bquote(warning("This is a warning 2!")))
   testthat::expect_identical(
-    get_warnings(q),
+    get_warnings(q), #TODO fix
     paste0(
       "~~~ Warnings ~~~\n\n> This is a warning 2!\nwhen running code:\nwarning(\"This is a warning 2!\")\n\n",
       "~~~ Trace ~~~\n\nx <- 1\nwarning(\"This is a warning 2!\")"
diff --git a/tests/testthat/test-qenv_join.R b/tests/testthat/test-qenv_join.R
index fdc218d8..c728ad88 100644
--- a/tests/testthat/test-qenv_join.R
+++ b/tests/testthat/test-qenv_join.R
@@ -40,9 +40,9 @@ testthat::test_that("Joined qenv does not duplicate common code", {
 
   testthat::expect_identical(
     q@code,
-    c("iris1 <- iris\nmtcars1 <- mtcars", "mtcars2 <- mtcars")
+    c("iris1 <- iris", "mtcars1 <- mtcars", "mtcars2 <- mtcars")
   )
-  testthat::expect_identical(q@id, c(q1@id, q2@id[2]))
+  testthat::expect_identical(q@id, c(q1@id, q2@id[2])) #TODO fix
 })
 
 testthat::test_that("Not able to join two qenvs if any of the shared objects changed", {
@@ -64,7 +64,7 @@ testthat::test_that("join does not duplicate code but adds only extra code", {
 
   testthat::expect_identical(
     q@code,
-    c("iris1 <- iris\nmtcars1 <- mtcars", "iris2 <- iris", "mtcars2 <- mtcars")
+    c("iris1 <- iris", "mtcars1 <- mtcars", "iris2 <- iris", "mtcars2 <- mtcars")
   )
 
   testthat::expect_equal(
@@ -72,7 +72,7 @@ testthat::test_that("join does not duplicate code but adds only extra code", {
     list(iris1 = iris, iris2 = iris, mtcars1 = mtcars, mtcars2 = mtcars)
   )
 
-  testthat::expect_identical(q@id, c(q1@id, q2@id[2]))
+  testthat::expect_identical(q@id, c(q1@id, q2@id[2])) #TODO - fix this
 })
 
 testthat::test_that("Not possible to join qenvs which share some code when one of the shared object was modified", {
diff --git a/tests/testthat/test-qenv_subset.R b/tests/testthat/test-qenv_subset.R
new file mode 100644
index 00000000..d490b7e3
--- /dev/null
+++ b/tests/testthat/test-qenv_subset.R
@@ -0,0 +1,45 @@
+testthat::test_that("subset extract proper objects", {
+  q <- qenv()
+  code <- c("x<-1","a<-1;b<-2")
+  q <- eval_code(q, code)
+  object_names <- c("x", "a")
+  qs <- subset(q, names = object_names)
+  testthat::expect_true(all(ls(get_env(qs)) %in% object_names))
+})
+
+testthat::test_that("subset extract proper code", {
+  q <- qenv()
+  code <- c("x<-1","a<-1;b<-2")
+  q <- eval_code(q, code)
+  object_names <- c("x", "a")
+  qs <- subset(q, names = object_names)
+  testthat::expect_identical(
+    qs@code,
+    c("x <- 1", "a <- 1")
+  )
+})
+
+testthat::test_that("subset preservers comments in the code", {
+  q <- qenv()
+  code <- c("x<-1 #comment","a<-1;b<-2")
+  q <- eval_code(q, code)
+  qs <- subset(q, names = c("x", "a"))
+  testthat::expect_identical(
+    qs@code,
+    c("x <- 1 #comment", "a <- 1")
+  )
+})
+
+testthat::test_that("subset extract proper elements of @id, @warnings and @messages fiels", {
+  q <- qenv()
+  code <-
+    c("x<-1 #comment", "message('tiny message')", "a<-1;b<-2;warning('small warning')")
+  q <- eval_code(q, code)
+  qs <- subset(q, names = c("x", "a"))
+
+  testthat::expect_identical(qs@id, q@id[c(1, 3)])
+  testthat::expect_identical(qs@code, q@code[c(1, 3)])
+  testthat::expect_identical(qs@warnings, q@warnings[c(1, 3)])
+  testthat::expect_identical(qs@messages, q@messages[c(1, 3)])
+
+})
diff --git a/tests/testthat/test-qenv_within.R b/tests/testthat/test-qenv_within.R
index 6073d80b..ff8842a6 100644
--- a/tests/testthat/test-qenv_within.R
+++ b/tests/testthat/test-qenv_within.R
@@ -29,7 +29,7 @@ testthat::test_that("styling of input code does not impact evaluation results",
   all_code <- get_code(q)
   testthat::expect_identical(
     all_code,
-    paste(rep("1 + 1", 4L), collapse = "\n")
+    rep("1 + 1", 4L)
   )
 
   q <- qenv()
@@ -48,7 +48,7 @@ testthat::test_that("styling of input code does not impact evaluation results",
   all_code <- get_code(q)
   testthat::expect_identical(
     all_code,
-    paste(rep("1 + 1\n2 + 2", 4L), collapse = "\n")
+    rep(c("1 + 1", "2 + 2"), 4L)
   )
 })
 
@@ -79,28 +79,28 @@ testthat::test_that("external values can be injected into expressions through `.
 
   external_value <- "virginica"
   q <- within(q, {
-    i <- subset(iris, Species == species)
+    i <- base::subset(iris, Species == species)
   },
   species = external_value)
 
-  testthat::expect_identical(get_code(q), "i <- subset(iris, Species == \"virginica\")")
+  testthat::expect_identical(get_code(q), "i <- base::subset(iris, Species == \"virginica\")")
 })
 
 testthat::test_that("external values are not taken from calling frame", {
   q <- qenv()
   species <- "setosa"
   qq <- within(q, {
-    i <- subset(iris, Species == species)
+    i <- base::subset(iris, Species == species)
   })
   testthat::expect_s3_class(qq, "qenv.error")
   testthat::expect_error(get_code(qq), "object 'species' not found")
 
   qq <- within(q, {
-    i <- subset(iris, Species == species)
+    i <- base::subset(iris, Species == species)
   },
   species = species)
   testthat::expect_s4_class(qq, "qenv")
-  testthat::expect_identical(get_code(qq), "i <- subset(iris, Species == \"setosa\")")
+  testthat::expect_identical(get_code(qq), "i <- base::subset(iris, Species == \"setosa\")")
 })
 
 # nolint end

From 8349eef1c6db2326cfe01ca03f8a8fc15eb29c82 Mon Sep 17 00:00:00 2001
From: github-actions <41898282+github-actions[bot]@users.noreply.github.com>
Date: Thu, 24 Oct 2024 12:47:28 +0000
Subject: [PATCH 04/98] [skip style] [skip vbump] Restyle files

---
 R/qenv-subset.R                         | 2 --
 R/utils-get_code_dependency.R           | 1 -
 tests/testthat/test-qenv_get_code.R     | 6 ++++--
 tests/testthat/test-qenv_get_warnings.R | 9 +++++----
 tests/testthat/test-qenv_join.R         | 4 ++--
 tests/testthat/test-qenv_subset.R       | 7 +++----
 6 files changed, 14 insertions(+), 15 deletions(-)

diff --git a/R/qenv-subset.R b/R/qenv-subset.R
index 7bff50f4..f337a3da 100644
--- a/R/qenv-subset.R
+++ b/R/qenv-subset.R
@@ -40,10 +40,8 @@ setMethod("subset", signature = c("qenv"), function(object, names) {
   object@messages <- object@messages[indexes]
 
   object
-
 })
 
 setMethod("subset", signature = c("qenv.error", "ANY"), function(object, names) {
   object
 })
-
diff --git a/R/utils-get_code_dependency.R b/R/utils-get_code_dependency.R
index 2f69950b..955e2d90 100644
--- a/R/utils-get_code_dependency.R
+++ b/R/utils-get_code_dependency.R
@@ -471,4 +471,3 @@ extract_comments <- function(parsed_code) {
     get_comments
   ))
 }
-
diff --git a/tests/testthat/test-qenv_get_code.R b/tests/testthat/test-qenv_get_code.R
index 0533d481..39183a88 100644
--- a/tests/testthat/test-qenv_get_code.R
+++ b/tests/testthat/test-qenv_get_code.R
@@ -586,8 +586,10 @@ testthat::test_that("detects occurrence of a function definition with a @linksto
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
     get_code(q, names = "x"),
-    c("foo <- function() {\n    env <- parent.frame()\n    env$x <- 0\n}",
-      "foo() # @linksto x")
+    c(
+      "foo <- function() {\n    env <- parent.frame()\n    env$x <- 0\n}",
+      "foo() # @linksto x"
+    )
   )
 })
 # $ ---------------------------------------------------------------------------------------------------------------
diff --git a/tests/testthat/test-qenv_get_warnings.R b/tests/testthat/test-qenv_get_warnings.R
index 7d2ee762..eb113f71 100644
--- a/tests/testthat/test-qenv_get_warnings.R
+++ b/tests/testthat/test-qenv_get_warnings.R
@@ -28,7 +28,7 @@ testthat::test_that("get_warnings accepts a qenv object with 2 warnings", {
     eval_code(bquote(warning("This is a warning 1!"))) %>%
     eval_code(bquote(warning("This is a warning 2!")))
   testthat::expect_identical(
-    get_warnings(q), #TODO fix
+    get_warnings(q), # TODO fix
     paste0(
       "~~~ Warnings ~~~\n\n> This is a warning 1!\nwhen running code:\nwarning(\"This is a warning 1!\")",
       "\n\n> This is a warning 2!\nwhen running code:\nwarning(\"This is a warning 2!\")\n\n",
@@ -42,9 +42,10 @@ testthat::test_that("get_warnings accepts a qenv object with a single eval_code
     warning("This is a warning 1!")
     warning("This is a warning 2!")
   }))
-  testthat::expect_identical( #TODO fix
+  testthat::expect_identical( # TODO fix
     get_warnings(q),
-    c("~~~ Warnings ~~~\n\n> This is a warning 1!\nwhen running code:\nwarning(\"This is a warning 1!\")\n\n> This is a warning 2!\nwhen running code:\nwarning(\"This is a warning 2!\")\n\n~~~ Trace ~~~\n\nwarning(\"This is a warning 1!\")",
+    c(
+      "~~~ Warnings ~~~\n\n> This is a warning 1!\nwhen running code:\nwarning(\"This is a warning 1!\")\n\n> This is a warning 2!\nwhen running code:\nwarning(\"This is a warning 2!\")\n\n~~~ Trace ~~~\n\nwarning(\"This is a warning 1!\")",
       "~~~ Warnings ~~~\n\n> This is a warning 1!\nwhen running code:\nwarning(\"This is a warning 1!\")\n\n> This is a warning 2!\nwhen running code:\nwarning(\"This is a warning 2!\")\n\n~~~ Trace ~~~\n\nwarning(\"This is a warning 2!\")"
     )
   )
@@ -55,7 +56,7 @@ testthat::test_that("get_warnings accepts a qenv object with 1 warning eval_code
     eval_code(bquote("x <- 1")) %>%
     eval_code(bquote(warning("This is a warning 2!")))
   testthat::expect_identical(
-    get_warnings(q), #TODO fix
+    get_warnings(q), # TODO fix
     paste0(
       "~~~ Warnings ~~~\n\n> This is a warning 2!\nwhen running code:\nwarning(\"This is a warning 2!\")\n\n",
       "~~~ Trace ~~~\n\nx <- 1\nwarning(\"This is a warning 2!\")"
diff --git a/tests/testthat/test-qenv_join.R b/tests/testthat/test-qenv_join.R
index c728ad88..b86b3e9e 100644
--- a/tests/testthat/test-qenv_join.R
+++ b/tests/testthat/test-qenv_join.R
@@ -42,7 +42,7 @@ testthat::test_that("Joined qenv does not duplicate common code", {
     q@code,
     c("iris1 <- iris", "mtcars1 <- mtcars", "mtcars2 <- mtcars")
   )
-  testthat::expect_identical(q@id, c(q1@id, q2@id[2])) #TODO fix
+  testthat::expect_identical(q@id, c(q1@id, q2@id[2])) # TODO fix
 })
 
 testthat::test_that("Not able to join two qenvs if any of the shared objects changed", {
@@ -72,7 +72,7 @@ testthat::test_that("join does not duplicate code but adds only extra code", {
     list(iris1 = iris, iris2 = iris, mtcars1 = mtcars, mtcars2 = mtcars)
   )
 
-  testthat::expect_identical(q@id, c(q1@id, q2@id[2])) #TODO - fix this
+  testthat::expect_identical(q@id, c(q1@id, q2@id[2])) # TODO - fix this
 })
 
 testthat::test_that("Not possible to join qenvs which share some code when one of the shared object was modified", {
diff --git a/tests/testthat/test-qenv_subset.R b/tests/testthat/test-qenv_subset.R
index d490b7e3..cb0c4857 100644
--- a/tests/testthat/test-qenv_subset.R
+++ b/tests/testthat/test-qenv_subset.R
@@ -1,6 +1,6 @@
 testthat::test_that("subset extract proper objects", {
   q <- qenv()
-  code <- c("x<-1","a<-1;b<-2")
+  code <- c("x<-1", "a<-1;b<-2")
   q <- eval_code(q, code)
   object_names <- c("x", "a")
   qs <- subset(q, names = object_names)
@@ -9,7 +9,7 @@ testthat::test_that("subset extract proper objects", {
 
 testthat::test_that("subset extract proper code", {
   q <- qenv()
-  code <- c("x<-1","a<-1;b<-2")
+  code <- c("x<-1", "a<-1;b<-2")
   q <- eval_code(q, code)
   object_names <- c("x", "a")
   qs <- subset(q, names = object_names)
@@ -21,7 +21,7 @@ testthat::test_that("subset extract proper code", {
 
 testthat::test_that("subset preservers comments in the code", {
   q <- qenv()
-  code <- c("x<-1 #comment","a<-1;b<-2")
+  code <- c("x<-1 #comment", "a<-1;b<-2")
   q <- eval_code(q, code)
   qs <- subset(q, names = c("x", "a"))
   testthat::expect_identical(
@@ -41,5 +41,4 @@ testthat::test_that("subset extract proper elements of @id, @warnings and @messa
   testthat::expect_identical(qs@code, q@code[c(1, 3)])
   testthat::expect_identical(qs@warnings, q@warnings[c(1, 3)])
   testthat::expect_identical(qs@messages, q@messages[c(1, 3)])
-
 })

From 984c439e8673a5b37bffbddf6f9430d0ea7b07d4 Mon Sep 17 00:00:00 2001
From: Marcin <133694481+m7pr@users.noreply.github.com>
Date: Thu, 24 Oct 2024 14:47:39 +0200
Subject: [PATCH 05/98] Update R/qenv-get_code.R

Signed-off-by: Marcin <133694481+m7pr@users.noreply.github.com>
---
 R/qenv-get_code.R | 5 -----
 1 file changed, 5 deletions(-)

diff --git a/R/qenv-get_code.R b/R/qenv-get_code.R
index ba90c786..ac72d1d1 100644
--- a/R/qenv-get_code.R
+++ b/R/qenv-get_code.R
@@ -124,11 +124,6 @@ setMethod("get_code", signature = "qenv", function(object, deparse = TRUE, names
   }
 
   if (deparse) {
-    # if (length(code) == 0) {
-    #   code
-    # } else {
-    #   paste(code, collapse = "\n")
-    # }
     code
   } else {
     parse(text = paste(c("{", code, "}"), collapse = "\n"), keep.source = TRUE)

From a277b2d188843291f7b62f45a80d27961fc8729f Mon Sep 17 00:00:00 2001
From: m7pr <marcin.kosinski.mk1@roche.com>
Date: Fri, 25 Oct 2024 14:08:57 +0200
Subject: [PATCH 06/98] fix join qenv tests

---
 tests/testthat/test-qenv_join.R | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/tests/testthat/test-qenv_join.R b/tests/testthat/test-qenv_join.R
index b86b3e9e..ac5a1053 100644
--- a/tests/testthat/test-qenv_join.R
+++ b/tests/testthat/test-qenv_join.R
@@ -42,7 +42,7 @@ testthat::test_that("Joined qenv does not duplicate common code", {
     q@code,
     c("iris1 <- iris", "mtcars1 <- mtcars", "mtcars2 <- mtcars")
   )
-  testthat::expect_identical(q@id, c(q1@id, q2@id[2])) # TODO fix
+  testthat::expect_identical(q@id, c(q1@id, q2@id[3]))
 })
 
 testthat::test_that("Not able to join two qenvs if any of the shared objects changed", {
@@ -72,7 +72,7 @@ testthat::test_that("join does not duplicate code but adds only extra code", {
     list(iris1 = iris, iris2 = iris, mtcars1 = mtcars, mtcars2 = mtcars)
   )
 
-  testthat::expect_identical(q@id, c(q1@id, q2@id[2])) # TODO - fix this
+  testthat::expect_identical(q@id, c(q1@id, q2@id[3]))
 })
 
 testthat::test_that("Not possible to join qenvs which share some code when one of the shared object was modified", {

From 5f77d9db2be5d2e4cbc0cf9a98fbd11008543eed Mon Sep 17 00:00:00 2001
From: m7pr <marcin.kosinski.mk1@roche.com>
Date: Fri, 25 Oct 2024 14:15:42 +0200
Subject: [PATCH 07/98] adjust warning messages

---
 R/qenv-get_warnings.R                   |  2 +-
 tests/testthat/test-qenv_get_warnings.R | 11 ++++++-----
 2 files changed, 7 insertions(+), 6 deletions(-)

diff --git a/R/qenv-get_warnings.R b/R/qenv-get_warnings.R
index e9a16b97..18ee917a 100644
--- a/R/qenv-get_warnings.R
+++ b/R/qenv-get_warnings.R
@@ -52,7 +52,7 @@ setMethod("get_warnings", signature = c("qenv"), function(object) {
   sprintf(
     "~~~ Warnings ~~~\n\n%s\n\n~~~ Trace ~~~\n\n%s",
     paste(lines, collapse = "\n\n"),
-    get_code(object)
+    paste(get_code(object), collapse = "\n")
   )
 })
 
diff --git a/tests/testthat/test-qenv_get_warnings.R b/tests/testthat/test-qenv_get_warnings.R
index eb113f71..6b12a993 100644
--- a/tests/testthat/test-qenv_get_warnings.R
+++ b/tests/testthat/test-qenv_get_warnings.R
@@ -28,7 +28,7 @@ testthat::test_that("get_warnings accepts a qenv object with 2 warnings", {
     eval_code(bquote(warning("This is a warning 1!"))) %>%
     eval_code(bquote(warning("This is a warning 2!")))
   testthat::expect_identical(
-    get_warnings(q), # TODO fix
+    get_warnings(q),
     paste0(
       "~~~ Warnings ~~~\n\n> This is a warning 1!\nwhen running code:\nwarning(\"This is a warning 1!\")",
       "\n\n> This is a warning 2!\nwhen running code:\nwarning(\"This is a warning 2!\")\n\n",
@@ -42,11 +42,12 @@ testthat::test_that("get_warnings accepts a qenv object with a single eval_code
     warning("This is a warning 1!")
     warning("This is a warning 2!")
   }))
-  testthat::expect_identical( # TODO fix
+  testthat::expect_identical(
     get_warnings(q),
-    c(
-      "~~~ Warnings ~~~\n\n> This is a warning 1!\nwhen running code:\nwarning(\"This is a warning 1!\")\n\n> This is a warning 2!\nwhen running code:\nwarning(\"This is a warning 2!\")\n\n~~~ Trace ~~~\n\nwarning(\"This is a warning 1!\")",
-      "~~~ Warnings ~~~\n\n> This is a warning 1!\nwhen running code:\nwarning(\"This is a warning 1!\")\n\n> This is a warning 2!\nwhen running code:\nwarning(\"This is a warning 2!\")\n\n~~~ Trace ~~~\n\nwarning(\"This is a warning 2!\")"
+    paste0(
+      "~~~ Warnings ~~~\n\n> This is a warning 1!\nwhen running code:\nwarning(\"This is a warning 1!\")",
+      "\n\n> This is a warning 2!\nwhen running code:\nwarning(\"This is a warning 2!\")\n\n",
+      "~~~ Trace ~~~\n\nwarning(\"This is a warning 1!\")\nwarning(\"This is a warning 2!\")"
     )
   )
 })

From 84231109e247893776cac3b8c55439c7e80ccc29 Mon Sep 17 00:00:00 2001
From: m7pr <marcin.kosinski.mk1@roche.com>
Date: Fri, 25 Oct 2024 14:20:51 +0200
Subject: [PATCH 08/98] fix R CMD checks just for now

---
 vignettes/qenv.Rmd | 14 +++++++-------
 1 file changed, 7 insertions(+), 7 deletions(-)

diff --git a/vignettes/qenv.Rmd b/vignettes/qenv.Rmd
index 00fbf4ba..fc864e01 100644
--- a/vignettes/qenv.Rmd
+++ b/vignettes/qenv.Rmd
@@ -67,17 +67,17 @@ cat(get_code(q2))
 
 ### Substitutions
 In some cases, one may want to substitute some elements of the code before evaluation.
-Consider a case when a subset of `iris` is defined by an input value.
+Consider a case when a base::subset of `iris` is defined by an input value.
 ```{r}
 q <- qenv()
-q <- eval_code(q, quote(i <- subset(iris, Species == "setosa")))
+q <- eval_code(q, quote(i <- base::subset(iris, Species == "setosa")))
 q <- eval_code(q, substitute(
-  ii <- subset(iris, Species == species),
+  ii <- base::subset(iris, Species == species),
   env = list(species = "versicolor")
 ))
 input_value <- "virginica"
 q <- eval_code(q, substitute(
-  iii <- subset(iris, Species == species),
+  iii <- base::subset(iris, Species == species),
   env = list(species = input_value)
 ))
 
@@ -89,10 +89,10 @@ summary(q[["iii"]]$Species)
 A more convenient way to pass code with substitution is to use the `within` method.
 ```{r}
 qq <- qenv()
-qq <- within(qq, i <- subset(iris, Species == "setosa"))
-qq <- within(qq, ii <- subset(iris, Species == species), species = "versicolor")
+qq <- within(qq, i <- base::subset(iris, Species == "setosa"))
+qq <- within(qq, ii <- base::subset(iris, Species == species), species = "versicolor")
 input_value <- "virginica"
-qq <- within(qq, iii <- subset(iris, Species == species), species = input_value)
+qq <- within(qq, iii <- base::subset(iris, Species == species), species = input_value)
 
 summary(qq[["i"]]$Species)
 summary(qq[["ii"]]$Species)

From cc17c8ba7723c62b7aa2d51cb94da66dd7a5a805 Mon Sep 17 00:00:00 2001
From: m7pr <marcin.kosinski.mk1@roche.com>
Date: Fri, 25 Oct 2024 15:10:51 +0200
Subject: [PATCH 09/98] fix lintr

---
 R/qenv-eval_code.R | 2 +-
 R/qenv-subset.R    | 1 -
 2 files changed, 1 insertion(+), 2 deletions(-)

diff --git a/R/qenv-eval_code.R b/R/qenv-eval_code.R
index 5f7d2d14..df62a2ab 100644
--- a/R/qenv-eval_code.R
+++ b/R/qenv-eval_code.R
@@ -40,7 +40,7 @@ setMethod("eval_code", signature = c("qenv", "character"), function(object, code
   current_messages <- rep("", length(parsed_code))
 
 
-  for (i in 1:length(parsed_code)) {
+  for (i in seq_along(parsed_code)) {
     single_call <- parsed_code[i]
     # Using withCallingHandlers to capture warnings and messages.
     # Using tryCatch to capture the error and abort further evaluation.
diff --git a/R/qenv-subset.R b/R/qenv-subset.R
index f337a3da..c575557b 100644
--- a/R/qenv-subset.R
+++ b/R/qenv-subset.R
@@ -23,7 +23,6 @@
 setGeneric("subset", function(object, names) standardGeneric("subset"))
 
 setMethod("subset", signature = c("qenv"), function(object, names) {
-  # based on https://github.com/insightsengineering/teal/blob/a1087d2d3ff0c62393c3d5277cd5f184d543e2d9/R/teal_data_utils.R#L41-L64
   checkmate::assert_class(names, "character")
   names_in_env <- intersect(names, ls(get_env(object)))
   if (!length(names_in_env)) {

From 23911706ecf6fd2ef49b39b28fb4030cbc97e260 Mon Sep 17 00:00:00 2001
From: Marcin <133694481+m7pr@users.noreply.github.com>
Date: Fri, 25 Oct 2024 15:12:46 +0200
Subject: [PATCH 10/98] Update tests/testthat/test-qenv_get_warnings.R

Signed-off-by: Marcin <133694481+m7pr@users.noreply.github.com>
---
 tests/testthat/test-qenv_get_warnings.R | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/tests/testthat/test-qenv_get_warnings.R b/tests/testthat/test-qenv_get_warnings.R
index 6b12a993..119f53b8 100644
--- a/tests/testthat/test-qenv_get_warnings.R
+++ b/tests/testthat/test-qenv_get_warnings.R
@@ -57,7 +57,7 @@ testthat::test_that("get_warnings accepts a qenv object with 1 warning eval_code
     eval_code(bquote("x <- 1")) %>%
     eval_code(bquote(warning("This is a warning 2!")))
   testthat::expect_identical(
-    get_warnings(q), # TODO fix
+    get_warnings(q),
     paste0(
       "~~~ Warnings ~~~\n\n> This is a warning 2!\nwhen running code:\nwarning(\"This is a warning 2!\")\n\n",
       "~~~ Trace ~~~\n\nx <- 1\nwarning(\"This is a warning 2!\")"

From 3c8a070f435e5a75381f2efe1ed56494b022e1ad Mon Sep 17 00:00:00 2001
From: Marcin <133694481+m7pr@users.noreply.github.com>
Date: Fri, 25 Oct 2024 15:13:21 +0200
Subject: [PATCH 11/98] Update tests/testthat/test-qenv_get_warnings.R

Signed-off-by: Marcin <133694481+m7pr@users.noreply.github.com>
---
 tests/testthat/test-qenv_get_warnings.R | 8 +++++---
 1 file changed, 5 insertions(+), 3 deletions(-)

diff --git a/tests/testthat/test-qenv_get_warnings.R b/tests/testthat/test-qenv_get_warnings.R
index 119f53b8..5f286b85 100644
--- a/tests/testthat/test-qenv_get_warnings.R
+++ b/tests/testthat/test-qenv_get_warnings.R
@@ -45,9 +45,11 @@ testthat::test_that("get_warnings accepts a qenv object with a single eval_code
   testthat::expect_identical(
     get_warnings(q),
     paste0(
-      "~~~ Warnings ~~~\n\n> This is a warning 1!\nwhen running code:\nwarning(\"This is a warning 1!\")",
-      "\n\n> This is a warning 2!\nwhen running code:\nwarning(\"This is a warning 2!\")\n\n",
-      "~~~ Trace ~~~\n\nwarning(\"This is a warning 1!\")\nwarning(\"This is a warning 2!\")"
+      "~~~ Warnings ~~~\n\n",
+      "> This is a warning 1!\n> This is a warning 2!\nwhen running code:\n",
+      "warning(\"This is a warning 1!\")\nwarning(\"This is a warning 2!\")\n\n",
+      "~~~ Trace ~~~\n\n",
+      "warning(\"This is a warning 1!\")\nwarning(\"This is a warning 2!\")"
     )
   )
 })

From f8295f838e6de5e833f6730e1a2b12fcc77dbbd0 Mon Sep 17 00:00:00 2001
From: m7pr <marcin.kosinski.mk1@roche.com>
Date: Mon, 28 Oct 2024 10:10:20 +0100
Subject: [PATCH 12/98] fix get_warnings

---
 R/qenv-get_warnings.R                   |  7 +++----
 tests/testthat/test-qenv_get_warnings.R | 25 ++++++++++++++++---------
 2 files changed, 19 insertions(+), 13 deletions(-)

diff --git a/R/qenv-get_warnings.R b/R/qenv-get_warnings.R
index 18ee917a..c6d66b78 100644
--- a/R/qenv-get_warnings.R
+++ b/R/qenv-get_warnings.R
@@ -49,10 +49,9 @@ setMethod("get_warnings", signature = c("qenv"), function(object) {
   )
   lines <- Filter(Negate(is.null), lines)
 
-  sprintf(
-    "~~~ Warnings ~~~\n\n%s\n\n~~~ Trace ~~~\n\n%s",
-    paste(lines, collapse = "\n\n"),
-    paste(get_code(object), collapse = "\n")
+  paste0(
+    sprintf("~~~ Warnings ~~~\n\n%s\n\n", paste(lines, collapse = "\n\n")),
+    sprintf("~~~ Trace ~~~\n\n%s",paste(get_code(object), collapse = "\n"))
   )
 })
 
diff --git a/tests/testthat/test-qenv_get_warnings.R b/tests/testthat/test-qenv_get_warnings.R
index 5f286b85..9c1d4839 100644
--- a/tests/testthat/test-qenv_get_warnings.R
+++ b/tests/testthat/test-qenv_get_warnings.R
@@ -1,5 +1,5 @@
 testthat::test_that("get_warnings accepts a qenv object and returns character", {
-  q <- qenv() %>% eval_code(bquote(warning("This is a warning!")))
+  q <- eval_code(qenv(), bquote(warning("This is a warning!")))
   testthat::expect_identical(
     get_warnings(q),
     paste0(
@@ -10,7 +10,7 @@ testthat::test_that("get_warnings accepts a qenv object and returns character",
 })
 
 testthat::test_that("get_warnings accepts a qenv.error object and returns NULL", {
-  q <- qenv() %>% eval_code(bquote(error("This is a error!")))
+  q <- eval_code(qenv(), bquote(error("This is a error!")))
   testthat::expect_null(get_warnings(q))
 })
 
@@ -19,7 +19,7 @@ testthat::test_that("get_warnings accepts a NULL object and returns NULL", {
 })
 
 testthat::test_that("get_warnings accepts a qenv object with no warning and returns NULL", {
-  q <- qenv() %>% eval_code(bquote("x <- 1"))
+  q <- eval_code(qenv(), bquote("x <- 1"))
   testthat::expect_null(get_warnings(q))
 })
 
@@ -44,12 +44,19 @@ testthat::test_that("get_warnings accepts a qenv object with a single eval_code
   }))
   testthat::expect_identical(
     get_warnings(q),
-    paste0(
-      "~~~ Warnings ~~~\n\n",
-      "> This is a warning 1!\n> This is a warning 2!\nwhen running code:\n",
-      "warning(\"This is a warning 1!\")\nwarning(\"This is a warning 2!\")\n\n",
-      "~~~ Trace ~~~\n\n",
-      "warning(\"This is a warning 1!\")\nwarning(\"This is a warning 2!\")"
+    paste(c(
+      "~~~ Warnings ~~~\n",
+      "> This is a warning 1!",
+      "when running code:",
+      "warning(\"This is a warning 1!\")\n",
+      "> This is a warning 2!",
+      "when running code:",
+      "warning(\"This is a warning 2!\")\n",
+      "~~~ Trace ~~~\n",
+      "warning(\"This is a warning 1!\")",
+      "warning(\"This is a warning 2!\")"
+      ),
+      collapse = "\n"
     )
   )
 })

From 069538f07451266e1bc64dfb7e52beceed26b580 Mon Sep 17 00:00:00 2001
From: m7pr <marcin.kosinski.mk1@roche.com>
Date: Mon, 28 Oct 2024 10:10:42 +0100
Subject: [PATCH 13/98] move back to regular subset in examples without prefix

---
 tests/testthat/test-qenv_within.R | 10 +++++-----
 vignettes/qenv.Rmd                | 14 +++++++-------
 2 files changed, 12 insertions(+), 12 deletions(-)

diff --git a/tests/testthat/test-qenv_within.R b/tests/testthat/test-qenv_within.R
index ff8842a6..7c119590 100644
--- a/tests/testthat/test-qenv_within.R
+++ b/tests/testthat/test-qenv_within.R
@@ -79,28 +79,28 @@ testthat::test_that("external values can be injected into expressions through `.
 
   external_value <- "virginica"
   q <- within(q, {
-    i <- base::subset(iris, Species == species)
+    i <- subset(iris, Species == species)
   },
   species = external_value)
 
-  testthat::expect_identical(get_code(q), "i <- base::subset(iris, Species == \"virginica\")")
+  testthat::expect_identical(get_code(q), "i <- subset(iris, Species == \"virginica\")")
 })
 
 testthat::test_that("external values are not taken from calling frame", {
   q <- qenv()
   species <- "setosa"
   qq <- within(q, {
-    i <- base::subset(iris, Species == species)
+    i <- subset(iris, Species == species)
   })
   testthat::expect_s3_class(qq, "qenv.error")
   testthat::expect_error(get_code(qq), "object 'species' not found")
 
   qq <- within(q, {
-    i <- base::subset(iris, Species == species)
+    i <- subset(iris, Species == species)
   },
   species = species)
   testthat::expect_s4_class(qq, "qenv")
-  testthat::expect_identical(get_code(qq), "i <- base::subset(iris, Species == \"setosa\")")
+  testthat::expect_identical(get_code(qq), "i <- subset(iris, Species == \"setosa\")")
 })
 
 # nolint end
diff --git a/vignettes/qenv.Rmd b/vignettes/qenv.Rmd
index fc864e01..00fbf4ba 100644
--- a/vignettes/qenv.Rmd
+++ b/vignettes/qenv.Rmd
@@ -67,17 +67,17 @@ cat(get_code(q2))
 
 ### Substitutions
 In some cases, one may want to substitute some elements of the code before evaluation.
-Consider a case when a base::subset of `iris` is defined by an input value.
+Consider a case when a subset of `iris` is defined by an input value.
 ```{r}
 q <- qenv()
-q <- eval_code(q, quote(i <- base::subset(iris, Species == "setosa")))
+q <- eval_code(q, quote(i <- subset(iris, Species == "setosa")))
 q <- eval_code(q, substitute(
-  ii <- base::subset(iris, Species == species),
+  ii <- subset(iris, Species == species),
   env = list(species = "versicolor")
 ))
 input_value <- "virginica"
 q <- eval_code(q, substitute(
-  iii <- base::subset(iris, Species == species),
+  iii <- subset(iris, Species == species),
   env = list(species = input_value)
 ))
 
@@ -89,10 +89,10 @@ summary(q[["iii"]]$Species)
 A more convenient way to pass code with substitution is to use the `within` method.
 ```{r}
 qq <- qenv()
-qq <- within(qq, i <- base::subset(iris, Species == "setosa"))
-qq <- within(qq, ii <- base::subset(iris, Species == species), species = "versicolor")
+qq <- within(qq, i <- subset(iris, Species == "setosa"))
+qq <- within(qq, ii <- subset(iris, Species == species), species = "versicolor")
 input_value <- "virginica"
-qq <- within(qq, iii <- base::subset(iris, Species == species), species = input_value)
+qq <- within(qq, iii <- subset(iris, Species == species), species = input_value)
 
 summary(qq[["i"]]$Species)
 summary(qq[["ii"]]$Species)

From 9fad8dc9c2ee11ab7f997d39eb4b93e95f437591 Mon Sep 17 00:00:00 2001
From: m7pr <marcin.kosinski.mk1@roche.com>
Date: Mon, 28 Oct 2024 10:11:05 +0100
Subject: [PATCH 14/98] use `[.` instead of subset for qenv

---
 DESCRIPTION                                   |  2 +-
 NAMESPACE                                     |  2 +-
 R/qenv-extract.R                              | 36 +++++++++++++++
 R/qenv-subset.R                               | 46 -------------------
 man/qenv.Rd                                   | 39 ++++++++--------
 ...test-qenv_subset.R => test-qenv_extract.R} | 16 +++----
 6 files changed, 67 insertions(+), 74 deletions(-)
 create mode 100644 R/qenv-extract.R
 delete mode 100644 R/qenv-subset.R
 rename tests/testthat/{test-qenv_subset.R => test-qenv_extract.R} (67%)

diff --git a/DESCRIPTION b/DESCRIPTION
index e998f4ec..33ea7a52 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -58,13 +58,13 @@ Collate:
     'qenv-concat.R'
     'qenv-constructor.R'
     'qenv-eval_code.R'
+    'qenv-extract.R'
     'qenv-get_code.R'
     'qenv-get_env.R'
     'qenv-get_var.R'
     'qenv-get_warnings.R'
     'qenv-join.R'
     'qenv-show.R'
-    'qenv-subset.R'
     'qenv-within.R'
     'teal.code-package.R'
     'utils-get_code_dependency.R'
diff --git a/NAMESPACE b/NAMESPACE
index d6472510..8310d7b3 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -1,5 +1,6 @@
 # Generated by roxygen2: do not edit by hand
 
+S3method("[",qenv)
 S3method("[[",qenv.error)
 S3method(within,qenv)
 S3method(within,qenv.error)
@@ -13,7 +14,6 @@ export(get_warnings)
 export(join)
 export(new_qenv)
 export(qenv)
-export(subset)
 exportClasses(qenv)
 exportMethods(show)
 importFrom(lifecycle,badge)
diff --git a/R/qenv-extract.R b/R/qenv-extract.R
new file mode 100644
index 00000000..a3fc5a64
--- /dev/null
+++ b/R/qenv-extract.R
@@ -0,0 +1,36 @@
+#' @rdname qenv
+#' @order 2
+#'
+#' @section Subsetting:
+#' `x[names]` subsets objects in `qenv` environment and limit the code to the necessary to build limited objects.
+#'
+#' @param names (`character`) names of objects included in `qenv` to subset
+#'
+#' @examples
+#'
+#' # Subsetting
+#' q <- qenv()
+#' q <- eval_code(q, "a <- 1;b<-2")
+#' q["a"]
+#' q[c("a", "b")]
+#'
+#' @export
+`[.qenv` <- function(x, names) {
+  checkmate::assert_class(names, "character")
+  names_in_env <- intersect(names, ls(get_env(x)))
+  if (!length(names_in_env)) {
+    return(qenv())
+  }
+
+  limited_code <- get_code(x, names = names_in_env)
+  indexes <- which(x@code %in% limited_code)
+
+  x@env <- list2env(mget(x = names_in_env, envir = get_env(x)))
+  x@code <- limited_code
+  x@id <- x@id[indexes]
+  x@warnings <- x@warnings[indexes]
+  x@messages <- x@messages[indexes]
+
+  x
+}
+
diff --git a/R/qenv-subset.R b/R/qenv-subset.R
deleted file mode 100644
index c575557b..00000000
--- a/R/qenv-subset.R
+++ /dev/null
@@ -1,46 +0,0 @@
-#' Subset `qenv`
-#'
-#' @details
-#' Subset objects in `qenv` environment and limit the code to the necessary to build limited objects.
-#'
-#' @param object (`qenv`)
-#' @param names (`character`) names of objects included in `qenv` to subset
-#'
-#' @return
-#' `qenv` object
-#'
-#' @examples
-#' q <- qenv()
-#' q <- eval_code(q, "a <- 1;b<-2")
-#' q <- subset(q, "a")
-#'
-#' @name subset
-#' @rdname qenv
-#' @aliases subset,qenv-method
-#' @aliases subset,qenv.error,ANY-method
-#'
-#' @export
-setGeneric("subset", function(object, names) standardGeneric("subset"))
-
-setMethod("subset", signature = c("qenv"), function(object, names) {
-  checkmate::assert_class(names, "character")
-  names_in_env <- intersect(names, ls(get_env(object)))
-  if (!length(names_in_env)) {
-    return(qenv())
-  }
-
-  limited_code <- get_code(object, names = names_in_env)
-  indexes <- which(object@code %in% limited_code)
-
-  object@env <- list2env(mget(x = names_in_env, envir = get_env(object)))
-  object@code <- limited_code
-  object@id <- object@id[indexes]
-  object@warnings <- object@warnings[indexes]
-  object@messages <- object@messages[indexes]
-
-  object
-})
-
-setMethod("subset", signature = c("qenv.error", "ANY"), function(object, names) {
-  object
-})
diff --git a/man/qenv.Rd b/man/qenv.Rd
index 84ad3305..552b3072 100644
--- a/man/qenv.Rd
+++ b/man/qenv.Rd
@@ -1,7 +1,8 @@
 % Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/qenv-constructor.R, R/qenv-eval_code.R,
-%   R/qenv-get_code.R, R/qenv-subset.R, R/qenv-within.R
-\name{qenv}
+% Please edit documentation in R/qenv-extract.R, R/qenv-constructor.R,
+%   R/qenv-eval_code.R, R/qenv-get_code.R, R/qenv-within.R
+\name{[.qenv}
+\alias{[.qenv}
 \alias{qenv}
 \alias{new_qenv}
 \alias{new_qenv,environment,expression-method}
@@ -17,12 +18,11 @@
 \alias{get_code}
 \alias{get_code,qenv-method}
 \alias{get_code,qenv.error-method}
-\alias{subset}
-\alias{subset,qenv-method}
-\alias{subset,qenv.error,ANY-method}
 \alias{within.qenv}
 \title{Code tracking with \code{qenv} object}
 \usage{
+\method{[}{qenv}(x, names)
+
 qenv()
 
 new_qenv(env = new.env(parent = parent.env(.GlobalEnv)), code = character())
@@ -31,11 +31,12 @@ eval_code(object, code)
 
 get_code(object, deparse = TRUE, names = NULL, ...)
 
-subset(object, names)
-
 \method{within}{qenv}(data, expr, ...)
 }
 \arguments{
+\item{names}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} (\code{character}) vector of object names to return the code for.
+For more details see the "Extracting dataset-specific code" section.}
+
 \item{env}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} (\code{environment})
 Environment being a result of the \code{code} evaluation.}
 
@@ -45,8 +46,6 @@ Environment being a result of the \code{code} evaluation.}
 
 \item{deparse}{(\code{logical(1)}) flag specifying whether to return code as \code{character} or \code{expression}.}
 
-\item{names}{(\code{character}) names of objects included in \code{qenv} to subset}
-
 \item{...}{see \code{Details}}
 
 \item{data}{(\code{qenv})}
@@ -60,8 +59,6 @@ Environment being a result of the \code{code} evaluation.}
 
 \code{get_code} returns the traced code (from \verb{@code} slot) in the form specified by \code{deparse}.
 
-\code{qenv} object
-
 \code{within} returns a \code{qenv} object with \code{expr} evaluated or \code{qenv.error} if evaluation fails.
 }
 \description{
@@ -81,14 +78,17 @@ Thus, if the \code{qenv} had been instantiated empty, contents of the environmen
 
 \code{get_code} retrieves the code stored in the \code{qenv}. \code{...} passes arguments to methods.
 
-Subset objects in \code{qenv} environment and limit the code to the necessary to build limited objects.
-
 \code{within} is a convenience function for evaluating inline code inside the environment of a \code{qenv}.
 It is a method for the \code{base} generic that wraps \code{eval_code} to provide a simplified way of passing code.
 \code{within} accepts only inline expressions (both simple and compound) and allows for injecting values into \code{expr}
 through the \code{...} argument:
 as \code{name:value} pairs are passed to \code{...}, \code{name} in \code{expr} will be replaced with \code{value}.
 }
+\section{Subsetting}{
+
+\code{x[names]} subsets objects in \code{qenv} environment and limit the code to the necessary to build limited objects.
+}
+
 \section{Extracting dataset-specific code}{
 
 When \code{names} is specified, the code returned will be limited  to the lines needed to \emph{create}
@@ -167,6 +167,13 @@ Only single \code{expression}s will work and substitution is not available. See
 }
 
 \examples{
+
+# Subsetting
+q <- qenv()
+q <- eval_code(q, "a <- 1;b<-2")
+q["a"]
+q[c("a", "b")]
+
 # create empty qenv
 qenv()
 
@@ -194,10 +201,6 @@ q <- qenv()
 q <- eval_code(q, code = c("a <- 1", "b <- 2"))
 get_code(q, names = "a")
 
-q <- qenv()
-q <- eval_code(q, "a <- 1;b<-2")
-q <- subset(q, "a")
-
 # evaluate code using within
 q <- qenv()
 q <- within(q, {
diff --git a/tests/testthat/test-qenv_subset.R b/tests/testthat/test-qenv_extract.R
similarity index 67%
rename from tests/testthat/test-qenv_subset.R
rename to tests/testthat/test-qenv_extract.R
index cb0c4857..18064f60 100644
--- a/tests/testthat/test-qenv_subset.R
+++ b/tests/testthat/test-qenv_extract.R
@@ -1,41 +1,41 @@
-testthat::test_that("subset extract proper objects", {
+testthat::test_that("`[.` extracts proper objects", {
   q <- qenv()
   code <- c("x<-1", "a<-1;b<-2")
   q <- eval_code(q, code)
   object_names <- c("x", "a")
-  qs <- subset(q, names = object_names)
+  qs <- q[object_names]
   testthat::expect_true(all(ls(get_env(qs)) %in% object_names))
 })
 
-testthat::test_that("subset extract proper code", {
+testthat::test_that("`[.` extract proper code", {
   q <- qenv()
   code <- c("x<-1", "a<-1;b<-2")
   q <- eval_code(q, code)
   object_names <- c("x", "a")
-  qs <- subset(q, names = object_names)
+  qs <- q[object_names]
   testthat::expect_identical(
     qs@code,
     c("x <- 1", "a <- 1")
   )
 })
 
-testthat::test_that("subset preservers comments in the code", {
+testthat::test_that("`[.` preservers comments in the code", {
   q <- qenv()
   code <- c("x<-1 #comment", "a<-1;b<-2")
   q <- eval_code(q, code)
-  qs <- subset(q, names = c("x", "a"))
+  qs <- q[c("x", "a")]
   testthat::expect_identical(
     qs@code,
     c("x <- 1 #comment", "a <- 1")
   )
 })
 
-testthat::test_that("subset extract proper elements of @id, @warnings and @messages fiels", {
+testthat::test_that("`[.` extract proper elements of @id, @warnings and @messages fiels", {
   q <- qenv()
   code <-
     c("x<-1 #comment", "message('tiny message')", "a<-1;b<-2;warning('small warning')")
   q <- eval_code(q, code)
-  qs <- subset(q, names = c("x", "a"))
+  qs <- q[c("x", "a")]
 
   testthat::expect_identical(qs@id, q@id[c(1, 3)])
   testthat::expect_identical(qs@code, q@code[c(1, 3)])

From 0b42371572a7279867a656bc91a1551b793df631 Mon Sep 17 00:00:00 2001
From: m7pr <marcin.kosinski.mk1@roche.com>
Date: Mon, 28 Oct 2024 10:25:02 +0100
Subject: [PATCH 15/98] document x

---
 R/qenv-extract.R |  7 ++++---
 man/qenv.Rd      | 36 +++++++++++++++++++-----------------
 2 files changed, 23 insertions(+), 20 deletions(-)

diff --git a/R/qenv-extract.R b/R/qenv-extract.R
index a3fc5a64..adb02664 100644
--- a/R/qenv-extract.R
+++ b/R/qenv-extract.R
@@ -1,10 +1,9 @@
-#' @rdname qenv
-#' @order 2
 #'
 #' @section Subsetting:
-#' `x[names]` subsets objects in `qenv` environment and limit the code to the necessary to build limited objects.
+#' `x[names]` subsets objects in `qenv` environment and limit the code to the necessary needed to build limited objects.
 #'
 #' @param names (`character`) names of objects included in `qenv` to subset
+#' @param x (`qenv`)
 #'
 #' @examples
 #'
@@ -14,6 +13,8 @@
 #' q["a"]
 #' q[c("a", "b")]
 #'
+#' @rdname qenv
+#'
 #' @export
 `[.qenv` <- function(x, names) {
   checkmate::assert_class(names, "character")
diff --git a/man/qenv.Rd b/man/qenv.Rd
index 552b3072..b4c6fb85 100644
--- a/man/qenv.Rd
+++ b/man/qenv.Rd
@@ -1,8 +1,7 @@
 % Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/qenv-extract.R, R/qenv-constructor.R,
-%   R/qenv-eval_code.R, R/qenv-get_code.R, R/qenv-within.R
-\name{[.qenv}
-\alias{[.qenv}
+% Please edit documentation in R/qenv-constructor.R, R/qenv-eval_code.R,
+%   R/qenv-extract.R, R/qenv-get_code.R, R/qenv-within.R
+\name{qenv}
 \alias{qenv}
 \alias{new_qenv}
 \alias{new_qenv,environment,expression-method}
@@ -15,28 +14,26 @@
 \alias{eval_code,qenv,language-method}
 \alias{eval_code,qenv,expression-method}
 \alias{eval_code,qenv.error,ANY-method}
+\alias{[.qenv}
 \alias{get_code}
 \alias{get_code,qenv-method}
 \alias{get_code,qenv.error-method}
 \alias{within.qenv}
 \title{Code tracking with \code{qenv} object}
 \usage{
-\method{[}{qenv}(x, names)
-
 qenv()
 
 new_qenv(env = new.env(parent = parent.env(.GlobalEnv)), code = character())
 
 eval_code(object, code)
 
+\method{[}{qenv}(x, names)
+
 get_code(object, deparse = TRUE, names = NULL, ...)
 
 \method{within}{qenv}(data, expr, ...)
 }
 \arguments{
-\item{names}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} (\code{character}) vector of object names to return the code for.
-For more details see the "Extracting dataset-specific code" section.}
-
 \item{env}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} (\code{environment})
 Environment being a result of the \code{code} evaluation.}
 
@@ -44,6 +41,11 @@ Environment being a result of the \code{code} evaluation.}
 
 \item{object}{(\code{qenv})}
 
+\item{x}{(\code{qenv})}
+
+\item{names}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} (\code{character}) vector of object names to return the code for.
+For more details see the "Extracting dataset-specific code" section.}
+
 \item{deparse}{(\code{logical(1)}) flag specifying whether to return code as \code{character} or \code{expression}.}
 
 \item{...}{see \code{Details}}
@@ -86,7 +88,7 @@ as \code{name:value} pairs are passed to \code{...}, \code{name} in \code{expr}
 }
 \section{Subsetting}{
 
-\code{x[names]} subsets objects in \code{qenv} environment and limit the code to the necessary to build limited objects.
+\code{x[names]} subsets objects in \code{qenv} environment and limit the code to the necessary needed to build limited objects.
 }
 
 \section{Extracting dataset-specific code}{
@@ -167,13 +169,6 @@ Only single \code{expression}s will work and substitution is not available. See
 }
 
 \examples{
-
-# Subsetting
-q <- qenv()
-q <- eval_code(q, "a <- 1;b<-2")
-q["a"]
-q[c("a", "b")]
-
 # create empty qenv
 qenv()
 
@@ -188,6 +183,13 @@ q <- eval_code(q, "a <- 1")
 q <- eval_code(q, quote(library(checkmate)))
 q <- eval_code(q, expression(assert_number(a)))
 
+
+# Subsetting
+q <- qenv()
+q <- eval_code(q, "a <- 1;b<-2")
+q["a"]
+q[c("a", "b")]
+
 # retrieve code
 q <- within(qenv(), {
   a <- 1

From 2e53db43c5d9749f9443dbbc7450aab284e112c8 Mon Sep 17 00:00:00 2001
From: github-actions <41898282+github-actions[bot]@users.noreply.github.com>
Date: Mon, 28 Oct 2024 09:27:14 +0000
Subject: [PATCH 16/98] [skip style] [skip vbump] Restyle files

---
 R/qenv-extract.R                        |  1 -
 R/qenv-get_warnings.R                   |  2 +-
 tests/testthat/test-qenv_get_warnings.R | 23 ++++++++++++-----------
 3 files changed, 13 insertions(+), 13 deletions(-)

diff --git a/R/qenv-extract.R b/R/qenv-extract.R
index adb02664..73baba1d 100644
--- a/R/qenv-extract.R
+++ b/R/qenv-extract.R
@@ -34,4 +34,3 @@
 
   x
 }
-
diff --git a/R/qenv-get_warnings.R b/R/qenv-get_warnings.R
index c6d66b78..be3d05be 100644
--- a/R/qenv-get_warnings.R
+++ b/R/qenv-get_warnings.R
@@ -51,7 +51,7 @@ setMethod("get_warnings", signature = c("qenv"), function(object) {
 
   paste0(
     sprintf("~~~ Warnings ~~~\n\n%s\n\n", paste(lines, collapse = "\n\n")),
-    sprintf("~~~ Trace ~~~\n\n%s",paste(get_code(object), collapse = "\n"))
+    sprintf("~~~ Trace ~~~\n\n%s", paste(get_code(object), collapse = "\n"))
   )
 })
 
diff --git a/tests/testthat/test-qenv_get_warnings.R b/tests/testthat/test-qenv_get_warnings.R
index 9c1d4839..01100a75 100644
--- a/tests/testthat/test-qenv_get_warnings.R
+++ b/tests/testthat/test-qenv_get_warnings.R
@@ -44,17 +44,18 @@ testthat::test_that("get_warnings accepts a qenv object with a single eval_code
   }))
   testthat::expect_identical(
     get_warnings(q),
-    paste(c(
-      "~~~ Warnings ~~~\n",
-      "> This is a warning 1!",
-      "when running code:",
-      "warning(\"This is a warning 1!\")\n",
-      "> This is a warning 2!",
-      "when running code:",
-      "warning(\"This is a warning 2!\")\n",
-      "~~~ Trace ~~~\n",
-      "warning(\"This is a warning 1!\")",
-      "warning(\"This is a warning 2!\")"
+    paste(
+      c(
+        "~~~ Warnings ~~~\n",
+        "> This is a warning 1!",
+        "when running code:",
+        "warning(\"This is a warning 1!\")\n",
+        "> This is a warning 2!",
+        "when running code:",
+        "warning(\"This is a warning 2!\")\n",
+        "~~~ Trace ~~~\n",
+        "warning(\"This is a warning 1!\")",
+        "warning(\"This is a warning 2!\")"
       ),
       collapse = "\n"
     )

From 7844ee80e83a730912c20bae2a4cf0629e04c9c9 Mon Sep 17 00:00:00 2001
From: m7pr <marcin.kosinski.mk1@roche.com>
Date: Tue, 29 Oct 2024 10:21:36 +0100
Subject: [PATCH 17/98] add a warning

---
 R/qenv-extract.R | 1 +
 1 file changed, 1 insertion(+)

diff --git a/R/qenv-extract.R b/R/qenv-extract.R
index 73baba1d..82277b57 100644
--- a/R/qenv-extract.R
+++ b/R/qenv-extract.R
@@ -20,6 +20,7 @@
   checkmate::assert_class(names, "character")
   names_in_env <- intersect(names, ls(get_env(x)))
   if (!length(names_in_env)) {
+    warning("None of `names` elements exist in `qenv`. Returning empty `qenv`.")
     return(qenv())
   }
 

From 38bd16fb25b6a3a27d473d41e5694155cb29ccbf Mon Sep 17 00:00:00 2001
From: m7pr <marcin.kosinski.mk1@roche.com>
Date: Tue, 29 Oct 2024 12:04:50 +0100
Subject: [PATCH 18/98] use fix shifted comments in extract comments

---
 R/utils-get_code_dependency.R       | 27 ++++++++++----
 tests/testthat/test-qenv_get_code.R | 55 +++++++++++++++++++++++++++++
 2 files changed, 75 insertions(+), 7 deletions(-)

diff --git a/R/utils-get_code_dependency.R b/R/utils-get_code_dependency.R
index 955e2d90..a20450ff 100644
--- a/R/utils-get_code_dependency.R
+++ b/R/utils-get_code_dependency.R
@@ -141,12 +141,12 @@ get_children <- function(pd, parent) {
 #' Fixes edge case of comments being shifted to the next call.
 #' @keywords internal
 #' @noRd
-fix_shifted_comments <- function(calls) {
+fix_shifted_comments <- function(calls, pattern = "@linksto") {
   # If the first or the second token is a @linksto COMMENT,
   #  then it belongs to the previous call.
   if (length(calls) >= 2) {
     for (i in 2:length(calls)) {
-      comment_idx <- grep("@linksto", calls[[i]][, "text"])
+      comment_idx <- grep(pattern, calls[[i]][, "text"])
       if (isTRUE(comment_idx[1] <= 2)) {
         calls[[i - 1]] <- rbind(
           calls[[i - 1]],
@@ -156,7 +156,20 @@ fix_shifted_comments <- function(calls) {
       }
     }
   }
-  Filter(nrow, calls)
+  calls <- Filter(nrow, calls)
+  # If, after shifting, there are two COMMENTs in one call, paste them.
+  merge_comments <- function(call) {
+    if (sum(call$token == "COMMENT") >= 2) {
+      comments <- call[call$token == "COMMENT", "text"]
+      first_comment_row <- call[which(call$token == "COMMENT")[1], ]
+      call <- call[call$token != "COMMENT", ]
+      first_comment_row$text <- paste(comments, collapse = " ")
+      rbind(call, first_comment_row)
+    } else {
+      call
+    }
+  }
+  lapply(calls, merge_comments)
 }
 
 #' Fixes edge case of `<-` assignment operator being called as function,
@@ -466,8 +479,8 @@ extract_comments <- function(parsed_code) {
     comment <- call[call$token == "COMMENT", "text"]
     if (length(comment) == 0) "" else comment
   }
-  unlist(lapply(
-    extract_calls(utils::getParseData(parsed_code)),
-    get_comments
-  ))
+  calls <- extract_calls(utils::getParseData(parsed_code))
+  fixed_calls <- fix_shifted_comments(calls, pattern = "#")
+
+  unlist(lapply(fixed_calls, get_comments))
 }
diff --git a/tests/testthat/test-qenv_get_code.R b/tests/testthat/test-qenv_get_code.R
index 39183a88..159a83ee 100644
--- a/tests/testthat/test-qenv_get_code.R
+++ b/tests/testthat/test-qenv_get_code.R
@@ -448,6 +448,61 @@ testthat::test_that(
   }
 )
 
+
+# comments --------------------------------------------------------------------------------------------------------
+
+testthat::test_that("comments fall into proper calls", {
+
+  # If comment is on top, it gets moved to the first call.
+  # Any other comment gets moved to the call above.
+  code <- "
+    # initial comment
+    a <- 1
+    b <- 2 # inline comment
+    c <- 3
+    # inbetween comment
+    d <- 4
+    # finishing comment
+  "
+
+  q <- qenv() |> eval_code(code)
+  testthat::expect_identical(
+    get_code(q),
+    c("a <- 1 # initial comment",
+      "b <- 2 # inline comment",
+      "c <- 3 # inbetween comment",
+      "d <- 4 # finishing comment")
+  )
+
+})
+
+testthat::test_that("comments get pasted when they fall into calls", {
+
+  # If comment is on top, it gets moved to the first call.
+  # Any other comment gets moved to the call above.
+  # Comments get pasted if there are two assigned to the same call.
+  code <- "
+    # initial comment
+    a <- 1 # A comment
+    b <- 2 # inline comment
+    c <- 3 # C comment
+    # inbetween comment
+    d <- 4
+    # finishing comment
+  "
+
+  q <- qenv() |> eval_code(code)
+  testthat::expect_identical(
+    get_code(q),
+    c("a <- 1 # initial comment # A comment",
+      "b <- 2 # inline comment",
+      "c <- 3 # C comment # inbetween comment",
+      "d <- 4 # finishing comment"
+    )
+  )
+
+})
+
 # functions -------------------------------------------------------------------------------------------------------
 
 testthat::test_that("ignores occurrence in a function definition", {

From 8b0faa32f64737a6b38315a8083fb012329588b4 Mon Sep 17 00:00:00 2001
From: github-actions <41898282+github-actions[bot]@users.noreply.github.com>
Date: Tue, 29 Oct 2024 11:06:58 +0000
Subject: [PATCH 19/98] [skip style] [skip vbump] Restyle files

---
 tests/testthat/test-qenv_get_code.R | 13 ++++++-------
 1 file changed, 6 insertions(+), 7 deletions(-)

diff --git a/tests/testthat/test-qenv_get_code.R b/tests/testthat/test-qenv_get_code.R
index 159a83ee..bc1152ed 100644
--- a/tests/testthat/test-qenv_get_code.R
+++ b/tests/testthat/test-qenv_get_code.R
@@ -452,7 +452,6 @@ testthat::test_that(
 # comments --------------------------------------------------------------------------------------------------------
 
 testthat::test_that("comments fall into proper calls", {
-
   # If comment is on top, it gets moved to the first call.
   # Any other comment gets moved to the call above.
   code <- "
@@ -468,16 +467,16 @@ testthat::test_that("comments fall into proper calls", {
   q <- qenv() |> eval_code(code)
   testthat::expect_identical(
     get_code(q),
-    c("a <- 1 # initial comment",
+    c(
+      "a <- 1 # initial comment",
       "b <- 2 # inline comment",
       "c <- 3 # inbetween comment",
-      "d <- 4 # finishing comment")
+      "d <- 4 # finishing comment"
+    )
   )
-
 })
 
 testthat::test_that("comments get pasted when they fall into calls", {
-
   # If comment is on top, it gets moved to the first call.
   # Any other comment gets moved to the call above.
   # Comments get pasted if there are two assigned to the same call.
@@ -494,13 +493,13 @@ testthat::test_that("comments get pasted when they fall into calls", {
   q <- qenv() |> eval_code(code)
   testthat::expect_identical(
     get_code(q),
-    c("a <- 1 # initial comment # A comment",
+    c(
+      "a <- 1 # initial comment # A comment",
       "b <- 2 # inline comment",
       "c <- 3 # C comment # inbetween comment",
       "d <- 4 # finishing comment"
     )
   )
-
 })
 
 # functions -------------------------------------------------------------------------------------------------------

From 56b5c8e824383a4762c53f0dc78b566888eabeda Mon Sep 17 00:00:00 2001
From: m7pr <marcin.kosinski.mk1@roche.com>
Date: Tue, 29 Oct 2024 16:42:52 +0100
Subject: [PATCH 20/98] prototype of the function that divides the character
 code by calls, and keeps comments

---
 R/extract_code_as_is_prototype.R | 94 ++++++++++++++++++++++++++++++++
 1 file changed, 94 insertions(+)
 create mode 100644 R/extract_code_as_is_prototype.R

diff --git a/R/extract_code_as_is_prototype.R b/R/extract_code_as_is_prototype.R
new file mode 100644
index 00000000..2f4cd2f9
--- /dev/null
+++ b/R/extract_code_as_is_prototype.R
@@ -0,0 +1,94 @@
+code <- "
+  # initial comment line 1
+  # initial comment line 2
+  a <- 1 # A comment
+  b1 <- 2; b2 <- 2;b3 = 3 # inline comment
+  c <- 3 # C comment
+  # inbetween comment
+  d <- 4
+  # finishing comment line 1
+  # finishing comment line 2
+"
+
+parsed_code <- parse(text = code)
+comments <- extract_comments(parsed_code)
+pd <- utils::getParseData(parsed_code)
+
+pd <- pd[pd$token != "';'", ]
+
+get_line_ids <- function(pd) {
+  if (pd$token[1] == "COMMENT") {
+    first_comment <- 1:(which(pd$parent == 0)[1]-1)
+    pd_first_comment <- pd[first_comment, ]
+    pd <- pd[-first_comment, ]
+
+    n <- nrow(pd_first_comment)
+    first_comment_ids <- data.frame(
+      lines = c(pd_first_comment[1, "line1"], pd_first_comment[n, "line2"]),
+      cols = c(pd_first_comment[1, "col1"], pd_first_comment[n, "col2"])
+    )
+  } else {
+    first_comment_ids <- NULL
+  }
+
+  if (pd$token[nrow(pd)] == "COMMENT") {
+    last_comment <- which(pd$parent == 0 & pd$token == "COMMENT")
+    pd_last_comment <- pd[last_comment, ]
+    pd <- pd[-last_comment, ]
+
+    n <- nrow(pd_last_comment)
+    last_comment_ids <- data.frame(
+      lines = c(pd_last_comment[1, "line1"], pd_last_comment[n, "line2"]),
+      cols = c(pd_last_comment[1, "col1"], pd_last_comment[n, "col2"])
+    )
+  } else {
+    last_comment_ids <- NULL
+  }
+
+
+  calls_start <- which(pd$parent == 0)
+  calls_end   <- c(which(pd$parent == 0)[-1] - 1, nrow(pd))
+
+  call_ids <- list()
+  for(i in seq_along(calls_start)) {
+    call <- pd[c(calls_start[i], calls_end[i]), ]
+    call_ids[[i]] <-
+      data.frame(
+       lines = c(call[1, "line1"], call[2, "line2"]),
+       cols = c(call[1, "col1"], call[2, "col2"])
+      )
+  }
+
+
+  Filter(Negate(is.null), c(list(first_comment_ids), call_ids, list(last_comment_ids)))
+}
+
+split_code <- function(code, lines_ids) {
+
+  code_split <- strsplit(code, split = "\n", fixed = TRUE)[[1]]
+  code_split_calls <- list()
+
+  for(i in seq_along(lines_ids)) {
+
+    code_lines <- code_split[lines_ids[[i]]$lines[1]:lines_ids[[i]]$lines[2]]
+
+    if (length(code_lines) == 1) {
+      code_lines <- substr(code_lines, lines_ids[[i]]$cols[1], lines_ids[[i]]$cols[2])
+    } else {
+      code_lines[1] <- substr(code_lines[1], lines_ids[[i]]$cols[1], nchar(code_lines[1]))
+      code_lines[length(code_lines)] <- substr(code_lines[length(code_lines)], 1, lines_ids[[i]]$cols[2])
+    }
+
+
+    code_split_calls[[i]] <- paste(code_lines, collapse = "\n")
+  }
+  code_split_calls
+}
+
+lines_ids <- get_line_ids(pd)
+
+code_by_calls <- split_code(code, lines_ids)
+
+code_by_calls
+
+

From 15a6cd7e78a7b4c141f47198a7e60a5d8975b50d Mon Sep 17 00:00:00 2001
From: github-actions <41898282+github-actions[bot]@users.noreply.github.com>
Date: Tue, 29 Oct 2024 15:45:42 +0000
Subject: [PATCH 21/98] [skip style] [skip vbump] Restyle files

---
 R/extract_code_as_is_prototype.R | 16 ++++++----------
 1 file changed, 6 insertions(+), 10 deletions(-)

diff --git a/R/extract_code_as_is_prototype.R b/R/extract_code_as_is_prototype.R
index 2f4cd2f9..663fcf80 100644
--- a/R/extract_code_as_is_prototype.R
+++ b/R/extract_code_as_is_prototype.R
@@ -18,7 +18,7 @@ pd <- pd[pd$token != "';'", ]
 
 get_line_ids <- function(pd) {
   if (pd$token[1] == "COMMENT") {
-    first_comment <- 1:(which(pd$parent == 0)[1]-1)
+    first_comment <- 1:(which(pd$parent == 0)[1] - 1)
     pd_first_comment <- pd[first_comment, ]
     pd <- pd[-first_comment, ]
 
@@ -47,15 +47,15 @@ get_line_ids <- function(pd) {
 
 
   calls_start <- which(pd$parent == 0)
-  calls_end   <- c(which(pd$parent == 0)[-1] - 1, nrow(pd))
+  calls_end <- c(which(pd$parent == 0)[-1] - 1, nrow(pd))
 
   call_ids <- list()
-  for(i in seq_along(calls_start)) {
+  for (i in seq_along(calls_start)) {
     call <- pd[c(calls_start[i], calls_end[i]), ]
     call_ids[[i]] <-
       data.frame(
-       lines = c(call[1, "line1"], call[2, "line2"]),
-       cols = c(call[1, "col1"], call[2, "col2"])
+        lines = c(call[1, "line1"], call[2, "line2"]),
+        cols = c(call[1, "col1"], call[2, "col2"])
       )
   }
 
@@ -64,12 +64,10 @@ get_line_ids <- function(pd) {
 }
 
 split_code <- function(code, lines_ids) {
-
   code_split <- strsplit(code, split = "\n", fixed = TRUE)[[1]]
   code_split_calls <- list()
 
-  for(i in seq_along(lines_ids)) {
-
+  for (i in seq_along(lines_ids)) {
     code_lines <- code_split[lines_ids[[i]]$lines[1]:lines_ids[[i]]$lines[2]]
 
     if (length(code_lines) == 1) {
@@ -90,5 +88,3 @@ lines_ids <- get_line_ids(pd)
 code_by_calls <- split_code(code, lines_ids)
 
 code_by_calls
-
-

From 8ddff1baa33a91c91d651ef053f30ac0dec1adff Mon Sep 17 00:00:00 2001
From: m7pr <marcin.kosinski.mk1@roche.com>
Date: Tue, 29 Oct 2024 16:54:43 +0100
Subject: [PATCH 22/98] clean examples from prototype script

---
 R/extract_code_as_is_prototype.R | 43 ++++++++++++++++----------------
 1 file changed, 21 insertions(+), 22 deletions(-)

diff --git a/R/extract_code_as_is_prototype.R b/R/extract_code_as_is_prototype.R
index 2f4cd2f9..6afeeff9 100644
--- a/R/extract_code_as_is_prototype.R
+++ b/R/extract_code_as_is_prototype.R
@@ -1,21 +1,3 @@
-code <- "
-  # initial comment line 1
-  # initial comment line 2
-  a <- 1 # A comment
-  b1 <- 2; b2 <- 2;b3 = 3 # inline comment
-  c <- 3 # C comment
-  # inbetween comment
-  d <- 4
-  # finishing comment line 1
-  # finishing comment line 2
-"
-
-parsed_code <- parse(text = code)
-comments <- extract_comments(parsed_code)
-pd <- utils::getParseData(parsed_code)
-
-pd <- pd[pd$token != "';'", ]
-
 get_line_ids <- function(pd) {
   if (pd$token[1] == "COMMENT") {
     first_comment <- 1:(which(pd$parent == 0)[1]-1)
@@ -85,10 +67,27 @@ split_code <- function(code, lines_ids) {
   code_split_calls
 }
 
-lines_ids <- get_line_ids(pd)
-
-code_by_calls <- split_code(code, lines_ids)
+# EXAMPLE
+# code <- "
+#   # initial comment line 1
+#   # initial comment line 2
+#   a <- 1 # A comment
+#   b1 <- 2; b2 <- 2;b3 = 3 # inline comment
+#   c <- 3 # C comment
+#   # inbetween comment
+#   d <- 4
+#   # finishing comment line 1
+#   # finishing comment line 2
+# "
+#
+# parsed_code <- parse(text = code)
+# comments <- extract_comments(parsed_code)
+# pd <- utils::getParseData(parsed_code)
+#
+# pd <- pd[pd$token != "';'", ]
+# lines_ids <- get_line_ids(pd)
+# code_by_calls <- split_code(code, lines_ids)
+# code_by_calls
 
-code_by_calls
 
 

From f0b0e9ed46eed09020d1517f5b42960510e5e6f5 Mon Sep 17 00:00:00 2001
From: "27856297+dependabot-preview[bot]@users.noreply.github.com"
 <27856297+dependabot-preview[bot]@users.noreply.github.com>
Date: Tue, 29 Oct 2024 15:57:27 +0000
Subject: [PATCH 23/98] [skip roxygen] [skip vbump] Roxygen Man Pages Auto
 Update

---
 DESCRIPTION | 1 +
 1 file changed, 1 insertion(+)

diff --git a/DESCRIPTION b/DESCRIPTION
index 7a1ccff3..42fd8ed3 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -53,6 +53,7 @@ Language: en-US
 Roxygen: list(markdown = TRUE)
 RoxygenNote: 7.3.2
 Collate:
+    'extract_code_as_is_prototype.R'
     'qenv-class.R'
     'qenv-errors.R'
     'qenv-concat.R'

From a1a73fafaed29cbe5fe24f24e4daa0523294b394 Mon Sep 17 00:00:00 2001
From: github-actions <41898282+github-actions[bot]@users.noreply.github.com>
Date: Tue, 29 Oct 2024 15:57:35 +0000
Subject: [PATCH 24/98] [skip style] [skip vbump] Restyle files

---
 R/extract_code_as_is_prototype.R | 1 -
 1 file changed, 1 deletion(-)

diff --git a/R/extract_code_as_is_prototype.R b/R/extract_code_as_is_prototype.R
index ca9ff773..de81b4f2 100644
--- a/R/extract_code_as_is_prototype.R
+++ b/R/extract_code_as_is_prototype.R
@@ -86,4 +86,3 @@ split_code <- function(code, lines_ids) {
 # lines_ids <- get_line_ids(pd)
 # code_by_calls <- split_code(code, lines_ids)
 # code_by_calls
-

From 35de66bdee5059092159e01fcec90f191a6ed646 Mon Sep 17 00:00:00 2001
From: m7pr <marcin.kosinski.mk1@roche.com>
Date: Tue, 29 Oct 2024 17:13:23 +0100
Subject: [PATCH 25/98] incorporate split_code into codebase

---
 R/extract_code_as_is_prototype.R |  7 ++++++-
 R/qenv-eval_code.R               | 10 +++++-----
 R/utils-get_code_dependency.R    | 30 +++++++++---------------------
 3 files changed, 20 insertions(+), 27 deletions(-)

diff --git a/R/extract_code_as_is_prototype.R b/R/extract_code_as_is_prototype.R
index ca9ff773..fc0790c2 100644
--- a/R/extract_code_as_is_prototype.R
+++ b/R/extract_code_as_is_prototype.R
@@ -45,7 +45,12 @@ get_line_ids <- function(pd) {
   Filter(Negate(is.null), c(list(first_comment_ids), call_ids, list(last_comment_ids)))
 }
 
-split_code <- function(code, lines_ids) {
+split_code <- function(code, parsed_code) {
+
+  pd <- utils::getParseData(parsed_code)
+  pd <- pd[pd$token != "';'", ]
+  lines_ids <- get_line_ids(pd)
+
   code_split <- strsplit(code, split = "\n", fixed = TRUE)[[1]]
   code_split_calls <- list()
 
diff --git a/R/qenv-eval_code.R b/R/qenv-eval_code.R
index df62a2ab..a195b6b9 100644
--- a/R/qenv-eval_code.R
+++ b/R/qenv-eval_code.R
@@ -29,19 +29,19 @@ setGeneric("eval_code", function(object, code) standardGeneric("eval_code"))
 
 setMethod("eval_code", signature = c("qenv", "character"), function(object, code) {
   parsed_code <- parse(text = code, keep.source = TRUE)
-  comments <- extract_comments(parsed_code)
   id <- sample.int(.Machine$integer.max, size = length(parsed_code))
 
   object@id <- c(object@id, id)
   object@env <- rlang::env_clone(object@env, parent = parent.env(.GlobalEnv))
-  object@code <- c(object@code, trimws(paste(as.character(parsed_code), comments)))
+
+  code_split <- split_code(code, parsed_code)
+  object@code <- c(object@code, unlist(code_split))
 
   current_warnings <- rep("", length(parsed_code))
   current_messages <- rep("", length(parsed_code))
 
-
-  for (i in seq_along(parsed_code)) {
-    single_call <- parsed_code[i]
+  for (i in seq_along(code_split)) {
+    single_call <- parse(text = code_split[[i]], keep.source = FALSE)
     # Using withCallingHandlers to capture warnings and messages.
     # Using tryCatch to capture the error and abort further evaluation.
     x <- withCallingHandlers(
diff --git a/R/utils-get_code_dependency.R b/R/utils-get_code_dependency.R
index a20450ff..3d2497de 100644
--- a/R/utils-get_code_dependency.R
+++ b/R/utils-get_code_dependency.R
@@ -39,12 +39,12 @@ get_code_dependency <- function(code, names, check_names = TRUE) {
     code <- sub("^\\{(.*)\\}$", "\\1", tcode)
   }
 
-
-  code <- parse(text = code, keep.source = TRUE)
-  pd <- utils::getParseData(code)
+  code <- split_code(code, parsed_code)
+  parsed_code <- parse(text = code, keep.source = TRUE)
+  pd <- utils::getParseData(parsed_code)
   pd <- normalize_pd(pd)
   calls_pd <- extract_calls(pd)
-  comments <- extract_comments(code)
+  comments <- extract_comments(parsed_code)
 
   if (check_names) {
     # Detect if names are actually in code.
@@ -66,7 +66,8 @@ get_code_dependency <- function(code, names, check_names = TRUE) {
   lib_ind <- detect_libraries(calls_pd)
 
   code_ids <- sort(unique(c(lib_ind, ind)))
-  trimws(paste(as.character(code[code_ids]), comments[code_ids]))
+  code[code_ids]
+  #trimws(paste(as.character(code[code_ids]), comments[code_ids]))
 }
 
 #' Locate function call token
@@ -141,12 +142,12 @@ get_children <- function(pd, parent) {
 #' Fixes edge case of comments being shifted to the next call.
 #' @keywords internal
 #' @noRd
-fix_shifted_comments <- function(calls, pattern = "@linksto") {
+fix_shifted_comments <- function(calls) {
   # If the first or the second token is a @linksto COMMENT,
   #  then it belongs to the previous call.
   if (length(calls) >= 2) {
     for (i in 2:length(calls)) {
-      comment_idx <- grep(pattern, calls[[i]][, "text"])
+      comment_idx <- grep("@linksto", calls[[i]][, "text"])
       if (isTRUE(comment_idx[1] <= 2)) {
         calls[[i - 1]] <- rbind(
           calls[[i - 1]],
@@ -156,20 +157,7 @@ fix_shifted_comments <- function(calls, pattern = "@linksto") {
       }
     }
   }
-  calls <- Filter(nrow, calls)
-  # If, after shifting, there are two COMMENTs in one call, paste them.
-  merge_comments <- function(call) {
-    if (sum(call$token == "COMMENT") >= 2) {
-      comments <- call[call$token == "COMMENT", "text"]
-      first_comment_row <- call[which(call$token == "COMMENT")[1], ]
-      call <- call[call$token != "COMMENT", ]
-      first_comment_row$text <- paste(comments, collapse = " ")
-      rbind(call, first_comment_row)
-    } else {
-      call
-    }
-  }
-  lapply(calls, merge_comments)
+  Filter(nrow, calls)
 }
 
 #' Fixes edge case of `<-` assignment operator being called as function,

From 0ced3698a090087edbec1c01a658fa43e0752f0b Mon Sep 17 00:00:00 2001
From: github-actions <41898282+github-actions[bot]@users.noreply.github.com>
Date: Tue, 29 Oct 2024 16:15:37 +0000
Subject: [PATCH 26/98] [skip style] [skip vbump] Restyle files

---
 R/extract_code_as_is_prototype.R | 1 -
 R/utils-get_code_dependency.R    | 2 +-
 2 files changed, 1 insertion(+), 2 deletions(-)

diff --git a/R/extract_code_as_is_prototype.R b/R/extract_code_as_is_prototype.R
index 2d65b3b8..9eae78d1 100644
--- a/R/extract_code_as_is_prototype.R
+++ b/R/extract_code_as_is_prototype.R
@@ -46,7 +46,6 @@ get_line_ids <- function(pd) {
 }
 
 split_code <- function(code, parsed_code) {
-
   pd <- utils::getParseData(parsed_code)
   pd <- pd[pd$token != "';'", ]
   lines_ids <- get_line_ids(pd)
diff --git a/R/utils-get_code_dependency.R b/R/utils-get_code_dependency.R
index 3d2497de..022eea8b 100644
--- a/R/utils-get_code_dependency.R
+++ b/R/utils-get_code_dependency.R
@@ -67,7 +67,7 @@ get_code_dependency <- function(code, names, check_names = TRUE) {
 
   code_ids <- sort(unique(c(lib_ind, ind)))
   code[code_ids]
-  #trimws(paste(as.character(code[code_ids]), comments[code_ids]))
+  # trimws(paste(as.character(code[code_ids]), comments[code_ids]))
 }
 
 #' Locate function call token

From 089514c1913dcfdcb6bb2af835c849a6707fa703 Mon Sep 17 00:00:00 2001
From: m7pr <marcin.kosinski.mk1@roche.com>
Date: Wed, 30 Oct 2024 12:23:22 +0100
Subject: [PATCH 27/98] merge

---
 R/utils-get_code_dependency.R | 41 ++++++++++++++++++-----------------
 1 file changed, 21 insertions(+), 20 deletions(-)

diff --git a/R/utils-get_code_dependency.R b/R/utils-get_code_dependency.R
index 3d2497de..92186c96 100644
--- a/R/utils-get_code_dependency.R
+++ b/R/utils-get_code_dependency.R
@@ -39,12 +39,13 @@ get_code_dependency <- function(code, names, check_names = TRUE) {
     code <- sub("^\\{(.*)\\}$", "\\1", tcode)
   }
 
-  code <- split_code(code, parsed_code)
   parsed_code <- parse(text = code, keep.source = TRUE)
+  code_split <- split_code(code, parsed_code)
+
   pd <- utils::getParseData(parsed_code)
   pd <- normalize_pd(pd)
   calls_pd <- extract_calls(pd)
-  comments <- extract_comments(parsed_code)
+  #comments <- extract_comments(parsed_code)
 
   if (check_names) {
     # Detect if names are actually in code.
@@ -66,7 +67,7 @@ get_code_dependency <- function(code, names, check_names = TRUE) {
   lib_ind <- detect_libraries(calls_pd)
 
   code_ids <- sort(unique(c(lib_ind, ind)))
-  code[code_ids]
+  code_split[code_ids]
   #trimws(paste(as.character(code[code_ids]), comments[code_ids]))
 }
 
@@ -455,20 +456,20 @@ normalize_pd <- function(pd) {
   pd
 }
 
-#' Extract comments from parsed code
-#'
-#' @param parsed_code `expression`, result of `parse()` function
-#'
-#' @return `character` vector of length of `parsed_code` with comments included in `parsed_code`
-#' @keywords internal
-#' @noRd
-extract_comments <- function(parsed_code) {
-  get_comments <- function(call) {
-    comment <- call[call$token == "COMMENT", "text"]
-    if (length(comment) == 0) "" else comment
-  }
-  calls <- extract_calls(utils::getParseData(parsed_code))
-  fixed_calls <- fix_shifted_comments(calls, pattern = "#")
-
-  unlist(lapply(fixed_calls, get_comments))
-}
+#' #' Extract comments from parsed code
+#' #'
+#' #' @param parsed_code `expression`, result of `parse()` function
+#' #'
+#' #' @return `character` vector of length of `parsed_code` with comments included in `parsed_code`
+#' #' @keywords internal
+#' #' @noRd
+#' extract_comments <- function(parsed_code) {
+#'   get_comments <- function(call) {
+#'     comment <- call[call$token == "COMMENT", "text"]
+#'     if (length(comment) == 0) "" else comment
+#'   }
+#'   calls <- extract_calls(utils::getParseData(parsed_code))
+#'   fixed_calls <- fix_shifted_comments(calls, pattern = "#")
+#'
+#'   unlist(lapply(fixed_calls, get_comments))
+#' }

From 80d877fe317a72f0eeb8697ee5ffd69dc795439a Mon Sep 17 00:00:00 2001
From: m7pr <marcin.kosinski.mk1@roche.com>
Date: Wed, 30 Oct 2024 13:11:57 +0100
Subject: [PATCH 28/98] cleanup

---
 R/extract_code_as_is_prototype.R |  92 -----------------------
 R/qenv-eval_code.R               |   2 +-
 R/utils-get_code_dependency.R    | 125 +++++++++++++++++++++++++------
 3 files changed, 105 insertions(+), 114 deletions(-)
 delete mode 100644 R/extract_code_as_is_prototype.R

diff --git a/R/extract_code_as_is_prototype.R b/R/extract_code_as_is_prototype.R
deleted file mode 100644
index 9eae78d1..00000000
--- a/R/extract_code_as_is_prototype.R
+++ /dev/null
@@ -1,92 +0,0 @@
-get_line_ids <- function(pd) {
-  if (pd$token[1] == "COMMENT") {
-    first_comment <- 1:(which(pd$parent == 0)[1] - 1)
-    pd_first_comment <- pd[first_comment, ]
-    pd <- pd[-first_comment, ]
-
-    n <- nrow(pd_first_comment)
-    first_comment_ids <- data.frame(
-      lines = c(pd_first_comment[1, "line1"], pd_first_comment[n, "line2"]),
-      cols = c(pd_first_comment[1, "col1"], pd_first_comment[n, "col2"])
-    )
-  } else {
-    first_comment_ids <- NULL
-  }
-
-  if (pd$token[nrow(pd)] == "COMMENT") {
-    last_comment <- which(pd$parent == 0 & pd$token == "COMMENT")
-    pd_last_comment <- pd[last_comment, ]
-    pd <- pd[-last_comment, ]
-
-    n <- nrow(pd_last_comment)
-    last_comment_ids <- data.frame(
-      lines = c(pd_last_comment[1, "line1"], pd_last_comment[n, "line2"]),
-      cols = c(pd_last_comment[1, "col1"], pd_last_comment[n, "col2"])
-    )
-  } else {
-    last_comment_ids <- NULL
-  }
-
-
-  calls_start <- which(pd$parent == 0)
-  calls_end <- c(which(pd$parent == 0)[-1] - 1, nrow(pd))
-
-  call_ids <- list()
-  for (i in seq_along(calls_start)) {
-    call <- pd[c(calls_start[i], calls_end[i]), ]
-    call_ids[[i]] <-
-      data.frame(
-        lines = c(call[1, "line1"], call[2, "line2"]),
-        cols = c(call[1, "col1"], call[2, "col2"])
-      )
-  }
-
-
-  Filter(Negate(is.null), c(list(first_comment_ids), call_ids, list(last_comment_ids)))
-}
-
-split_code <- function(code, parsed_code) {
-  pd <- utils::getParseData(parsed_code)
-  pd <- pd[pd$token != "';'", ]
-  lines_ids <- get_line_ids(pd)
-
-  code_split <- strsplit(code, split = "\n", fixed = TRUE)[[1]]
-  code_split_calls <- list()
-
-  for (i in seq_along(lines_ids)) {
-    code_lines <- code_split[lines_ids[[i]]$lines[1]:lines_ids[[i]]$lines[2]]
-
-    if (length(code_lines) == 1) {
-      code_lines <- substr(code_lines, lines_ids[[i]]$cols[1], lines_ids[[i]]$cols[2])
-    } else {
-      code_lines[1] <- substr(code_lines[1], lines_ids[[i]]$cols[1], nchar(code_lines[1]))
-      code_lines[length(code_lines)] <- substr(code_lines[length(code_lines)], 1, lines_ids[[i]]$cols[2])
-    }
-
-
-    code_split_calls[[i]] <- paste(code_lines, collapse = "\n")
-  }
-  code_split_calls
-}
-
-# EXAMPLE
-# code <- "
-#   # initial comment line 1
-#   # initial comment line 2
-#   a <- 1 # A comment
-#   b1 <- 2; b2 <- 2;b3 = 3 # inline comment
-#   c <- 3 # C comment
-#   # inbetween comment
-#   d <- 4
-#   # finishing comment line 1
-#   # finishing comment line 2
-# "
-#
-# parsed_code <- parse(text = code)
-# comments <- extract_comments(parsed_code)
-# pd <- utils::getParseData(parsed_code)
-#
-# pd <- pd[pd$token != "';'", ]
-# lines_ids <- get_line_ids(pd)
-# code_by_calls <- split_code(code, lines_ids)
-# code_by_calls
diff --git a/R/qenv-eval_code.R b/R/qenv-eval_code.R
index a195b6b9..8994babf 100644
--- a/R/qenv-eval_code.R
+++ b/R/qenv-eval_code.R
@@ -34,7 +34,7 @@ setMethod("eval_code", signature = c("qenv", "character"), function(object, code
   object@id <- c(object@id, id)
   object@env <- rlang::env_clone(object@env, parent = parent.env(.GlobalEnv))
 
-  code_split <- split_code(code, parsed_code)
+  code_split <- split_code(code)
   object@code <- c(object@code, unlist(code_split))
 
   current_warnings <- rep("", length(parsed_code))
diff --git a/R/utils-get_code_dependency.R b/R/utils-get_code_dependency.R
index 2ef94789..1950c2f6 100644
--- a/R/utils-get_code_dependency.R
+++ b/R/utils-get_code_dependency.R
@@ -34,18 +34,17 @@ get_code_dependency <- function(code, names, check_names = TRUE) {
   }
 
   # If code is bound in curly brackets, remove them.
+  # TODO: rethink if this is still needed when code is divided by calls?
   tcode <- trimws(code)
   if (any(grepl("^\\{.*\\}$", tcode))) {
     code <- sub("^\\{(.*)\\}$", "\\1", tcode)
   }
 
   parsed_code <- parse(text = code, keep.source = TRUE)
-  code_split <- split_code(code, parsed_code)
 
   pd <- utils::getParseData(parsed_code)
   pd <- normalize_pd(pd)
   calls_pd <- extract_calls(pd)
-  #comments <- extract_comments(parsed_code)
 
   if (check_names) {
     # Detect if names are actually in code.
@@ -67,8 +66,7 @@ get_code_dependency <- function(code, names, check_names = TRUE) {
   lib_ind <- detect_libraries(calls_pd)
 
   code_ids <- sort(unique(c(lib_ind, ind)))
-  code_split[code_ids]
-  #trimws(paste(as.character(code[code_ids]), comments[code_ids]))
+  code[code_ids]
 
 }
 
@@ -457,20 +455,105 @@ normalize_pd <- function(pd) {
   pd
 }
 
-#' #' Extract comments from parsed code
-#' #'
-#' #' @param parsed_code `expression`, result of `parse()` function
-#' #'
-#' #' @return `character` vector of length of `parsed_code` with comments included in `parsed_code`
-#' #' @keywords internal
-#' #' @noRd
-#' extract_comments <- function(parsed_code) {
-#'   get_comments <- function(call) {
-#'     comment <- call[call$token == "COMMENT", "text"]
-#'     if (length(comment) == 0) "" else comment
-#'   }
-#'   calls <- extract_calls(utils::getParseData(parsed_code))
-#'   fixed_calls <- fix_shifted_comments(calls, pattern = "#")
-#'
-#'   unlist(lapply(fixed_calls, get_comments))
-#' }
+#' Get line and cols ids of starts and ends of calls
+#'
+#' @param pd `data.frame` resulting from `utils::getParseData()` call.
+#'
+#' @return list of `data.frames` containing number of lines and columns of starts and ends of calls included in `pd`.
+#'
+#' @keywords internal
+#' @noRd
+get_line_ids <- function(pd) {
+  if (pd$token[1] == "COMMENT") {
+    first_comment <- 1:(which(pd$parent == 0)[1] - 1)
+    pd_first_comment <- pd[first_comment, ]
+    pd <- pd[-first_comment, ]
+
+    n <- nrow(pd_first_comment)
+    first_comment_ids <- data.frame(
+      lines = c(pd_first_comment[1, "line1"], pd_first_comment[n, "line2"]),
+      cols = c(pd_first_comment[1, "col1"], pd_first_comment[n, "col2"])
+    )
+  } else {
+    first_comment_ids <- NULL
+  }
+
+  if (pd$token[nrow(pd)] == "COMMENT") {
+    last_comment <- which(pd$parent == 0 & pd$token == "COMMENT")
+    pd_last_comment <- pd[last_comment, ]
+    pd <- pd[-last_comment, ]
+
+    n <- nrow(pd_last_comment)
+    last_comment_ids <- data.frame(
+      lines = c(pd_last_comment[1, "line1"], pd_last_comment[n, "line2"]),
+      cols = c(pd_last_comment[1, "col1"], pd_last_comment[n, "col2"])
+    )
+  } else {
+    last_comment_ids <- NULL
+  }
+
+
+  calls_start <- which(pd$parent == 0)
+  calls_end <- c(which(pd$parent == 0)[-1] - 1, nrow(pd))
+
+  call_ids <- list()
+  for (i in seq_along(calls_start)) {
+    call <- pd[c(calls_start[i], calls_end[i]), ]
+    call_ids[[i]] <-
+      data.frame(
+        lines = c(call[1, "line1"], call[2, "line2"]),
+        cols = c(call[1, "col1"], call[2, "col2"])
+      )
+  }
+
+  if (!is.null(first_comment_ids)) {
+    call_ids[[1]] <- rbind(first_comment_ids[1, ], call_ids[[1]][2, ])
+  }
+  if (!is.null(last_comment_ids)) {
+    n <- length(call_ids)
+    call_ids[[n]] <- rbind(call_ids[[n]][1, ], last_comment_ids[2, ])
+  }
+  call_ids
+}
+
+#' Split code by calls
+#'
+#' @param code `character` with the code.
+#'
+#' @return list of `character`s of the length equal to the number of calls in `code`.
+#'
+#' @keywords internal
+#' @noRd
+split_code <- function(code) {
+  parsed_code <- parse(text = code, keep.source = TRUE)
+  pd <- utils::getParseData(parsed_code)
+  pd <- pd[pd$token != "';'", ]
+  lines_ids <- get_line_ids(pd)
+
+  code_split <- strsplit(code, split = "\n", fixed = TRUE)[[1]]
+  code_split_calls <- list()
+
+  for (i in seq_along(lines_ids)) {
+    code_lines <- code_split[lines_ids[[i]]$lines[1]:lines_ids[[i]]$lines[2]]
+
+    if (length(code_lines) == 1) {
+      code_lines_candidate <- substr(code_lines, lines_ids[[i]]$cols[1], lines_ids[[i]]$cols[2])
+      # in case only indentantion is changed, do not trim the indentation
+      if (!identical(code_lines_candidate, trimws(code_lines))) {
+        # case of multiple calls in one line, keep the original indentation
+        indentation <- gsub("^(\\s+).*", "\\1", code_lines)
+        code_lines <- paste0(indentation, code_lines_candidate)
+      }
+    } else {
+      code_lines_candidate <- substr(code_lines[1], lines_ids[[i]]$cols[1], nchar(code_lines[1]))
+      # in case only indentantion is changed, do not trim the indentation
+      if (!identical(code_lines_candidate, trimws(code_lines[1]))) {
+        code_lines[1] <- code_lines_candidate
+      }
+      code_lines[length(code_lines)] <- substr(code_lines[length(code_lines)], 1, lines_ids[[i]]$cols[2])
+    }
+
+    code_split_calls[[i]] <- paste(code_lines, collapse = "\n")
+  }
+  code_split_calls
+}

From 5e1bd45de6a8dd3eefa4514546141bfd002d06fe Mon Sep 17 00:00:00 2001
From: "27856297+dependabot-preview[bot]@users.noreply.github.com"
 <27856297+dependabot-preview[bot]@users.noreply.github.com>
Date: Wed, 30 Oct 2024 12:14:06 +0000
Subject: [PATCH 29/98] [skip roxygen] [skip vbump] Roxygen Man Pages Auto
 Update

---
 DESCRIPTION | 1 -
 1 file changed, 1 deletion(-)

diff --git a/DESCRIPTION b/DESCRIPTION
index 42fd8ed3..7a1ccff3 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -53,7 +53,6 @@ Language: en-US
 Roxygen: list(markdown = TRUE)
 RoxygenNote: 7.3.2
 Collate:
-    'extract_code_as_is_prototype.R'
     'qenv-class.R'
     'qenv-errors.R'
     'qenv-concat.R'

From 08bd2dac8e4972fbd0e38bdc02dc97e4d58e79cd Mon Sep 17 00:00:00 2001
From: github-actions <41898282+github-actions[bot]@users.noreply.github.com>
Date: Wed, 30 Oct 2024 12:14:12 +0000
Subject: [PATCH 30/98] [skip style] [skip vbump] Restyle files

---
 R/utils-get_code_dependency.R | 1 -
 1 file changed, 1 deletion(-)

diff --git a/R/utils-get_code_dependency.R b/R/utils-get_code_dependency.R
index 1950c2f6..e5db6b45 100644
--- a/R/utils-get_code_dependency.R
+++ b/R/utils-get_code_dependency.R
@@ -67,7 +67,6 @@ get_code_dependency <- function(code, names, check_names = TRUE) {
 
   code_ids <- sort(unique(c(lib_ind, ind)))
   code[code_ids]
-
 }
 
 #' Locate function call token

From 166a8c120d7798e9a5c970c237cdb8560961bc12 Mon Sep 17 00:00:00 2001
From: m7pr <marcin.kosinski.mk1@roche.com>
Date: Wed, 30 Oct 2024 13:14:48 +0100
Subject: [PATCH 31/98] Collate

---
 DESCRIPTION | 1 -
 1 file changed, 1 deletion(-)

diff --git a/DESCRIPTION b/DESCRIPTION
index 42fd8ed3..7a1ccff3 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -53,7 +53,6 @@ Language: en-US
 Roxygen: list(markdown = TRUE)
 RoxygenNote: 7.3.2
 Collate:
-    'extract_code_as_is_prototype.R'
     'qenv-class.R'
     'qenv-errors.R'
     'qenv-concat.R'

From 88a8c047ad98430a6fbf292c17e93c500b9c66c0 Mon Sep 17 00:00:00 2001
From: m7pr <marcin.kosinski.mk1@roche.com>
Date: Wed, 30 Oct 2024 14:16:22 +0100
Subject: [PATCH 32/98] fix tests

---
 R/qenv-eval_code.R                  |  4 +-
 R/utils-get_code_dependency.R       | 13 +++++-
 tests/testthat/test-qenv_extract.R  |  4 +-
 tests/testthat/test-qenv_get_code.R | 66 +++++++++++++----------------
 tests/testthat/test-qenv_within.R   |  2 +
 5 files changed, 48 insertions(+), 41 deletions(-)

diff --git a/R/qenv-eval_code.R b/R/qenv-eval_code.R
index 8994babf..61d7f7e5 100644
--- a/R/qenv-eval_code.R
+++ b/R/qenv-eval_code.R
@@ -29,12 +29,14 @@ setGeneric("eval_code", function(object, code) standardGeneric("eval_code"))
 
 setMethod("eval_code", signature = c("qenv", "character"), function(object, code) {
   parsed_code <- parse(text = code, keep.source = TRUE)
+  if (length(parsed_code) == 0) return(object)
+
   id <- sample.int(.Machine$integer.max, size = length(parsed_code))
 
   object@id <- c(object@id, id)
   object@env <- rlang::env_clone(object@env, parent = parent.env(.GlobalEnv))
 
-  code_split <- split_code(code)
+  code_split <- split_code(paste(code, collapse = "\n"))
   object@code <- c(object@code, unlist(code_split))
 
   current_warnings <- rep("", length(parsed_code))
diff --git a/R/utils-get_code_dependency.R b/R/utils-get_code_dependency.R
index e5db6b45..66f30c49 100644
--- a/R/utils-get_code_dependency.R
+++ b/R/utils-get_code_dependency.R
@@ -491,6 +491,12 @@ get_line_ids <- function(pd) {
     last_comment_ids <- NULL
   }
 
+  # If NUM_CONST is the last element, we need to reorder rows.
+  # Last 2 rows
+  n <- nrow(pd)
+  if (pd$token[n-1] == "NUM_CONST" && pd$parent[n] == 0) {
+    pd <- rbind(pd[-(n-1), ], pd[n-1, ])
+  }
 
   calls_start <- which(pd$parent == 0)
   calls_end <- c(which(pd$parent == 0)[-1] - 1, nrow(pd))
@@ -526,6 +532,7 @@ get_line_ids <- function(pd) {
 split_code <- function(code) {
   parsed_code <- parse(text = code, keep.source = TRUE)
   pd <- utils::getParseData(parsed_code)
+  pd <- normalize_pd(pd)
   pd <- pd[pd$token != "';'", ]
   lines_ids <- get_line_ids(pd)
 
@@ -540,7 +547,11 @@ split_code <- function(code) {
       # in case only indentantion is changed, do not trim the indentation
       if (!identical(code_lines_candidate, trimws(code_lines))) {
         # case of multiple calls in one line, keep the original indentation
-        indentation <- gsub("^(\\s+).*", "\\1", code_lines)
+        indentation <- if (grepl("^\\s+", code_lines)) {
+          gsub("^(\\s+).*", "\\1", code_lines)
+        } else {
+          ""
+        }
         code_lines <- paste0(indentation, code_lines_candidate)
       }
     } else {
diff --git a/tests/testthat/test-qenv_extract.R b/tests/testthat/test-qenv_extract.R
index 18064f60..aedd05e5 100644
--- a/tests/testthat/test-qenv_extract.R
+++ b/tests/testthat/test-qenv_extract.R
@@ -15,7 +15,7 @@ testthat::test_that("`[.` extract proper code", {
   qs <- q[object_names]
   testthat::expect_identical(
     qs@code,
-    c("x <- 1", "a <- 1")
+    c("x<-1", "a<-1")
   )
 })
 
@@ -26,7 +26,7 @@ testthat::test_that("`[.` preservers comments in the code", {
   qs <- q[c("x", "a")]
   testthat::expect_identical(
     qs@code,
-    c("x <- 1 #comment", "a <- 1")
+    c("x<-1 #comment", "a<-1")
   )
 })
 
diff --git a/tests/testthat/test-qenv_get_code.R b/tests/testthat/test-qenv_get_code.R
index bc1152ed..137fc1a2 100644
--- a/tests/testthat/test-qenv_get_code.R
+++ b/tests/testthat/test-qenv_get_code.R
@@ -76,6 +76,7 @@ testthat::test_that("handles the code included in curly brackets", {
   code <- "{1 + 1;a <- 5}"
 
   testthat::expect_identical(
+    # TODO: to be fixed
     get_code(eval_code(qenv(), code), names = "a"),
     "a <- 5"
   )
@@ -87,7 +88,7 @@ testthat::test_that("handles the code of length > 1 when at least one is enclose
 
   testthat::expect_identical(
     get_code(q, names = "a"),
-    "a <- 5"
+    "a<-5"
   )
 })
 
@@ -212,7 +213,7 @@ testthat::test_that("detects every assign calls even if not evaluated, if there
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
     get_code(q, names = "b"),
-    c("b <- 2", "eval(expression({\n    b <- b + 2\n}))")
+    code[2:3]
   )
 })
 
@@ -295,16 +296,11 @@ testthat::test_that("extracts the code for assign() where \"x\" is a literal str
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
     get_code(q, names = "b"),
-    c("assign(\"b\", 5)", "b <- b + 2")
+    code[c(2, 5)]
   )
   testthat::expect_identical(
     get_code(q, names = "c"),
-    c(
-      "assign(\"b\", 5)",
-      "assign(value = 7, x = \"c\")",
-      "b <- b + 2",
-      "c <- b"
-    )
+    code[c(2, 3, 5, 6)]
   )
   testthat::expect_identical(
     get_code(q, names = "d"),
@@ -355,11 +351,11 @@ testthat::test_that("detects function usage of the assignment operator", {
 
   testthat::expect_identical(
     get_code(q, names = "y"),
-    c(code[1], "y <- x")
+    code
   )
   testthat::expect_identical(
     get_code(q2, names = "y"),
-    "y <- x <- 2"
+    code2
   )
 })
 
@@ -390,7 +386,7 @@ testthat::test_that("@linksto makes a line being returned for an affected bindin
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
     get_code(q, names = "b"),
-    c("a <- 1 # @linksto b", "b <- 2")
+    c("  a <- 1 # @linksto b", "  b <- 2")
   )
 })
 
@@ -443,7 +439,7 @@ testthat::test_that(
     q <- eval_code(qenv(), code)
     testthat::expect_identical(
       get_code(q, names = "classes"),
-      c("iris2 <- iris[1:5, ]", code[2:4])
+      code
     )
   }
 )
@@ -467,11 +463,10 @@ testthat::test_that("comments fall into proper calls", {
   q <- qenv() |> eval_code(code)
   testthat::expect_identical(
     get_code(q),
-    c(
-      "a <- 1 # initial comment",
-      "b <- 2 # inline comment",
-      "c <- 3 # inbetween comment",
-      "d <- 4 # finishing comment"
+    c("    # initial comment\n    a <- 1",
+      "    b <- 2 # inline comment",
+      "    c <- 3\n    # inbetween comment",
+      "    d <- 4\n    # finishing comment"
     )
   )
 })
@@ -493,11 +488,10 @@ testthat::test_that("comments get pasted when they fall into calls", {
   q <- qenv() |> eval_code(code)
   testthat::expect_identical(
     get_code(q),
-    c(
-      "a <- 1 # initial comment # A comment",
-      "b <- 2 # inline comment",
-      "c <- 3 # C comment # inbetween comment",
-      "d <- 4 # finishing comment"
+    c("    # initial comment\n    a <- 1 # A comment",
+      "    b <- 2 # inline comment",
+      "    c <- 3 # C comment\n    # inbetween comment",
+      "    d <- 4\n    # finishing comment"
     )
   )
 })
@@ -516,7 +510,7 @@ testthat::test_that("ignores occurrence in a function definition", {
   )
   testthat::expect_identical(
     get_code(q, names = "foo"),
-    "foo <- function(b) {\n    b <- b + 2\n}"
+    code[2]
   )
 })
 
@@ -528,11 +522,11 @@ testthat::test_that("ignores occurrence in a function definition that has functi
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
     get_code(q, names = "b"),
-    "b <- 2"
+    code[1]
   )
   testthat::expect_identical(
     get_code(q, names = "foo"),
-    "foo <- function(b) {\n    function(c) {\n        b <- c + 2\n    }\n}"
+    code[2]
   )
 })
 
@@ -550,7 +544,7 @@ testthat::test_that("ignores occurrence in a function definition if there is mul
   )
   testthat::expect_identical(
     get_code(q, names = "foo"),
-    "foo <- function(b) {\n    function(c) {\n        b <- c + 2\n    }\n}"
+    code[2]
   )
 })
 
@@ -587,7 +581,7 @@ testthat::test_that("does not ignore occurrence in function body if object exsit
 testthat::test_that("ignores occurrence in function definition without { curly brackets", {
   code <- c(
     "b <- 2",
-    "foo <- function(b) b <- b + 2 "
+    "foo <- function(b) b <- b + 2"
   )
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
@@ -610,7 +604,7 @@ testthat::test_that("detects occurrence of the function object", {
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
     get_code(q, names = "b"),
-    c("a <- 1", "b <- 2", "foo <- function(b) {\n    b <- b + 2\n}", "b <- foo(a)")
+    code
   )
 })
 
@@ -623,7 +617,7 @@ testthat::test_that("detects occurrence of a function definition when a formal i
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
     get_code(q, names = "a"),
-    c("x <- 1", "foo <- function(foo = 1) \"text\"", "a <- foo(x)")
+    code
   )
 })
 
@@ -640,10 +634,8 @@ testthat::test_that("detects occurrence of a function definition with a @linksto
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
     get_code(q, names = "x"),
-    c(
-      "foo <- function() {\n    env <- parent.frame()\n    env$x <- 0\n}",
-      "foo() # @linksto x"
-    )
+    c("        foo <- function() {\n          env <- parent.frame()\n          env$x <- 0\n        }",
+      "foo() # @linksto x")
   )
 })
 # $ ---------------------------------------------------------------------------------------------------------------
@@ -696,11 +688,11 @@ testthat::test_that("understands @ usage and do not treat rhs of @ as objects (o
   q@code <- code # we don't use eval_code so the code is not run
   testthat::expect_identical(
     get_code(q, names = "x"),
-    gsub("'", "\"", code[1:2], fixed = TRUE)
+    code[1:2]
   )
   testthat::expect_identical(
     get_code(q, names = "a"),
-    gsub("'", "\"", code, fixed = TRUE)
+    code
   )
 })
 
@@ -752,7 +744,7 @@ testthat::test_that("data() call is returned when data name is provided as a cha
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
     get_code(q, names = "z"),
-    gsub("'", "\"", code[-1], fixed = TRUE)
+    code[-1]
   )
 })
 
diff --git a/tests/testthat/test-qenv_within.R b/tests/testthat/test-qenv_within.R
index 7c119590..a05d0a03 100644
--- a/tests/testthat/test-qenv_within.R
+++ b/tests/testthat/test-qenv_within.R
@@ -60,6 +60,8 @@ testthat::test_that("within.qenv renturns a `qenv` where `@env` is a deep copy o
   qq <- within(q, {})
   testthat::expect_equal(q@env, qq@env)
   testthat::expect_false(identical(q@env, qq@env))
+  # TODO: fix
+  # dunno what's going on yet
 })
 
 testthat::test_that("within.qenv renturns qenv.error even if evaluation raises error", {

From ae51d8ac6158f56e13f625c4eef6c7bd3f8a71f2 Mon Sep 17 00:00:00 2001
From: github-actions <41898282+github-actions[bot]@users.noreply.github.com>
Date: Wed, 30 Oct 2024 13:18:28 +0000
Subject: [PATCH 33/98] [skip style] [skip vbump] Restyle files

---
 R/qenv-eval_code.R                  |  4 +++-
 R/utils-get_code_dependency.R       |  4 ++--
 tests/testthat/test-qenv_get_code.R | 12 ++++++++----
 3 files changed, 13 insertions(+), 7 deletions(-)

diff --git a/R/qenv-eval_code.R b/R/qenv-eval_code.R
index 61d7f7e5..4e86b731 100644
--- a/R/qenv-eval_code.R
+++ b/R/qenv-eval_code.R
@@ -29,7 +29,9 @@ setGeneric("eval_code", function(object, code) standardGeneric("eval_code"))
 
 setMethod("eval_code", signature = c("qenv", "character"), function(object, code) {
   parsed_code <- parse(text = code, keep.source = TRUE)
-  if (length(parsed_code) == 0) return(object)
+  if (length(parsed_code) == 0) {
+    return(object)
+  }
 
   id <- sample.int(.Machine$integer.max, size = length(parsed_code))
 
diff --git a/R/utils-get_code_dependency.R b/R/utils-get_code_dependency.R
index 66f30c49..6e877e90 100644
--- a/R/utils-get_code_dependency.R
+++ b/R/utils-get_code_dependency.R
@@ -494,8 +494,8 @@ get_line_ids <- function(pd) {
   # If NUM_CONST is the last element, we need to reorder rows.
   # Last 2 rows
   n <- nrow(pd)
-  if (pd$token[n-1] == "NUM_CONST" && pd$parent[n] == 0) {
-    pd <- rbind(pd[-(n-1), ], pd[n-1, ])
+  if (pd$token[n - 1] == "NUM_CONST" && pd$parent[n] == 0) {
+    pd <- rbind(pd[-(n - 1), ], pd[n - 1, ])
   }
 
   calls_start <- which(pd$parent == 0)
diff --git a/tests/testthat/test-qenv_get_code.R b/tests/testthat/test-qenv_get_code.R
index 137fc1a2..030b58f2 100644
--- a/tests/testthat/test-qenv_get_code.R
+++ b/tests/testthat/test-qenv_get_code.R
@@ -463,7 +463,8 @@ testthat::test_that("comments fall into proper calls", {
   q <- qenv() |> eval_code(code)
   testthat::expect_identical(
     get_code(q),
-    c("    # initial comment\n    a <- 1",
+    c(
+      "    # initial comment\n    a <- 1",
       "    b <- 2 # inline comment",
       "    c <- 3\n    # inbetween comment",
       "    d <- 4\n    # finishing comment"
@@ -488,7 +489,8 @@ testthat::test_that("comments get pasted when they fall into calls", {
   q <- qenv() |> eval_code(code)
   testthat::expect_identical(
     get_code(q),
-    c("    # initial comment\n    a <- 1 # A comment",
+    c(
+      "    # initial comment\n    a <- 1 # A comment",
       "    b <- 2 # inline comment",
       "    c <- 3 # C comment\n    # inbetween comment",
       "    d <- 4\n    # finishing comment"
@@ -634,8 +636,10 @@ testthat::test_that("detects occurrence of a function definition with a @linksto
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
     get_code(q, names = "x"),
-    c("        foo <- function() {\n          env <- parent.frame()\n          env$x <- 0\n        }",
-      "foo() # @linksto x")
+    c(
+      "        foo <- function() {\n          env <- parent.frame()\n          env$x <- 0\n        }",
+      "foo() # @linksto x"
+    )
   )
 })
 # $ ---------------------------------------------------------------------------------------------------------------

From abcab21ac95f73b72624ec15222e57b991ec06b8 Mon Sep 17 00:00:00 2001
From: m7pr <marcin.kosinski.mk1@roche.com>
Date: Wed, 30 Oct 2024 14:59:15 +0100
Subject: [PATCH 34/98] add warnings about skipped objects

---
 R/qenv-extract.R                   | 19 +++++++++++++++----
 tests/testthat/test-qenv_extract.R | 16 ++++++++++++++++
 2 files changed, 31 insertions(+), 4 deletions(-)

diff --git a/R/qenv-extract.R b/R/qenv-extract.R
index 82277b57..30bef8ce 100644
--- a/R/qenv-extract.R
+++ b/R/qenv-extract.R
@@ -18,16 +18,27 @@
 #' @export
 `[.qenv` <- function(x, names) {
   checkmate::assert_class(names, "character")
-  names_in_env <- intersect(names, ls(get_env(x)))
-  if (!length(names_in_env)) {
+  possible_names <- ls(get_env(x))
+  names_warn <- setdiff(names, possible_names)
+  names <- intersect(names, possible_names)
+  if (!length(names)) {
     warning("None of `names` elements exist in `qenv`. Returning empty `qenv`.")
     return(qenv())
   }
 
-  limited_code <- get_code(x, names = names_in_env)
+  if (length(names_warn)) {
+    warning(
+      sprintf(
+        "Some elements of `names` do not exist in `qenv`. Skipping those: %s.",
+        paste(names_warn, collapse = ", ")
+      )
+    )
+  }
+
+  limited_code <- get_code(x, names = names)
   indexes <- which(x@code %in% limited_code)
 
-  x@env <- list2env(mget(x = names_in_env, envir = get_env(x)))
+  x@env <- list2env(mget(x = names, envir = get_env(x)))
   x@code <- limited_code
   x@id <- x@id[indexes]
   x@warnings <- x@warnings[indexes]
diff --git a/tests/testthat/test-qenv_extract.R b/tests/testthat/test-qenv_extract.R
index aedd05e5..1402f10f 100644
--- a/tests/testthat/test-qenv_extract.R
+++ b/tests/testthat/test-qenv_extract.R
@@ -1,3 +1,19 @@
+testthat::test_that("`[.` returns empty qenv for names not in qenv", {
+  data <- within(qenv(), {x = 1; a = 2})
+  testthat::expect_warning(
+    testthat::expect_equal(data["y"], qenv()),
+    "None of `names` elements exist in `qenv`. Returning empty `qenv`."
+  )
+})
+
+testthat::test_that("`[.` returns limited qenv for some names not in qenv", {
+  data <- within(qenv(), {x = 1; a = 2})
+  testthat::expect_warning(
+    testthat::expect_equal(data[c("y", "a")], data["a"]),
+    "Some elements of `names` do not exist in `qenv`. Skipping those: y."
+  )
+})
+
 testthat::test_that("`[.` extracts proper objects", {
   q <- qenv()
   code <- c("x<-1", "a<-1;b<-2")

From a9e9c0e358b84f467b1ab983ba273aba60c99f67 Mon Sep 17 00:00:00 2001
From: github-actions <41898282+github-actions[bot]@users.noreply.github.com>
Date: Wed, 30 Oct 2024 14:01:23 +0000
Subject: [PATCH 35/98] [skip style] [skip vbump] Restyle files

---
 tests/testthat/test-qenv_extract.R | 10 ++++++++--
 1 file changed, 8 insertions(+), 2 deletions(-)

diff --git a/tests/testthat/test-qenv_extract.R b/tests/testthat/test-qenv_extract.R
index 1402f10f..214d4c2c 100644
--- a/tests/testthat/test-qenv_extract.R
+++ b/tests/testthat/test-qenv_extract.R
@@ -1,5 +1,8 @@
 testthat::test_that("`[.` returns empty qenv for names not in qenv", {
-  data <- within(qenv(), {x = 1; a = 2})
+  data <- within(qenv(), {
+    x <- 1
+    a <- 2
+  })
   testthat::expect_warning(
     testthat::expect_equal(data["y"], qenv()),
     "None of `names` elements exist in `qenv`. Returning empty `qenv`."
@@ -7,7 +10,10 @@ testthat::test_that("`[.` returns empty qenv for names not in qenv", {
 })
 
 testthat::test_that("`[.` returns limited qenv for some names not in qenv", {
-  data <- within(qenv(), {x = 1; a = 2})
+  data <- within(qenv(), {
+    x <- 1
+    a <- 2
+  })
   testthat::expect_warning(
     testthat::expect_equal(data[c("y", "a")], data["a"]),
     "Some elements of `names` do not exist in `qenv`. Skipping those: y."

From ed60b3273d15a94ccf1bfa6ad3e2067c938a3214 Mon Sep 17 00:00:00 2001
From: go_gonzo <dawid.kaledkowski@gmail.com>
Date: Thu, 31 Oct 2024 09:49:22 +0100
Subject: [PATCH 36/98] WIP #70

---
 R/qenv-class.R                      | 16 ++-------------
 R/qenv-eval_code.R                  | 30 ++++++++++++-----------------
 R/qenv-extract.R                    |  5 -----
 R/qenv-get_code.R                   |  5 +++--
 R/utils-get_code_dependency.R       |  4 ++--
 tests/testthat/test-qenv_get_code.R |  2 +-
 6 files changed, 20 insertions(+), 42 deletions(-)

diff --git a/R/qenv-class.R b/R/qenv-class.R
index d2a679bc..3bf7e03e 100644
--- a/R/qenv-class.R
+++ b/R/qenv-class.R
@@ -14,10 +14,9 @@
 #' @exportClass qenv
 setClass(
   "qenv",
-  slots = c(env = "environment", code = "character", id = "integer", warnings = "character", messages = "character"),
+  slots = c(env = "environment", code = "list"),
   prototype = list(
-    env = new.env(parent = parent.env(.GlobalEnv)), code = character(0), id = integer(0),
-    warnings = character(0), messages = character(0)
+    env = new.env(parent = parent.env(.GlobalEnv)), code = list()
   )
 )
 
@@ -25,15 +24,4 @@ setClass(
 #' @name qenv-class
 #' @keywords internal
 setValidity("qenv", function(object) {
-  if (length(object@code) != length(object@id)) {
-    "@code and @id slots must have the same length."
-  } else if (length(object@code) != length(object@warnings)) {
-    "@code and @warnings slots must have the same length"
-  } else if (length(object@code) != length(object@messages)) {
-    "@code and @messages slots must have the same length"
-  } else if (any(duplicated(object@id))) {
-    "@id contains duplicated values."
-  } else {
-    TRUE
-  }
 })
diff --git a/R/qenv-eval_code.R b/R/qenv-eval_code.R
index 4e86b731..5bc340ab 100644
--- a/R/qenv-eval_code.R
+++ b/R/qenv-eval_code.R
@@ -33,25 +33,20 @@ setMethod("eval_code", signature = c("qenv", "character"), function(object, code
     return(object)
   }
 
-  id <- sample.int(.Machine$integer.max, size = length(parsed_code))
-
-  object@id <- c(object@id, id)
   object@env <- rlang::env_clone(object@env, parent = parent.env(.GlobalEnv))
-
   code_split <- split_code(paste(code, collapse = "\n"))
-  object@code <- c(object@code, unlist(code_split))
-
-  current_warnings <- rep("", length(parsed_code))
-  current_messages <- rep("", length(parsed_code))
 
   for (i in seq_along(code_split)) {
-    single_call <- parse(text = code_split[[i]], keep.source = FALSE)
+    current_code <- code_split[[i]]
+    current_call <- parse(text = current_code, keep.source = FALSE)
+    new_object_code <- c(object@code, list(current_code))
+
     # Using withCallingHandlers to capture warnings and messages.
     # Using tryCatch to capture the error and abort further evaluation.
     x <- withCallingHandlers(
       tryCatch(
         {
-          eval(single_call, envir = object@env)
+          eval(current_call, envir = object@env)
           if (!identical(parent.env(object@env), parent.env(.GlobalEnv))) {
             # needed to make sure that @env is always a sibling of .GlobalEnv
             # could be changed when any new package is added to search path (through library or require call)
@@ -64,19 +59,19 @@ setMethod("eval_code", signature = c("qenv", "character"), function(object, code
             message = sprintf(
               "%s \n when evaluating qenv code:\n%s",
               .ansi_strip(conditionMessage(e)),
-              deparse1(single_call)
+              deparse1(current_call)
             ),
             class = c("qenv.error", "try-error", "simpleError"),
-            trace = object@code
+            trace = unlist(new_object_code)
           )
         }
       ),
       warning = function(w) {
-        current_warnings[i] <<- .ansi_strip(sprintf("> %s\n", conditionMessage(w)))
+        attr(current_code, "warning") <<- .ansi_strip(sprintf("> %s\n", conditionMessage(w)))
         invokeRestart("muffleWarning")
       },
       message = function(m) {
-        current_messages[i] <<- .ansi_strip(sprintf("> %s", conditionMessage(m)))
+        attr(current_code, "message") <<- .ansi_strip(sprintf("> %s", conditionMessage(m)))
         invokeRestart("muffleMessage")
       }
     )
@@ -84,11 +79,10 @@ setMethod("eval_code", signature = c("qenv", "character"), function(object, code
     if (!is.null(x)) {
       return(x)
     }
-  }
-
 
-  object@warnings <- c(object@warnings, current_warnings)
-  object@messages <- c(object@messages, current_messages)
+    attr(current_code, "id") <- sample.int(.Machine$integer.max, size = 1)
+    object@code <- new_object_code
+  }
 
   lockEnvironment(object@env, bindings = TRUE)
   object
diff --git a/R/qenv-extract.R b/R/qenv-extract.R
index 30bef8ce..8eb83d6a 100644
--- a/R/qenv-extract.R
+++ b/R/qenv-extract.R
@@ -36,13 +36,8 @@
   }
 
   limited_code <- get_code(x, names = names)
-  indexes <- which(x@code %in% limited_code)
-
   x@env <- list2env(mget(x = names, envir = get_env(x)))
   x@code <- limited_code
-  x@id <- x@id[indexes]
-  x@warnings <- x@warnings[indexes]
-  x@messages <- x@messages[indexes]
 
   x
 }
diff --git a/R/qenv-get_code.R b/R/qenv-get_code.R
index ac72d1d1..3a74f226 100644
--- a/R/qenv-get_code.R
+++ b/R/qenv-get_code.R
@@ -118,15 +118,16 @@ setMethod("get_code", signature = "qenv", function(object, deparse = TRUE, names
   }
 
   code <- if (!is.null(names)) {
+    # todo:
     get_code_dependency(object@code, names, ...)
   } else {
     object@code
   }
 
   if (deparse) {
-    code
+    unlist(code)
   } else {
-    parse(text = paste(c("{", code, "}"), collapse = "\n"), keep.source = TRUE)
+    parse(text = paste(c("{", unlist(code), "}"), collapse = "\n"), keep.source = TRUE)
   }
 })
 
diff --git a/R/utils-get_code_dependency.R b/R/utils-get_code_dependency.R
index 6e877e90..80812e30 100644
--- a/R/utils-get_code_dependency.R
+++ b/R/utils-get_code_dependency.R
@@ -26,10 +26,10 @@
 #'
 #' @keywords internal
 get_code_dependency <- function(code, names, check_names = TRUE) {
-  checkmate::assert_character(code)
+  checkmate::assert_list(code, "character")
   checkmate::assert_character(names, any.missing = FALSE)
 
-  if (identical(code, character(0)) || identical(trimws(code), "")) {
+  if (length(code) == 0) {
     return(code)
   }
 
diff --git a/tests/testthat/test-qenv_get_code.R b/tests/testthat/test-qenv_get_code.R
index 030b58f2..fbc0569b 100644
--- a/tests/testthat/test-qenv_get_code.R
+++ b/tests/testthat/test-qenv_get_code.R
@@ -460,7 +460,7 @@ testthat::test_that("comments fall into proper calls", {
     # finishing comment
   "
 
-  q <- qenv() |> eval_code(code)
+  q <- eval_code(qenv(), code)
   testthat::expect_identical(
     get_code(q),
     c(

From 84875c7268037f6f68e9985a88fafd128832738e Mon Sep 17 00:00:00 2001
From: m7pr <marcin.kosinski.mk1@roche.com>
Date: Thu, 31 Oct 2024 13:18:36 +0100
Subject: [PATCH 37/98] move @id, @warnings and @message to attributes of code
 and fix rest of the codebase #70

---
 R/qenv-concat.R                        |   3 -
 R/qenv-eval_code.R                     |  10 +-
 R/qenv-get_code.R                      |   2 +-
 R/qenv-get_warnings.R                  |   8 +-
 R/qenv-join.R                          |  13 ++-
 R/utils-get_code_dependency.R          |   4 +-
 tests/testthat/test-qenv_concat.R      |  12 ++-
 tests/testthat/test-qenv_constructor.R |   8 +-
 tests/testthat/test-qenv_eval_code.R   |  27 ++---
 tests/testthat/test-qenv_extract.R     |  14 +--
 tests/testthat/test-qenv_get_code.R    | 136 ++++++++++++-------------
 tests/testthat/test-qenv_join.R        |  28 ++---
 tests/testthat/test-qenv_within.R      |  10 +-
 vignettes/qenv.Rmd                     |  13 +--
 14 files changed, 146 insertions(+), 142 deletions(-)

diff --git a/R/qenv-concat.R b/R/qenv-concat.R
index cc9f5ed2..9aff55d7 100644
--- a/R/qenv-concat.R
+++ b/R/qenv-concat.R
@@ -32,10 +32,7 @@
 setGeneric("concat", function(x, y) standardGeneric("concat"))
 
 setMethod("concat", signature = c("qenv", "qenv"), function(x, y) {
-  y@id <- c(x@id, y@id)
   y@code <- c(x@code, y@code)
-  y@warnings <- c(x@warnings, y@warnings)
-  y@messages <- c(x@messages, y@messages)
 
   # insert (and overwrite) objects from y to x
   y@env <- rlang::env_clone(y@env, parent = parent.env(.GlobalEnv))
diff --git a/R/qenv-eval_code.R b/R/qenv-eval_code.R
index 5bc340ab..b6c184b8 100644
--- a/R/qenv-eval_code.R
+++ b/R/qenv-eval_code.R
@@ -39,7 +39,6 @@ setMethod("eval_code", signature = c("qenv", "character"), function(object, code
   for (i in seq_along(code_split)) {
     current_code <- code_split[[i]]
     current_call <- parse(text = current_code, keep.source = FALSE)
-    new_object_code <- c(object@code, list(current_code))
 
     # Using withCallingHandlers to capture warnings and messages.
     # Using tryCatch to capture the error and abort further evaluation.
@@ -62,7 +61,7 @@ setMethod("eval_code", signature = c("qenv", "character"), function(object, code
               deparse1(current_call)
             ),
             class = c("qenv.error", "try-error", "simpleError"),
-            trace = unlist(new_object_code)
+            trace = unlist(c(object@code, list(current_code)))
           )
         }
       ),
@@ -81,7 +80,7 @@ setMethod("eval_code", signature = c("qenv", "character"), function(object, code
     }
 
     attr(current_code, "id") <- sample.int(.Machine$integer.max, size = 1)
-    object@code <- new_object_code
+    object@code <- c(object@code, list(current_code))
   }
 
   lockEnvironment(object@env, bindings = TRUE)
@@ -109,3 +108,8 @@ setMethod("eval_code", signature = c("qenv.error", "ANY"), function(object, code
     chr
   }
 }
+
+get_code_attr <- function(qenv, attr){
+  #unlist(lapply(qenv@code, attr, attr)) # somehow doesn't work
+  unlist(lapply(qenv@code, function(x) attr(x, attr)))
+}
diff --git a/R/qenv-get_code.R b/R/qenv-get_code.R
index 3a74f226..857469ee 100644
--- a/R/qenv-get_code.R
+++ b/R/qenv-get_code.R
@@ -125,7 +125,7 @@ setMethod("get_code", signature = "qenv", function(object, deparse = TRUE, names
   }
 
   if (deparse) {
-    unlist(code)
+    code
   } else {
     parse(text = paste(c("{", unlist(code), "}"), collapse = "\n"), keep.source = TRUE)
   }
diff --git a/R/qenv-get_warnings.R b/R/qenv-get_warnings.R
index be3d05be..b5d3c582 100644
--- a/R/qenv-get_warnings.R
+++ b/R/qenv-get_warnings.R
@@ -33,7 +33,9 @@ setGeneric("get_warnings", function(object) {
 })
 
 setMethod("get_warnings", signature = c("qenv"), function(object) {
-  if (all(object@warnings == "")) {
+  warnings <- lapply(object@code, "attr", "warning")
+  code <- object@code[unlist(lapply(warnings, Negate(is.null)))]
+  if (length(unlist(warnings)) == 0) {
     return(NULL)
   }
 
@@ -44,8 +46,8 @@ setMethod("get_warnings", signature = c("qenv"), function(object) {
       }
       sprintf("%swhen running code:\n%s", warn, paste(lang2calls(expr), collapse = "\n"))
     },
-    warn = as.list(object@warnings),
-    expr = as.list(as.character(object@code))
+    warn = as.list(unlist(warnings)),
+    expr = as.list(unlist(code))
   )
   lines <- Filter(Negate(is.null), lines)
 
diff --git a/R/qenv-join.R b/R/qenv-join.R
index f644223a..6b98cb96 100644
--- a/R/qenv-join.R
+++ b/R/qenv-join.R
@@ -143,11 +143,8 @@ setMethod("join", signature = c("qenv", "qenv"), function(x, y) {
     stop(join_validation)
   }
 
-  id_unique <- !y@id %in% x@id
-  x@id <- c(x@id, y@id[id_unique])
+  id_unique <- !get_code_attr(y, "id") %in% get_code_attr(x, "id")
   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@env <- rlang::env_clone(x@env, parent = parent.env(.GlobalEnv))
@@ -188,14 +185,16 @@ setMethod("join", signature = c("qenv.error", "ANY"), function(x, y) {
       )
     )
   }
+  x_id <- get_code_attr(x, "id")
+  y_id <- get_code_attr(y, "id")
 
-  shared_ids <- intersect(x@id, y@id)
+  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)
+  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))) {
diff --git a/R/utils-get_code_dependency.R b/R/utils-get_code_dependency.R
index 80812e30..0942f867 100644
--- a/R/utils-get_code_dependency.R
+++ b/R/utils-get_code_dependency.R
@@ -37,10 +37,10 @@ get_code_dependency <- function(code, names, check_names = TRUE) {
   # TODO: rethink if this is still needed when code is divided by calls?
   tcode <- trimws(code)
   if (any(grepl("^\\{.*\\}$", tcode))) {
-    code <- sub("^\\{(.*)\\}$", "\\1", tcode)
+    tcode <- sub("^\\{(.*)\\}$", "\\1", tcode)
   }
 
-  parsed_code <- parse(text = code, keep.source = TRUE)
+  parsed_code <- parse(text = tcode, keep.source = TRUE)
 
   pd <- utils::getParseData(parsed_code)
   pd <- normalize_pd(pd)
diff --git a/tests/testthat/test-qenv_concat.R b/tests/testthat/test-qenv_concat.R
index c7b55739..457a9d7b 100644
--- a/tests/testthat/test-qenv_concat.R
+++ b/tests/testthat/test-qenv_concat.R
@@ -7,7 +7,7 @@ testthat::test_that("Concatenate two identical qenvs outputs", {
 
   testthat::expect_equal(q12@env, q1@env)
   testthat::expect_identical(
-    q12@code,
+    unlist(q12@code),
     c("iris1 <- iris", "iris1 <- iris")
   )
 })
@@ -23,10 +23,12 @@ testthat::test_that("Concatenate two independent qenvs results in object having
 
   testthat::expect_equal(q12@env, list2env(list(iris1 = iris, mtcars1 = mtcars)))
   testthat::expect_identical(
-    q12@code,
+    unlist(q12@code),
     c("iris1 <- iris", "mtcars1 <- mtcars")
   )
-  testthat::expect_identical(q12@id, c(q1@id, q2@id))
+  q12_ids <- unlist(lapply(q12@code, "attr", "id"))
+  q1_q2_ids <- c(attr(q1@code[[1]], "id"), attr(q2@code[[1]], "id"))
+  testthat::expect_identical(q12_ids, q1_q2_ids)
 })
 
 testthat::test_that("Concatenate qenvs results with the same variable, the RHS has priority", {
@@ -57,7 +59,7 @@ testthat::test_that("Concatenate two independent qenvs with warnings results in
   q12 <- concat(q1, q2)
 
   testthat::expect_equal(
-    q12@warnings,
+    unlist(lapply(q12@code, attr, "warning")),
     c(
       "> This is warning 1\n",
       "> This is warning 2\n"
@@ -72,7 +74,7 @@ testthat::test_that("Concatenate two independent qenvs with messages results in
   q12 <- concat(q1, q2)
 
   testthat::expect_equal(
-    q12@messages,
+    unlist(lapply(q12@code, attr, "message")),
     c(
       "> This is message 1\n",
       "> This is message 2\n"
diff --git a/tests/testthat/test-qenv_constructor.R b/tests/testthat/test-qenv_constructor.R
index 20bec3dc..3a7daaf5 100644
--- a/tests/testthat/test-qenv_constructor.R
+++ b/tests/testthat/test-qenv_constructor.R
@@ -2,10 +2,10 @@ testthat::test_that("constructor returns qenv", {
   q <- qenv()
   testthat::expect_s4_class(q, "qenv")
   testthat::expect_identical(ls(q@env), character(0))
-  testthat::expect_identical(q@code, character(0))
-  testthat::expect_identical(q@id, integer(0))
-  testthat::expect_identical(q@warnings, character(0))
-  testthat::expect_identical(q@messages, character(0))
+  testthat::expect_null(unlist(q@code), NULL)
+  testthat::expect_null(attr(q@code, "id"))
+  testthat::expect_null(attr(q@code, "warning"))
+  testthat::expect_null(attr(q@code, "message"))
 })
 
 testthat::test_that("parent of qenv environment is the parent of .GlobalEnv", {
diff --git a/tests/testthat/test-qenv_eval_code.R b/tests/testthat/test-qenv_eval_code.R
index 4d4fc8d6..4b188ff2 100644
--- a/tests/testthat/test-qenv_eval_code.R
+++ b/tests/testthat/test-qenv_eval_code.R
@@ -41,21 +41,21 @@ 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(q1@code, "a <- 1")
+  testthat::expect_identical(unlist(q1@code), "a <- 1")
   testthat::expect_equal(q1@env, list2env(list(a = 1)))
 })
 
 testthat::test_that("eval_code works with expression", {
   q1 <- eval_code(qenv(), as.expression(quote(a <- 1)))
 
-  testthat::expect_identical(q1@code, "a <- 1")
+  testthat::expect_identical(unlist(q1@code), "a <- 1")
   testthat::expect_equal(q1@env, list2env(list(a = 1)))
 })
 
 testthat::test_that("eval_code works with quoted", {
   q1 <- eval_code(qenv(), quote(a <- 1))
 
-  testthat::expect_identical(q1@code, "a <- 1")
+  testthat::expect_identical(unlist(q1@code), "a <- 1")
   testthat::expect_equal(q1@env, list2env(list(a = 1)))
 })
 
@@ -69,7 +69,7 @@ testthat::test_that("eval_code works with quoted code block", {
   )
 
   testthat::expect_equal(
-    q1@code,
+    unlist(q1@code),
     c("a <- 1", "b <- 2")
   )
   testthat::expect_equal(q1@env, list2env(list(a = 1, b = 2)))
@@ -96,14 +96,17 @@ testthat::test_that("a warning when calling eval_code returns a qenv object whic
   q <- eval_code(q, quote("p <- hist(iris_data[, 'Sepal.Length'], ff = '')"))
   testthat::expect_s4_class(q, "qenv")
   testthat::expect_equal(
-    q@warnings,
-    c("", "> \"ff\" is not a graphical parameter\n")
+    lapply(q@code, attr, "warning"),
+    list(NULL, "> \"ff\" is not a graphical parameter\n")
   )
 })
 
 testthat::test_that("eval_code with a vector of code produces one warning element per code element", {
   q <- eval_code(qenv(), c("x <- 1", "y <- 1", "warning('warn1')"))
-  testthat::expect_equal(c("", "", "> warn1\n"), q@warnings)
+  testthat::expect_equal(
+    lapply(q@code, attr, "warning"),
+    list(NULL, NULL, "> warn1\n")
+  )
 })
 
 
@@ -112,9 +115,9 @@ testthat::test_that("a message when calling eval_code returns a qenv object whic
   q <- eval_code(q, quote("message('This is a message')"))
   testthat::expect_s4_class(q, "qenv")
   testthat::expect_equal(
-    q@messages,
-    c(
-      "",
+    lapply(q@code, attr, "message"),
+    list(
+      NULL,
       "> This is a message\n"
     )
   )
@@ -123,6 +126,6 @@ testthat::test_that("a message when calling eval_code returns a qenv object whic
 testthat::test_that("eval_code returns a qenv object with empty messages and warnings when none are returned", {
   q <- eval_code(qenv(), quote("iris_data <- head(iris)"))
   testthat::expect_s4_class(q, "qenv")
-  testthat::expect_equal(q@messages, "")
-  testthat::expect_equal(q@warnings, "")
+  testthat::expect_null(attr(q@code, "message"))
+  testthat::expect_null(attr(q@code, "warning"))
 })
diff --git a/tests/testthat/test-qenv_extract.R b/tests/testthat/test-qenv_extract.R
index 214d4c2c..869d610e 100644
--- a/tests/testthat/test-qenv_extract.R
+++ b/tests/testthat/test-qenv_extract.R
@@ -1,3 +1,4 @@
+
 testthat::test_that("`[.` returns empty qenv for names not in qenv", {
   data <- within(qenv(), {
     x <- 1
@@ -36,7 +37,7 @@ testthat::test_that("`[.` extract proper code", {
   object_names <- c("x", "a")
   qs <- q[object_names]
   testthat::expect_identical(
-    qs@code,
+    unlist(qs@code),
     c("x<-1", "a<-1")
   )
 })
@@ -47,7 +48,7 @@ testthat::test_that("`[.` preservers comments in the code", {
   q <- eval_code(q, code)
   qs <- q[c("x", "a")]
   testthat::expect_identical(
-    qs@code,
+    unlist(qs@code),
     c("x<-1 #comment", "a<-1")
   )
 })
@@ -59,8 +60,9 @@ testthat::test_that("`[.` extract proper elements of @id, @warnings and @message
   q <- eval_code(q, code)
   qs <- q[c("x", "a")]
 
-  testthat::expect_identical(qs@id, q@id[c(1, 3)])
-  testthat::expect_identical(qs@code, q@code[c(1, 3)])
-  testthat::expect_identical(qs@warnings, q@warnings[c(1, 3)])
-  testthat::expect_identical(qs@messages, q@messages[c(1, 3)])
+  testthat::expect_identical(get_code_attr(qs, "id"), get_code_attr(q, "id")[c(1, 3)])
+  testthat::expect_identical(unlist(qs@code), unlist(q@code[c(1, 3)]))
+  testthat::expect_null(get_code_attr(qs, "warning"))
+  testthat::expect_null(get_code_attr(qs, "message"))
 })
+
diff --git a/tests/testthat/test-qenv_get_code.R b/tests/testthat/test-qenv_get_code.R
index fbc0569b..7b996ae0 100644
--- a/tests/testthat/test-qenv_get_code.R
+++ b/tests/testthat/test-qenv_get_code.R
@@ -2,7 +2,7 @@ testthat::test_that("get_code returns code (character by default) of qenv object
   q <- qenv() |>
     eval_code(quote(x <- 1)) |>
     eval_code(quote(y <- x))
-  testthat::expect_equal(get_code(q), c("x <- 1", "y <- x"))
+  testthat::expect_equal(unlist(get_code(q)), c("x <- 1", "y <- x"))
 })
 
 testthat::test_that("get_code handles code elements being code-blocks", {
@@ -15,7 +15,7 @@ testthat::test_that("get_code handles code elements being code-blocks", {
       z <- 5
     })
   )
-  testthat::expect_equal(get_code(q), c("x <- 1", "y <- x", "z <- 5"))
+  testthat::expect_equal(unlist(get_code(q)), c("x <- 1", "y <- x", "z <- 5"))
 })
 
 testthat::test_that("get_code returns expression of qenv object if deparse = FALSE", {
@@ -23,8 +23,8 @@ testthat::test_that("get_code returns expression of qenv object if deparse = FAL
   q <- eval_code(q, quote(x <- 1))
   q <- eval_code(q, quote(y <- x))
   testthat::expect_equivalent(
-    toString(get_code(q, deparse = FALSE)),
-    toString(parse(text = paste(c("{", q@code, "}"), collapse = "\n"), keep.source = TRUE))
+    toString(unlist(get_code(q, deparse = FALSE))),
+    toString(parse(text = paste(c("{", unlist(q@code), "}"), collapse = "\n"), keep.source = TRUE))
   )
 })
 
@@ -51,11 +51,11 @@ testthat::test_that("get_code called with qenv.error returns error with trace in
 testthat::test_that("handles empty @code slot", {
   testthat::expect_identical(
     get_code(qenv(), names = "a"),
-    character(0)
+    list()
   )
   testthat::expect_identical(
     get_code(eval_code(qenv(), code = ""), names = "a"),
-    character(0)
+    list()
   )
 })
 
@@ -67,7 +67,7 @@ testthat::test_that("handles the code without symbols on rhs", {
   )
 
   testthat::expect_identical(
-    get_code(eval_code(qenv(), code), names = "a"),
+    unlist(get_code(eval_code(qenv(), code), names = "a")),
     "a <- 5"
   )
 })
@@ -75,8 +75,8 @@ testthat::test_that("handles the code without symbols on rhs", {
 testthat::test_that("handles the code included in curly brackets", {
   code <- "{1 + 1;a <- 5}"
 
+  testthat::skip("# TODO: to be fixed")
   testthat::expect_identical(
-    # TODO: to be fixed
     get_code(eval_code(qenv(), code), names = "a"),
     "a <- 5"
   )
@@ -87,8 +87,8 @@ testthat::test_that("handles the code of length > 1 when at least one is enclose
   q <- eval_code(eval_code(qenv(), code[1]), code[2])
 
   testthat::expect_identical(
-    get_code(q, names = "a"),
-    "a<-5"
+    unlist(get_code(q, names = "a")),
+    "{a<-5}"
   )
 })
 
@@ -100,11 +100,11 @@ testthat::test_that("extracts the code of a binding from character vector contai
   )
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
-    get_code(q, names = "a"),
+    unlist(get_code(q, names = "a")),
     "a <- 1"
   )
   testthat::expect_identical(
-    get_code(q, names = "b"),
+    unlist(get_code(q, names = "b")),
     "b <- 2"
   )
 })
@@ -116,7 +116,7 @@ testthat::test_that("extracts the code without downstream usage", {
   )
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
-    get_code(q, names = "a"),
+    unlist(get_code(q, names = "a")),
     "a <- 1"
   )
 })
@@ -128,7 +128,7 @@ testthat::test_that("works for names of length > 1", {
   )
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
-    get_code(q, names = c("a", "b")),
+    unlist(get_code(q, names = c("a", "b"))),
     code
   )
 })
@@ -137,7 +137,7 @@ testthat::test_that("warns if binding doesn't exist in code", {
   code <- c("a <- 1")
   q <- eval_code(qenv(), code)
   testthat::expect_warning(
-    get_code(q, names = "c"),
+    unlist(get_code(q, names = "c")),
     "Object\\(s\\) not found in code: c"
   )
 })
@@ -151,15 +151,15 @@ testthat::test_that("does not fall into a loop", {
   )
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
-    get_code(q, names = "a"),
+    unlist(get_code(q, names = "a")),
     code
   )
   testthat::expect_identical(
-    get_code(q, names = "b"),
+    unlist(get_code(q, names = "b")),
     code[1:2]
   )
   testthat::expect_identical(
-    get_code(q, names = "c"),
+    unlist(get_code(q, names = "c")),
     code[1:3]
   )
 })
@@ -173,7 +173,7 @@ testthat::test_that("extracts code of a parent binding but only those evaluated
   )
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
-    get_code(q, names = "b"),
+    unlist(get_code(q, names = "b")),
     c("a <- 1", "b <- a")
   )
 })
@@ -186,7 +186,7 @@ testthat::test_that("extracts the code of a parent binding if used as an arg in
   )
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
-    get_code(q, names = "b"),
+    unlist(get_code(q, names = "b")),
     c("a <- 1", "b <- identity(x = a)")
   )
 })
@@ -199,7 +199,7 @@ testthat::test_that("extracts the code when using <<-", {
   )
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
-    get_code(q, names = "b"),
+    unlist(get_code(q, names = "b")),
     c("a <- 1", "b <- a", "b <<- b + 2")
   )
 })
@@ -212,7 +212,7 @@ testthat::test_that("detects every assign calls even if not evaluated, if there
   )
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
-    get_code(q, names = "b"),
+    unlist(get_code(q, names = "b")),
     code[2:3]
   )
 })
@@ -234,7 +234,7 @@ testthat::test_that("does not break if code is separated by ;", {
   )
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
-    get_code(q, names = "a"),
+    unlist(get_code(q, names = "a")),
     c("a <- 1", "a <- a + 1")
   )
 })
@@ -247,7 +247,7 @@ testthat::test_that("does not break if code uses quote()", {
   )
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
-    get_code(q, names = "x"),
+    unlist(get_code(q, names = "x")),
     code[2]
   )
 })
@@ -260,7 +260,7 @@ testthat::test_that("does not break if object is used in a function on lhs", {
   )
   q <- eval_code(qenv(), code = code)
   testthat::expect_identical(
-    get_code(q, names = "iris"),
+    unlist(get_code(q, names = "iris")),
     code[c(1, 3)]
   )
 })
@@ -275,7 +275,7 @@ testthat::test_that(
     )
     q <- eval_code(qenv(), code = code)
     testthat::expect_identical(
-      get_code(q, names = "x"),
+      unlist(get_code(q, names = "x")),
       code
     )
   }
@@ -295,15 +295,15 @@ testthat::test_that("extracts the code for assign() where \"x\" is a literal str
   )
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
-    get_code(q, names = "b"),
+    unlist(get_code(q, names = "b")),
     code[c(2, 5)]
   )
   testthat::expect_identical(
-    get_code(q, names = "c"),
+    unlist(get_code(q, names = "c")),
     code[c(2, 3, 5, 6)]
   )
   testthat::expect_identical(
-    get_code(q, names = "d"),
+    unlist(get_code(q, names = "d")),
     c("assign(value = 15, x = \"d\")", "d <- d * 2")
   )
 })
@@ -317,7 +317,7 @@ testthat::test_that("extracts the code for assign() where \"x\" is variable", {
   )
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
-    get_code(q, names = "b"),
+    unlist(get_code(q, names = "b")),
     code
   )
 })
@@ -334,7 +334,7 @@ testthat::test_that("works for assign() detection no matter how many parametrers
   q <- eval_code(qenv(), code)
 
   testthat::expect_identical(
-    get_code(q, names = "y"),
+    unlist(get_code(q, names = "y")),
     code
   )
 })
@@ -350,11 +350,11 @@ testthat::test_that("detects function usage of the assignment operator", {
   q2 <- eval_code(qenv(), code2)
 
   testthat::expect_identical(
-    get_code(q, names = "y"),
+    unlist(get_code(q, names = "y")),
     code
   )
   testthat::expect_identical(
-    get_code(q2, names = "y"),
+    unlist(get_code(q2, names = "y")),
     code2
   )
 })
@@ -373,7 +373,7 @@ testthat::test_that("get_code does not break if @linksto is put in the last line
   )
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
-    get_code(q, names = "x"),
+    unlist(get_code(q, names = "x")),
     code
   )
 })
@@ -385,7 +385,7 @@ testthat::test_that("@linksto makes a line being returned for an affected bindin
   "
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
-    get_code(q, names = "b"),
+    unlist(get_code(q, names = "b")),
     c("  a <- 1 # @linksto b", "  b <- 2")
   )
 })
@@ -400,7 +400,7 @@ testthat::test_that(
     )
     q <- eval_code(qenv(), code)
     testthat::expect_identical(
-      get_code(q, names = "b"),
+      unlist(get_code(q, names = "b")),
       code
     )
   }
@@ -417,11 +417,11 @@ testthat::test_that(
     )
     q <- eval_code(qenv(), code)
     testthat::expect_identical(
-      get_code(q, names = "a"),
+      unlist(get_code(q, names = "a")),
       code[1:3]
     )
     testthat::expect_identical(
-      get_code(q, names = "b"),
+      unlist(get_code(q, names = "b")),
       code[c(2, 4)]
     )
   }
@@ -438,7 +438,7 @@ testthat::test_that(
     )
     q <- eval_code(qenv(), code)
     testthat::expect_identical(
-      get_code(q, names = "classes"),
+      unlist(get_code(q, names = "classes")),
       code
     )
   }
@@ -462,7 +462,7 @@ testthat::test_that("comments fall into proper calls", {
 
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
-    get_code(q),
+    unlist(get_code(q)),
     c(
       "    # initial comment\n    a <- 1",
       "    b <- 2 # inline comment",
@@ -488,7 +488,7 @@ testthat::test_that("comments get pasted when they fall into calls", {
 
   q <- qenv() |> eval_code(code)
   testthat::expect_identical(
-    get_code(q),
+    unlist(get_code(q)),
     c(
       "    # initial comment\n    a <- 1 # A comment",
       "    b <- 2 # inline comment",
@@ -507,11 +507,11 @@ testthat::test_that("ignores occurrence in a function definition", {
   )
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
-    get_code(q, names = "b"),
+    unlist(get_code(q, names = "b")),
     "b <- 2"
   )
   testthat::expect_identical(
-    get_code(q, names = "foo"),
+    unlist(get_code(q, names = "foo")),
     code[2]
   )
 })
@@ -523,11 +523,11 @@ testthat::test_that("ignores occurrence in a function definition that has functi
   )
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
-    get_code(q, names = "b"),
+    unlist(get_code(q, names = "b")),
     code[1]
   )
   testthat::expect_identical(
-    get_code(q, names = "foo"),
+    unlist(get_code(q, names = "foo")),
     code[2]
   )
 })
@@ -541,11 +541,11 @@ testthat::test_that("ignores occurrence in a function definition if there is mul
   )
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
-    get_code(q, names = "b"),
+    unlist(get_code(q, names = "b")),
     code[c(1, 3)]
   )
   testthat::expect_identical(
-    get_code(q, names = "foo"),
+    unlist(get_code(q, names = "foo")),
     code[2]
   )
 })
@@ -560,7 +560,7 @@ testthat::test_that("ignores occurrence in a function definition in lapply", {
   )
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
-    get_code(q, names = "x"),
+    unlist(get_code(q, names = "x")),
     "x <- 1"
   )
 })
@@ -575,7 +575,7 @@ testthat::test_that("does not ignore occurrence in function body if object exsit
   )
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
-    get_code(q, names = "b"),
+    unlist(get_code(q, names = "b")),
     code
   )
 })
@@ -587,11 +587,11 @@ testthat::test_that("ignores occurrence in function definition without { curly b
   )
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
-    get_code(q, names = "foo"),
+    unlist(get_code(q, names = "foo")),
     "foo <- function(b) b <- b + 2"
   )
   testthat::expect_identical(
-    get_code(q, names = "b"),
+    unlist(get_code(q, names = "b")),
     "b <- 2"
   )
 })
@@ -605,7 +605,7 @@ testthat::test_that("detects occurrence of the function object", {
   )
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
-    get_code(q, names = "b"),
+    unlist(get_code(q, names = "b")),
     code
   )
 })
@@ -618,7 +618,7 @@ testthat::test_that("detects occurrence of a function definition when a formal i
   )
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
-    get_code(q, names = "a"),
+    unlist(get_code(q, names = "a")),
     code
   )
 })
@@ -635,7 +635,7 @@ testthat::test_that("detects occurrence of a function definition with a @linksto
   )
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
-    get_code(q, names = "x"),
+    unlist(get_code(q, names = "x")),
     c(
       "        foo <- function() {\n          env <- parent.frame()\n          env$x <- 0\n        }",
       "foo() # @linksto x"
@@ -654,11 +654,11 @@ testthat::test_that("understands $ usage and do not treat rhs of $ as objects (o
   )
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
-    get_code(q, names = "x"),
+    unlist(get_code(q, names = "x")),
     "x <- data.frame(a = 1:3)"
   )
   testthat::expect_identical(
-    get_code(q, names = "a"),
+    unlist(get_code(q, names = "a")),
     code
   )
 })
@@ -671,7 +671,7 @@ testthat::test_that("detects cooccurrence properly even if all objects are on lh
   )
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
-    get_code(q, names = "b"),
+    unlist(get_code(q, names = "b")),
     code
   )
 })
@@ -680,7 +680,7 @@ testthat::test_that("detects cooccurrence properly even if all objects are on lh
 # @ ---------------------------------------------------------------------------------------------------------------
 
 testthat::test_that("understands @ usage and do not treat rhs of @ as objects (only lhs)", {
-  code <- c(
+  code <- list(
     "setClass('aclass', slots = c(a = 'numeric', x = 'numeric', y = 'numeric')) # @linksto a x",
     "x <- new('aclass', a = 1:3, x = 1:3, y = 1:3)",
     "a <- new('aclass', a = 1:3, x = 1:3, y = 1:3)",
@@ -714,7 +714,7 @@ testthat::test_that("library() and require() are always returned", {
   )
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
-    get_code(q, names = "x"),
+    unlist(get_code(q, names = "x")),
     code[c(2, 3, 4)]
   )
 })
@@ -732,7 +732,7 @@ testthat::test_that("data() call is returned when data name is provided as is",
   )
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
-    get_code(q, names = "x"),
+    unlist(get_code(q, names = "x")),
     code[-1]
   )
 })
@@ -747,7 +747,7 @@ testthat::test_that("data() call is returned when data name is provided as a cha
   )
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
-    get_code(q, names = "z"),
+    unlist(get_code(q, names = "z")),
     code[-1]
   )
 })
@@ -764,7 +764,7 @@ testthat::describe("Backticked symbol", {
     )
 
     testthat::expect_identical(
-      get_code(td, names = "%cbind%"),
+      unlist(get_code(td, names = "%cbind%")),
       "`%cbind%` <- function(lhs, rhs) cbind(lhs, rhs)"
     )
   })
@@ -779,7 +779,7 @@ testthat::describe("Backticked symbol", {
     )
 
     testthat::expect_identical(
-      get_code(td, names = "`%cbind%`"),
+      unlist(get_code(td, names = "`%cbind%`")),
       "`%cbind%` <- function(lhs, rhs) cbind(lhs, rhs)"
     )
   })
@@ -794,7 +794,7 @@ testthat::describe("Backticked symbol", {
     )
 
     testthat::expect_identical(
-      get_code(td, names = "iris_ds"),
+      unlist(get_code(td, names = "iris_ds")),
       c(
         "`_add_column_` <- function(lhs, rhs) cbind(lhs, rhs)",
         "iris_ds <- `_add_column_`(iris, data.frame(new_col = \"new column\"))"
@@ -812,7 +812,7 @@ testthat::describe("Backticked symbol", {
     )
 
     testthat::expect_identical(
-      get_code(td, names = "iris_ds"),
+      unlist(get_code(td, names = "iris_ds")),
       c(
         "`add column` <- function(lhs, rhs) cbind(lhs, rhs)",
         "iris_ds <- `add column`(iris, data.frame(new_col = \"new column\"))"
@@ -830,7 +830,7 @@ testthat::describe("Backticked symbol", {
     )
 
     testthat::expect_identical(
-      get_code(td, names = "iris_ds"),
+      unlist(get_code(td, names = "iris_ds")),
       c(
         "add_column <- function(lhs, rhs) cbind(lhs, rhs)",
         "iris_ds <- add_column(iris, data.frame(new_col = \"new column\"))"
@@ -850,7 +850,7 @@ testthat::describe("Backticked symbol", {
     # Note that the original code is changed to use the non-native pipe operator
     # correctly.
     testthat::expect_identical(
-      get_code(td, names = "iris_ds"),
+      unlist(get_code(td, names = "iris_ds")),
       c(
         "`%add_column%` <- function(lhs, rhs) cbind(lhs, rhs)",
         "iris_ds <- iris %add_column% data.frame(new_col = \"new column\")"
@@ -870,7 +870,7 @@ testthat::describe("Backticked symbol", {
     # Note that the original code is changed to use the non-native pipe operator
     # correctly.
     testthat::expect_identical(
-      get_code(td, names = "iris_ds"),
+      unlist(get_code(td, names = "iris_ds")),
       c(
         "`%add_column%` <- function(lhs, rhs) cbind(lhs, rhs)",
         "iris_ds <- iris %add_column% data.frame(new_col = \"new column\")"
diff --git a/tests/testthat/test-qenv_join.R b/tests/testthat/test-qenv_join.R
index ac5a1053..6690326d 100644
--- a/tests/testthat/test-qenv_join.R
+++ b/tests/testthat/test-qenv_join.R
@@ -6,8 +6,8 @@ testthat::test_that("Joining two identical qenvs outputs the same object", {
   q <- join(q1, q2)
 
   testthat::expect_equal(q@env, q1@env)
-  testthat::expect_identical(q@code, "iris1 <- iris")
-  testthat::expect_identical(q@id, q1@id)
+  testthat::expect_identical(unlist(q@code), "iris1 <- iris")
+  testthat::expect_identical(get_code_attr(q, "id"), get_code_attr(q1, "id"))
 })
 
 testthat::test_that("Joining two independent qenvs results in object having combined code and environments", {
@@ -19,10 +19,10 @@ testthat::test_that("Joining two independent qenvs results in object having comb
 
   testthat::expect_equal(q@env, list2env(list(iris1 = iris, mtcars1 = mtcars)))
   testthat::expect_identical(
-    q@code,
+    unlist(q@code),
     c("iris1 <- iris", "mtcars1 <- mtcars")
   )
-  testthat::expect_identical(q@id, c(q1@id, q2@id))
+  testthat::expect_identical(get_code_attr(q, "id"), c(get_code_attr(q1, "id"), get_code_attr(q2, "id")))
 })
 
 testthat::test_that("Joined qenv does not duplicate common code", {
@@ -39,10 +39,10 @@ testthat::test_that("Joined qenv does not duplicate common code", {
   q <- join(q1, q2)
 
   testthat::expect_identical(
-    q@code,
+    unlist(q@code),
     c("iris1 <- iris", "mtcars1 <- mtcars", "mtcars2 <- mtcars")
   )
-  testthat::expect_identical(q@id, c(q1@id, q2@id[3]))
+  testthat::expect_identical(get_code_attr(q, "id"), c(get_code_attr(q1, "id"), get_code_attr(q2, "id")[3]))
 })
 
 testthat::test_that("Not able to join two qenvs if any of the shared objects changed", {
@@ -63,7 +63,7 @@ testthat::test_that("join does not duplicate code but adds only extra code", {
   q <- join(q1, q2)
 
   testthat::expect_identical(
-    q@code,
+    unlist(q@code),
     c("iris1 <- iris", "mtcars1 <- mtcars", "iris2 <- iris", "mtcars2 <- mtcars")
   )
 
@@ -72,7 +72,7 @@ testthat::test_that("join does not duplicate code but adds only extra code", {
     list(iris1 = iris, iris2 = iris, mtcars1 = mtcars, mtcars2 = mtcars)
   )
 
-  testthat::expect_identical(q@id, c(q1@id, q2@id[3]))
+  testthat::expect_identical(get_code_attr(q, "id"), c(get_code_attr(q1, "id"), get_code_attr(q2, "id")[3]))
 })
 
 testthat::test_that("Not possible to join qenvs which share some code when one of the shared object was modified", {
@@ -96,8 +96,8 @@ testthat::test_that("qenv objects are mergeable if they don't share any code (id
   cq <- join(q1, q2)
   testthat::expect_s4_class(cq, "qenv")
   testthat::expect_equal(cq@env, list2env(list(a1 = 1)))
-  testthat::expect_identical(cq@code, c("a1 <- 1", "a1 <- 1"))
-  testthat::expect_identical(cq@id, c(q1@id, q2@id))
+  testthat::expect_identical(unlist(cq@code), c("a1 <- 1", "a1 <- 1"))
+  testthat::expect_identical(get_code_attr(cq, "id"), c(get_code_attr(q1, "id"), get_code_attr(q2, "id")))
 })
 
 testthat::test_that("qenv objects are mergeable if they share common initial qenv elements", {
@@ -110,10 +110,10 @@ testthat::test_that("qenv objects are mergeable if they share common initial qen
   testthat::expect_s4_class(cq, "qenv")
   testthat::expect_equal(cq@env, list2env(list(a1 = 1, b1 = 2, a2 = 3)))
   testthat::expect_identical(
-    cq@code,
+    unlist(cq@code),
     c("a1 <- 1", "a2 <- 3", "b1 <- 2")
   )
-  testthat::expect_identical(cq@id, union(q1@id, q2@id))
+  testthat::expect_identical(get_code_attr(cq, "id"), c(get_code_attr(q1, "id"), get_code_attr(q2, "id")[2]))
 })
 
 testthat::test_that(
@@ -163,7 +163,7 @@ testthat::test_that("Joining two independent qenvs with warnings results in obje
   q <- join(q1, q2)
 
   testthat::expect_equal(
-    q@warnings,
+    get_code_attr(q, "warning"),
     c(
       "> This is warning 1\n",
       "> This is warning 2\n"
@@ -179,7 +179,7 @@ testthat::test_that("Joining two independent qenvs with messages results in obje
   q <- join(q1, q2)
 
   testthat::expect_equal(
-    q@messages,
+    get_code_attr(q, "message"),
     c(
       "> This is message 1\n",
       "> This is message 2\n"
diff --git a/tests/testthat/test-qenv_within.R b/tests/testthat/test-qenv_within.R
index a05d0a03..4d0f32c4 100644
--- a/tests/testthat/test-qenv_within.R
+++ b/tests/testthat/test-qenv_within.R
@@ -26,7 +26,7 @@ testthat::test_that("styling of input code does not impact evaluation results",
     1 +
       1
   })
-  all_code <- get_code(q)
+  all_code <- unlist(get_code(q))
   testthat::expect_identical(
     all_code,
     rep("1 + 1", 4L)
@@ -45,7 +45,7 @@ testthat::test_that("styling of input code does not impact evaluation results",
     1 + 1;
     2 + 2
   })
-  all_code <- get_code(q)
+  all_code <- unlist(get_code(q))
   testthat::expect_identical(
     all_code,
     rep(c("1 + 1", "2 + 2"), 4L)
@@ -85,7 +85,7 @@ testthat::test_that("external values can be injected into expressions through `.
   },
   species = external_value)
 
-  testthat::expect_identical(get_code(q), "i <- subset(iris, Species == \"virginica\")")
+  testthat::expect_identical(unlist(get_code(q)), "i <- subset(iris, Species == \"virginica\")")
 })
 
 testthat::test_that("external values are not taken from calling frame", {
@@ -95,14 +95,14 @@ testthat::test_that("external values are not taken from calling frame", {
     i <- subset(iris, Species == species)
   })
   testthat::expect_s3_class(qq, "qenv.error")
-  testthat::expect_error(get_code(qq), "object 'species' not found")
+  testthat::expect_error(unlist(get_code(qq)), "object 'species' not found")
 
   qq <- within(q, {
     i <- subset(iris, Species == species)
   },
   species = species)
   testthat::expect_s4_class(qq, "qenv")
-  testthat::expect_identical(get_code(qq), "i <- subset(iris, Species == \"setosa\")")
+  testthat::expect_identical(unlist(get_code(qq)), "i <- subset(iris, Species == \"setosa\")")
 })
 
 # nolint end
diff --git a/vignettes/qenv.Rmd b/vignettes/qenv.Rmd
index 00fbf4ba..484e081b 100644
--- a/vignettes/qenv.Rmd
+++ b/vignettes/qenv.Rmd
@@ -122,22 +122,17 @@ The feasibility of joining `qenv` objects hinges on the contents of the environm
 
 ### Warnings and messages in `qenv` objects
 
-In cases where warnings or messages arise while evaluating code within a `qenv` environment, these are captured and stored within the `qenv` object. Access these messages and warnings using the `@` operator.
+In cases where warnings or messages arise while evaluating code within a `qenv` environment, these are captured and stored within the `qenv` object. Access these messages and warnings using attributes of `@code` slot
 
 ```{r}
 q_message <- eval_code(qenv(), quote(message("this is a message")))
-q_message@messages
+lapply(q_message@code, "attr", "messages")
 
 q_warning <- eval_code(qenv(), quote(warning("and this is a warning")))
-q_warning@warnings
+lapply(q_warning@code, "attr", "warnings")
 ```
 
-If a particular line of code doesn't trigger any warnings or messages, the corresponding message/warning value will be an empty string.
-
-```{r}
-q_message@warnings
-q_warning@messages
-```
+If a particular line of code doesn't trigger any warnings or messages, the corresponding message/warning value will be `NULL`.
 
 Additionally, a helper function, `get_warnings()`, is available to generate a formatted string comprising the warnings and the code responsible for generating them. It returns `NULL` when no warnings are present.
 

From 69c08d3a310d2b8455c45ed2ef378b4c9bf0ade0 Mon Sep 17 00:00:00 2001
From: go_gonzo <dawid.kaledkowski@gmail.com>
Date: Thu, 31 Oct 2024 14:29:34 +0100
Subject: [PATCH 38/98] code split

---
 R/qenv-eval_code.R                  |   7 +-
 R/utils-get_code_dependency.R       | 136 ++++++++--------------------
 tests/testthat/test-qenv_get_code.R |  15 ++-
 3 files changed, 55 insertions(+), 103 deletions(-)

diff --git a/R/qenv-eval_code.R b/R/qenv-eval_code.R
index b6c184b8..570d0d06 100644
--- a/R/qenv-eval_code.R
+++ b/R/qenv-eval_code.R
@@ -35,7 +35,7 @@ setMethod("eval_code", signature = c("qenv", "character"), function(object, code
 
   object@env <- rlang::env_clone(object@env, parent = parent.env(.GlobalEnv))
   code_split <- split_code(paste(code, collapse = "\n"))
-
+  print(code_split)
   for (i in seq_along(code_split)) {
     current_code <- code_split[[i]]
     current_call <- parse(text = current_code, keep.source = FALSE)
@@ -92,6 +92,7 @@ setMethod("eval_code", signature = c("qenv", "language"), function(object, code)
 })
 
 setMethod("eval_code", signature = c("qenv", "expression"), function(object, code) {
+  # todo: if has srcfile then get original text!
   eval_code(object, code = paste(lang2calls(code), collapse = "\n"))
 })
 
@@ -109,7 +110,7 @@ setMethod("eval_code", signature = c("qenv.error", "ANY"), function(object, code
   }
 }
 
-get_code_attr <- function(qenv, attr){
-  #unlist(lapply(qenv@code, attr, attr)) # somehow doesn't work
+get_code_attr <- function(qenv, attr) {
+  # unlist(lapply(qenv@code, attr, attr)) # somehow doesn't work
   unlist(lapply(qenv@code, function(x) attr(x, attr)))
 }
diff --git a/R/utils-get_code_dependency.R b/R/utils-get_code_dependency.R
index 0942f867..193db7c8 100644
--- a/R/utils-get_code_dependency.R
+++ b/R/utils-get_code_dependency.R
@@ -110,17 +110,16 @@ find_call <- function(call_pd, text) {
 #' @noRd
 extract_calls <- function(pd) {
   calls <- lapply(
-    pd[pd$parent == 0, "id"],
+    pd[pd$parent == 0 & pd$token != "COMMENT", "id"],
     function(parent) {
       rbind(
-        pd[pd$id == parent, c("token", "text", "id", "parent")],
+        pd[pd$id == parent, ],
         get_children(pd = pd, parent = parent)
       )
     }
   )
   calls <- Filter(function(call) !(nrow(call) == 1 && call$token == "';'"), calls)
   calls <- Filter(Negate(is.null), calls)
-  calls <- fix_shifted_comments(calls)
   fix_arrows(calls)
 }
 
@@ -128,7 +127,7 @@ extract_calls <- function(pd) {
 #' @noRd
 get_children <- function(pd, parent) {
   idx_children <- abs(pd$parent) == parent
-  children <- pd[idx_children, c("token", "text", "id", "parent")]
+  children <- pd[idx_children, ]
   if (nrow(children) == 0) {
     return(NULL)
   }
@@ -454,71 +453,29 @@ normalize_pd <- function(pd) {
   pd
 }
 
-#' Get line and cols ids of starts and ends of calls
+#' Get line/column in the source where the calls end
 #'
-#' @param pd `data.frame` resulting from `utils::getParseData()` call.
 #'
-#' @return list of `data.frames` containing number of lines and columns of starts and ends of calls included in `pd`.
+#' @param code `character(1)`
+#'
+#' @return `matrix` with `colnames = c("line", "col")`
 #'
 #' @keywords internal
 #' @noRd
-get_line_ids <- function(pd) {
-  if (pd$token[1] == "COMMENT") {
-    first_comment <- 1:(which(pd$parent == 0)[1] - 1)
-    pd_first_comment <- pd[first_comment, ]
-    pd <- pd[-first_comment, ]
-
-    n <- nrow(pd_first_comment)
-    first_comment_ids <- data.frame(
-      lines = c(pd_first_comment[1, "line1"], pd_first_comment[n, "line2"]),
-      cols = c(pd_first_comment[1, "col1"], pd_first_comment[n, "col2"])
-    )
-  } else {
-    first_comment_ids <- NULL
-  }
-
-  if (pd$token[nrow(pd)] == "COMMENT") {
-    last_comment <- which(pd$parent == 0 & pd$token == "COMMENT")
-    pd_last_comment <- pd[last_comment, ]
-    pd <- pd[-last_comment, ]
-
-    n <- nrow(pd_last_comment)
-    last_comment_ids <- data.frame(
-      lines = c(pd_last_comment[1, "line1"], pd_last_comment[n, "line2"]),
-      cols = c(pd_last_comment[1, "col1"], pd_last_comment[n, "col2"])
-    )
-  } else {
-    last_comment_ids <- NULL
-  }
-
-  # If NUM_CONST is the last element, we need to reorder rows.
-  # Last 2 rows
-  n <- nrow(pd)
-  if (pd$token[n - 1] == "NUM_CONST" && pd$parent[n] == 0) {
-    pd <- rbind(pd[-(n - 1), ], pd[n - 1, ])
-  }
-
-  calls_start <- which(pd$parent == 0)
-  calls_end <- c(which(pd$parent == 0)[-1] - 1, nrow(pd))
-
-  call_ids <- list()
-  for (i in seq_along(calls_start)) {
-    call <- pd[c(calls_start[i], calls_end[i]), ]
-    call_ids[[i]] <-
-      data.frame(
-        lines = c(call[1, "line1"], call[2, "line2"]),
-        cols = c(call[1, "col1"], call[2, "col2"])
-      )
-  }
-
-  if (!is.null(first_comment_ids)) {
-    call_ids[[1]] <- rbind(first_comment_ids[1, ], call_ids[[1]][2, ])
-  }
-  if (!is.null(last_comment_ids)) {
-    n <- length(call_ids)
-    call_ids[[n]] <- rbind(call_ids[[n]][1, ], last_comment_ids[2, ])
-  }
-  call_ids
+get_call_breaks <- function(code) {
+  parsed_code <- parse(text = code, keep.source = TRUE)
+  pd <- utils::getParseData(parsed_code)
+  pd <- normalize_pd(pd)
+  pd <- pd[pd$token != "';'", ]
+  call_breaks <- t(sapply(
+    extract_calls(pd),
+    function(x) {
+      matrix(c(max(x$line2), max(x$col2)))
+    }
+  ))
+  if (nrow(call_breaks) > 1) call_breaks <- call_breaks[-nrow(call_breaks), ] # breaks in between needed only
+  colnames(call_breaks) <- c("line", "col")
+  call_breaks
 }
 
 #' Split code by calls
@@ -530,40 +487,23 @@ get_line_ids <- function(pd) {
 #' @keywords internal
 #' @noRd
 split_code <- function(code) {
-  parsed_code <- parse(text = code, keep.source = TRUE)
-  pd <- utils::getParseData(parsed_code)
-  pd <- normalize_pd(pd)
-  pd <- pd[pd$token != "';'", ]
-  lines_ids <- get_line_ids(pd)
-
+  call_breaks <- get_call_breaks(code)
+  call_breaks <- call_breaks[order(call_breaks[, "line"], call_breaks[, "col"]), ]
   code_split <- strsplit(code, split = "\n", fixed = TRUE)[[1]]
-  code_split_calls <- list()
-
-  for (i in seq_along(lines_ids)) {
-    code_lines <- code_split[lines_ids[[i]]$lines[1]:lines_ids[[i]]$lines[2]]
-
-    if (length(code_lines) == 1) {
-      code_lines_candidate <- substr(code_lines, lines_ids[[i]]$cols[1], lines_ids[[i]]$cols[2])
-      # in case only indentantion is changed, do not trim the indentation
-      if (!identical(code_lines_candidate, trimws(code_lines))) {
-        # case of multiple calls in one line, keep the original indentation
-        indentation <- if (grepl("^\\s+", code_lines)) {
-          gsub("^(\\s+).*", "\\1", code_lines)
-        } else {
-          ""
-        }
-        code_lines <- paste0(indentation, code_lines_candidate)
-      }
-    } else {
-      code_lines_candidate <- substr(code_lines[1], lines_ids[[i]]$cols[1], nchar(code_lines[1]))
-      # in case only indentantion is changed, do not trim the indentation
-      if (!identical(code_lines_candidate, trimws(code_lines[1]))) {
-        code_lines[1] <- code_lines_candidate
-      }
-      code_lines[length(code_lines)] <- substr(code_lines[length(code_lines)], 1, lines_ids[[i]]$cols[2])
-    }
+  char_count_lines <- c(0, cumsum(sapply(code_split, nchar, USE.NAMES = FALSE) + 1), -1)[seq_along(code_split)]
 
-    code_split_calls[[i]] <- paste(code_lines, collapse = "\n")
-  }
-  code_split_calls
+  idx_start <- c(
+    0, # first call starts in the beginning of src
+    char_count_lines[call_breaks[, "line"]] + call_breaks[, "col"] + 2
+  )
+  idx_end <- c(
+    char_count_lines[call_breaks[, "line"]] + call_breaks[, "col"] + 1,
+    nchar(code) # last call end in the end of src
+  )
+  new_code <- substring(code, idx_start, idx_end)
+
+  # we need to remove leading semicolons from the calls and move them to the previous call
+  #  this is a reasult of a wrong split, which ends on the end of call and not on the ;
+  #  semicolon is treated by R parser as a separate call.
+  gsub("^([[:space:]])*;(.+)$", "\\1\\2", new_code, perl = TRUE)
 }
diff --git a/tests/testthat/test-qenv_get_code.R b/tests/testthat/test-qenv_get_code.R
index 7b996ae0..e1815e3c 100644
--- a/tests/testthat/test-qenv_get_code.R
+++ b/tests/testthat/test-qenv_get_code.R
@@ -45,6 +45,19 @@ testthat::test_that("get_code called with qenv.error returns error with trace in
   )
 })
 
+testthat::test_that("get_code returns code with comments and empty spaces", {
+  code <- "
+    # header comment after white space
+
+    a <- 1L; b <- 2 #inline comment
+
+
+    c <- 3
+    # closing comment
+    "
+  q <- eval_code(qenv(), code)
+  testthat::expect_equal(paste(get_code(q), collapse = ""), code)
+})
 
 # names parameter -------------------------------------------------------------------------------------------------
 
@@ -92,7 +105,6 @@ testthat::test_that("handles the code of length > 1 when at least one is enclose
   )
 })
 
-
 testthat::test_that("extracts the code of a binding from character vector containing simple code", {
   code <- c(
     "a <- 1",
@@ -164,7 +176,6 @@ testthat::test_that("does not fall into a loop", {
   )
 })
 
-
 testthat::test_that("extracts code of a parent binding but only those evaluated before coocurence", {
   code <- c(
     "a <- 1",

From 29adf3a91bff36ea66b022ce1c07ca402e5cbcf8 Mon Sep 17 00:00:00 2001
From: m7pr <marcin.kosinski.mk1@roche.com>
Date: Thu, 31 Oct 2024 14:29:49 +0100
Subject: [PATCH 39/98] use get_code_dependency in qenv

---
 R/qenv-extract.R                    |   4 +-
 R/qenv-get_code.R                   |   3 +-
 tests/testthat/test-qenv_get_code.R | 138 ++++++++++++++--------------
 tests/testthat/test-qenv_within.R   |  10 +-
 4 files changed, 76 insertions(+), 79 deletions(-)

diff --git a/R/qenv-extract.R b/R/qenv-extract.R
index 8eb83d6a..a3b8c2d4 100644
--- a/R/qenv-extract.R
+++ b/R/qenv-extract.R
@@ -35,9 +35,9 @@
     )
   }
 
-  limited_code <- get_code(x, names = names)
   x@env <- list2env(mget(x = names, envir = get_env(x)))
-  x@code <- limited_code
+  names <- gsub("^`(.*)`$", "\\1", names)
+  x@code <- get_code_dependency(x@code, names = names)
 
   x
 }
diff --git a/R/qenv-get_code.R b/R/qenv-get_code.R
index 857469ee..a96579d6 100644
--- a/R/qenv-get_code.R
+++ b/R/qenv-get_code.R
@@ -118,14 +118,13 @@ setMethod("get_code", signature = "qenv", function(object, deparse = TRUE, names
   }
 
   code <- if (!is.null(names)) {
-    # todo:
     get_code_dependency(object@code, names, ...)
   } else {
     object@code
   }
 
   if (deparse) {
-    code
+    unlist(code)
   } else {
     parse(text = paste(c("{", unlist(code), "}"), collapse = "\n"), keep.source = TRUE)
   }
diff --git a/tests/testthat/test-qenv_get_code.R b/tests/testthat/test-qenv_get_code.R
index 7b996ae0..67bc57b9 100644
--- a/tests/testthat/test-qenv_get_code.R
+++ b/tests/testthat/test-qenv_get_code.R
@@ -2,7 +2,7 @@ testthat::test_that("get_code returns code (character by default) of qenv object
   q <- qenv() |>
     eval_code(quote(x <- 1)) |>
     eval_code(quote(y <- x))
-  testthat::expect_equal(unlist(get_code(q)), c("x <- 1", "y <- x"))
+  testthat::expect_equal(get_code(q), c("x <- 1", "y <- x"))
 })
 
 testthat::test_that("get_code handles code elements being code-blocks", {
@@ -15,7 +15,7 @@ testthat::test_that("get_code handles code elements being code-blocks", {
       z <- 5
     })
   )
-  testthat::expect_equal(unlist(get_code(q)), c("x <- 1", "y <- x", "z <- 5"))
+  testthat::expect_equal(get_code(q), c("x <- 1", "y <- x", "z <- 5"))
 })
 
 testthat::test_that("get_code returns expression of qenv object if deparse = FALSE", {
@@ -23,7 +23,7 @@ testthat::test_that("get_code returns expression of qenv object if deparse = FAL
   q <- eval_code(q, quote(x <- 1))
   q <- eval_code(q, quote(y <- x))
   testthat::expect_equivalent(
-    toString(unlist(get_code(q, deparse = FALSE))),
+    toString(get_code(q, deparse = FALSE)),
     toString(parse(text = paste(c("{", unlist(q@code), "}"), collapse = "\n"), keep.source = TRUE))
   )
 })
@@ -49,13 +49,11 @@ testthat::test_that("get_code called with qenv.error returns error with trace in
 # names parameter -------------------------------------------------------------------------------------------------
 
 testthat::test_that("handles empty @code slot", {
-  testthat::expect_identical(
-    get_code(qenv(), names = "a"),
-    list()
+  testthat::expect_null(
+    get_code(qenv(), names = "a")
   )
-  testthat::expect_identical(
-    get_code(eval_code(qenv(), code = ""), names = "a"),
-    list()
+  testthat::expect_null(
+    get_code(eval_code(qenv(), code = ""), names = "a")
   )
 })
 
@@ -67,7 +65,7 @@ testthat::test_that("handles the code without symbols on rhs", {
   )
 
   testthat::expect_identical(
-    unlist(get_code(eval_code(qenv(), code), names = "a")),
+    get_code(eval_code(qenv(), code), names = "a"),
     "a <- 5"
   )
 })
@@ -87,7 +85,7 @@ testthat::test_that("handles the code of length > 1 when at least one is enclose
   q <- eval_code(eval_code(qenv(), code[1]), code[2])
 
   testthat::expect_identical(
-    unlist(get_code(q, names = "a")),
+    get_code(q, names = "a"),
     "{a<-5}"
   )
 })
@@ -100,11 +98,11 @@ testthat::test_that("extracts the code of a binding from character vector contai
   )
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
-    unlist(get_code(q, names = "a")),
+    get_code(q, names = "a"),
     "a <- 1"
   )
   testthat::expect_identical(
-    unlist(get_code(q, names = "b")),
+    get_code(q, names = "b"),
     "b <- 2"
   )
 })
@@ -116,7 +114,7 @@ testthat::test_that("extracts the code without downstream usage", {
   )
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
-    unlist(get_code(q, names = "a")),
+    get_code(q, names = "a"),
     "a <- 1"
   )
 })
@@ -128,7 +126,7 @@ testthat::test_that("works for names of length > 1", {
   )
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
-    unlist(get_code(q, names = c("a", "b"))),
+    get_code(q, names = c("a", "b")),
     code
   )
 })
@@ -137,7 +135,7 @@ testthat::test_that("warns if binding doesn't exist in code", {
   code <- c("a <- 1")
   q <- eval_code(qenv(), code)
   testthat::expect_warning(
-    unlist(get_code(q, names = "c")),
+    get_code(q, names = "c"),
     "Object\\(s\\) not found in code: c"
   )
 })
@@ -151,15 +149,15 @@ testthat::test_that("does not fall into a loop", {
   )
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
-    unlist(get_code(q, names = "a")),
+    get_code(q, names = "a"),
     code
   )
   testthat::expect_identical(
-    unlist(get_code(q, names = "b")),
+    get_code(q, names = "b"),
     code[1:2]
   )
   testthat::expect_identical(
-    unlist(get_code(q, names = "c")),
+    get_code(q, names = "c"),
     code[1:3]
   )
 })
@@ -173,7 +171,7 @@ testthat::test_that("extracts code of a parent binding but only those evaluated
   )
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
-    unlist(get_code(q, names = "b")),
+    get_code(q, names = "b"),
     c("a <- 1", "b <- a")
   )
 })
@@ -186,7 +184,7 @@ testthat::test_that("extracts the code of a parent binding if used as an arg in
   )
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
-    unlist(get_code(q, names = "b")),
+    get_code(q, names = "b"),
     c("a <- 1", "b <- identity(x = a)")
   )
 })
@@ -199,7 +197,7 @@ testthat::test_that("extracts the code when using <<-", {
   )
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
-    unlist(get_code(q, names = "b")),
+    get_code(q, names = "b"),
     c("a <- 1", "b <- a", "b <<- b + 2")
   )
 })
@@ -212,7 +210,7 @@ testthat::test_that("detects every assign calls even if not evaluated, if there
   )
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
-    unlist(get_code(q, names = "b")),
+    get_code(q, names = "b"),
     code[2:3]
   )
 })
@@ -234,7 +232,7 @@ testthat::test_that("does not break if code is separated by ;", {
   )
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
-    unlist(get_code(q, names = "a")),
+    get_code(q, names = "a"),
     c("a <- 1", "a <- a + 1")
   )
 })
@@ -247,7 +245,7 @@ testthat::test_that("does not break if code uses quote()", {
   )
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
-    unlist(get_code(q, names = "x")),
+    get_code(q, names = "x"),
     code[2]
   )
 })
@@ -260,7 +258,7 @@ testthat::test_that("does not break if object is used in a function on lhs", {
   )
   q <- eval_code(qenv(), code = code)
   testthat::expect_identical(
-    unlist(get_code(q, names = "iris")),
+    get_code(q, names = "iris"),
     code[c(1, 3)]
   )
 })
@@ -275,7 +273,7 @@ testthat::test_that(
     )
     q <- eval_code(qenv(), code = code)
     testthat::expect_identical(
-      unlist(get_code(q, names = "x")),
+      get_code(q, names = "x"),
       code
     )
   }
@@ -295,15 +293,15 @@ testthat::test_that("extracts the code for assign() where \"x\" is a literal str
   )
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
-    unlist(get_code(q, names = "b")),
+    get_code(q, names = "b"),
     code[c(2, 5)]
   )
   testthat::expect_identical(
-    unlist(get_code(q, names = "c")),
+    get_code(q, names = "c"),
     code[c(2, 3, 5, 6)]
   )
   testthat::expect_identical(
-    unlist(get_code(q, names = "d")),
+    get_code(q, names = "d"),
     c("assign(value = 15, x = \"d\")", "d <- d * 2")
   )
 })
@@ -317,7 +315,7 @@ testthat::test_that("extracts the code for assign() where \"x\" is variable", {
   )
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
-    unlist(get_code(q, names = "b")),
+    get_code(q, names = "b"),
     code
   )
 })
@@ -334,7 +332,7 @@ testthat::test_that("works for assign() detection no matter how many parametrers
   q <- eval_code(qenv(), code)
 
   testthat::expect_identical(
-    unlist(get_code(q, names = "y")),
+    get_code(q, names = "y"),
     code
   )
 })
@@ -350,11 +348,11 @@ testthat::test_that("detects function usage of the assignment operator", {
   q2 <- eval_code(qenv(), code2)
 
   testthat::expect_identical(
-    unlist(get_code(q, names = "y")),
+    get_code(q, names = "y"),
     code
   )
   testthat::expect_identical(
-    unlist(get_code(q2, names = "y")),
+    get_code(q2, names = "y"),
     code2
   )
 })
@@ -373,7 +371,7 @@ testthat::test_that("get_code does not break if @linksto is put in the last line
   )
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
-    unlist(get_code(q, names = "x")),
+    get_code(q, names = "x"),
     code
   )
 })
@@ -385,7 +383,7 @@ testthat::test_that("@linksto makes a line being returned for an affected bindin
   "
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
-    unlist(get_code(q, names = "b")),
+    get_code(q, names = "b"),
     c("  a <- 1 # @linksto b", "  b <- 2")
   )
 })
@@ -400,7 +398,7 @@ testthat::test_that(
     )
     q <- eval_code(qenv(), code)
     testthat::expect_identical(
-      unlist(get_code(q, names = "b")),
+      get_code(q, names = "b"),
       code
     )
   }
@@ -417,11 +415,11 @@ testthat::test_that(
     )
     q <- eval_code(qenv(), code)
     testthat::expect_identical(
-      unlist(get_code(q, names = "a")),
+      get_code(q, names = "a"),
       code[1:3]
     )
     testthat::expect_identical(
-      unlist(get_code(q, names = "b")),
+      get_code(q, names = "b"),
       code[c(2, 4)]
     )
   }
@@ -438,7 +436,7 @@ testthat::test_that(
     )
     q <- eval_code(qenv(), code)
     testthat::expect_identical(
-      unlist(get_code(q, names = "classes")),
+      get_code(q, names = "classes"),
       code
     )
   }
@@ -462,7 +460,7 @@ testthat::test_that("comments fall into proper calls", {
 
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
-    unlist(get_code(q)),
+    get_code(q),
     c(
       "    # initial comment\n    a <- 1",
       "    b <- 2 # inline comment",
@@ -488,7 +486,7 @@ testthat::test_that("comments get pasted when they fall into calls", {
 
   q <- qenv() |> eval_code(code)
   testthat::expect_identical(
-    unlist(get_code(q)),
+    get_code(q),
     c(
       "    # initial comment\n    a <- 1 # A comment",
       "    b <- 2 # inline comment",
@@ -507,11 +505,11 @@ testthat::test_that("ignores occurrence in a function definition", {
   )
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
-    unlist(get_code(q, names = "b")),
+    get_code(q, names = "b"),
     "b <- 2"
   )
   testthat::expect_identical(
-    unlist(get_code(q, names = "foo")),
+    get_code(q, names = "foo"),
     code[2]
   )
 })
@@ -523,11 +521,11 @@ testthat::test_that("ignores occurrence in a function definition that has functi
   )
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
-    unlist(get_code(q, names = "b")),
+    get_code(q, names = "b"),
     code[1]
   )
   testthat::expect_identical(
-    unlist(get_code(q, names = "foo")),
+    get_code(q, names = "foo"),
     code[2]
   )
 })
@@ -541,11 +539,11 @@ testthat::test_that("ignores occurrence in a function definition if there is mul
   )
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
-    unlist(get_code(q, names = "b")),
+    get_code(q, names = "b"),
     code[c(1, 3)]
   )
   testthat::expect_identical(
-    unlist(get_code(q, names = "foo")),
+    get_code(q, names = "foo"),
     code[2]
   )
 })
@@ -560,7 +558,7 @@ testthat::test_that("ignores occurrence in a function definition in lapply", {
   )
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
-    unlist(get_code(q, names = "x")),
+    get_code(q, names = "x"),
     "x <- 1"
   )
 })
@@ -575,7 +573,7 @@ testthat::test_that("does not ignore occurrence in function body if object exsit
   )
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
-    unlist(get_code(q, names = "b")),
+    get_code(q, names = "b"),
     code
   )
 })
@@ -587,11 +585,11 @@ testthat::test_that("ignores occurrence in function definition without { curly b
   )
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
-    unlist(get_code(q, names = "foo")),
+    get_code(q, names = "foo"),
     "foo <- function(b) b <- b + 2"
   )
   testthat::expect_identical(
-    unlist(get_code(q, names = "b")),
+    get_code(q, names = "b"),
     "b <- 2"
   )
 })
@@ -605,7 +603,7 @@ testthat::test_that("detects occurrence of the function object", {
   )
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
-    unlist(get_code(q, names = "b")),
+    get_code(q, names = "b"),
     code
   )
 })
@@ -618,7 +616,7 @@ testthat::test_that("detects occurrence of a function definition when a formal i
   )
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
-    unlist(get_code(q, names = "a")),
+    get_code(q, names = "a"),
     code
   )
 })
@@ -635,7 +633,7 @@ testthat::test_that("detects occurrence of a function definition with a @linksto
   )
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
-    unlist(get_code(q, names = "x")),
+    get_code(q, names = "x"),
     c(
       "        foo <- function() {\n          env <- parent.frame()\n          env$x <- 0\n        }",
       "foo() # @linksto x"
@@ -654,11 +652,11 @@ testthat::test_that("understands $ usage and do not treat rhs of $ as objects (o
   )
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
-    unlist(get_code(q, names = "x")),
+    get_code(q, names = "x"),
     "x <- data.frame(a = 1:3)"
   )
   testthat::expect_identical(
-    unlist(get_code(q, names = "a")),
+    get_code(q, names = "a"),
     code
   )
 })
@@ -671,7 +669,7 @@ testthat::test_that("detects cooccurrence properly even if all objects are on lh
   )
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
-    unlist(get_code(q, names = "b")),
+    get_code(q, names = "b"),
     code
   )
 })
@@ -692,11 +690,11 @@ testthat::test_that("understands @ usage and do not treat rhs of @ as objects (o
   q@code <- code # we don't use eval_code so the code is not run
   testthat::expect_identical(
     get_code(q, names = "x"),
-    code[1:2]
+    unlist(code[1:2])
   )
   testthat::expect_identical(
     get_code(q, names = "a"),
-    code
+    unlist(code)
   )
 })
 
@@ -714,7 +712,7 @@ testthat::test_that("library() and require() are always returned", {
   )
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
-    unlist(get_code(q, names = "x")),
+    get_code(q, names = "x"),
     code[c(2, 3, 4)]
   )
 })
@@ -732,7 +730,7 @@ testthat::test_that("data() call is returned when data name is provided as is",
   )
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
-    unlist(get_code(q, names = "x")),
+    get_code(q, names = "x"),
     code[-1]
   )
 })
@@ -747,7 +745,7 @@ testthat::test_that("data() call is returned when data name is provided as a cha
   )
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
-    unlist(get_code(q, names = "z")),
+    get_code(q, names = "z"),
     code[-1]
   )
 })
@@ -764,7 +762,7 @@ testthat::describe("Backticked symbol", {
     )
 
     testthat::expect_identical(
-      unlist(get_code(td, names = "%cbind%")),
+      get_code(td, names = "%cbind%"),
       "`%cbind%` <- function(lhs, rhs) cbind(lhs, rhs)"
     )
   })
@@ -779,7 +777,7 @@ testthat::describe("Backticked symbol", {
     )
 
     testthat::expect_identical(
-      unlist(get_code(td, names = "`%cbind%`")),
+      get_code(td, names = "`%cbind%`"),
       "`%cbind%` <- function(lhs, rhs) cbind(lhs, rhs)"
     )
   })
@@ -794,7 +792,7 @@ testthat::describe("Backticked symbol", {
     )
 
     testthat::expect_identical(
-      unlist(get_code(td, names = "iris_ds")),
+      get_code(td, names = "iris_ds"),
       c(
         "`_add_column_` <- function(lhs, rhs) cbind(lhs, rhs)",
         "iris_ds <- `_add_column_`(iris, data.frame(new_col = \"new column\"))"
@@ -812,7 +810,7 @@ testthat::describe("Backticked symbol", {
     )
 
     testthat::expect_identical(
-      unlist(get_code(td, names = "iris_ds")),
+      get_code(td, names = "iris_ds"),
       c(
         "`add column` <- function(lhs, rhs) cbind(lhs, rhs)",
         "iris_ds <- `add column`(iris, data.frame(new_col = \"new column\"))"
@@ -830,7 +828,7 @@ testthat::describe("Backticked symbol", {
     )
 
     testthat::expect_identical(
-      unlist(get_code(td, names = "iris_ds")),
+      get_code(td, names = "iris_ds"),
       c(
         "add_column <- function(lhs, rhs) cbind(lhs, rhs)",
         "iris_ds <- add_column(iris, data.frame(new_col = \"new column\"))"
@@ -850,7 +848,7 @@ testthat::describe("Backticked symbol", {
     # Note that the original code is changed to use the non-native pipe operator
     # correctly.
     testthat::expect_identical(
-      unlist(get_code(td, names = "iris_ds")),
+      get_code(td, names = "iris_ds"),
       c(
         "`%add_column%` <- function(lhs, rhs) cbind(lhs, rhs)",
         "iris_ds <- iris %add_column% data.frame(new_col = \"new column\")"
@@ -870,7 +868,7 @@ testthat::describe("Backticked symbol", {
     # Note that the original code is changed to use the non-native pipe operator
     # correctly.
     testthat::expect_identical(
-      unlist(get_code(td, names = "iris_ds")),
+      get_code(td, names = "iris_ds"),
       c(
         "`%add_column%` <- function(lhs, rhs) cbind(lhs, rhs)",
         "iris_ds <- iris %add_column% data.frame(new_col = \"new column\")"
diff --git a/tests/testthat/test-qenv_within.R b/tests/testthat/test-qenv_within.R
index 4d0f32c4..a05d0a03 100644
--- a/tests/testthat/test-qenv_within.R
+++ b/tests/testthat/test-qenv_within.R
@@ -26,7 +26,7 @@ testthat::test_that("styling of input code does not impact evaluation results",
     1 +
       1
   })
-  all_code <- unlist(get_code(q))
+  all_code <- get_code(q)
   testthat::expect_identical(
     all_code,
     rep("1 + 1", 4L)
@@ -45,7 +45,7 @@ testthat::test_that("styling of input code does not impact evaluation results",
     1 + 1;
     2 + 2
   })
-  all_code <- unlist(get_code(q))
+  all_code <- get_code(q)
   testthat::expect_identical(
     all_code,
     rep(c("1 + 1", "2 + 2"), 4L)
@@ -85,7 +85,7 @@ testthat::test_that("external values can be injected into expressions through `.
   },
   species = external_value)
 
-  testthat::expect_identical(unlist(get_code(q)), "i <- subset(iris, Species == \"virginica\")")
+  testthat::expect_identical(get_code(q), "i <- subset(iris, Species == \"virginica\")")
 })
 
 testthat::test_that("external values are not taken from calling frame", {
@@ -95,14 +95,14 @@ testthat::test_that("external values are not taken from calling frame", {
     i <- subset(iris, Species == species)
   })
   testthat::expect_s3_class(qq, "qenv.error")
-  testthat::expect_error(unlist(get_code(qq)), "object 'species' not found")
+  testthat::expect_error(get_code(qq), "object 'species' not found")
 
   qq <- within(q, {
     i <- subset(iris, Species == species)
   },
   species = species)
   testthat::expect_s4_class(qq, "qenv")
-  testthat::expect_identical(unlist(get_code(qq)), "i <- subset(iris, Species == \"setosa\")")
+  testthat::expect_identical(get_code(qq), "i <- subset(iris, Species == \"setosa\")")
 })
 
 # nolint end

From 6d674aca977050cad88cf60269c8c783e1db0275 Mon Sep 17 00:00:00 2001
From: m7pr <marcin.kosinski.mk1@roche.com>
Date: Thu, 31 Oct 2024 14:47:18 +0100
Subject: [PATCH 40/98] remove print

---
 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 570d0d06..ff6dd27d 100644
--- a/R/qenv-eval_code.R
+++ b/R/qenv-eval_code.R
@@ -35,7 +35,7 @@ setMethod("eval_code", signature = c("qenv", "character"), function(object, code
 
   object@env <- rlang::env_clone(object@env, parent = parent.env(.GlobalEnv))
   code_split <- split_code(paste(code, collapse = "\n"))
-  print(code_split)
+
   for (i in seq_along(code_split)) {
     current_code <- code_split[[i]]
     current_call <- parse(text = current_code, keep.source = FALSE)

From e1254e7f71b22b42536cf5292770b5cf5d094e6b Mon Sep 17 00:00:00 2001
From: m7pr <marcin.kosinski.mk1@roche.com>
Date: Thu, 31 Oct 2024 14:47:37 +0100
Subject: [PATCH 41/98] for cases with just one call, do not DROP matrix calss
 in call_breaks

---
 R/utils-get_code_dependency.R | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/R/utils-get_code_dependency.R b/R/utils-get_code_dependency.R
index 193db7c8..200a0f77 100644
--- a/R/utils-get_code_dependency.R
+++ b/R/utils-get_code_dependency.R
@@ -488,7 +488,7 @@ get_call_breaks <- function(code) {
 #' @noRd
 split_code <- function(code) {
   call_breaks <- get_call_breaks(code)
-  call_breaks <- call_breaks[order(call_breaks[, "line"], call_breaks[, "col"]), ]
+  call_breaks <- call_breaks[order(call_breaks[, "line"], call_breaks[, "col"]), , drop = FALSE]
   code_split <- strsplit(code, split = "\n", fixed = TRUE)[[1]]
   char_count_lines <- c(0, cumsum(sapply(code_split, nchar, USE.NAMES = FALSE) + 1), -1)[seq_along(code_split)]
 

From 13b7f32b36438ae4ecb01f7ae52a9859c76918f9 Mon Sep 17 00:00:00 2001
From: m7pr <marcin.kosinski.mk1@roche.com>
Date: Thu, 31 Oct 2024 14:50:56 +0100
Subject: [PATCH 42/98] handle code with single call in split_code

---
 R/utils-get_code_dependency.R | 5 ++++-
 1 file changed, 4 insertions(+), 1 deletion(-)

diff --git a/R/utils-get_code_dependency.R b/R/utils-get_code_dependency.R
index 200a0f77..05c8c8c3 100644
--- a/R/utils-get_code_dependency.R
+++ b/R/utils-get_code_dependency.R
@@ -488,7 +488,10 @@ get_call_breaks <- function(code) {
 #' @noRd
 split_code <- function(code) {
   call_breaks <- get_call_breaks(code)
-  call_breaks <- call_breaks[order(call_breaks[, "line"], call_breaks[, "col"]), , drop = FALSE]
+  if (nrow(call_breaks) == 1) {
+    return(code)
+  }
+  call_breaks <- call_breaks[order(call_breaks[, "line"], call_breaks[, "col"]), ]
   code_split <- strsplit(code, split = "\n", fixed = TRUE)[[1]]
   char_count_lines <- c(0, cumsum(sapply(code_split, nchar, USE.NAMES = FALSE) + 1), -1)[seq_along(code_split)]
 

From 7d3138b0950473ed27823ef75f74ae1cff19e52b Mon Sep 17 00:00:00 2001
From: go_gonzo <dawid.kaledkowski@gmail.com>
Date: Thu, 31 Oct 2024 15:23:53 +0100
Subject: [PATCH 43/98] fix

---
 R/utils-get_code_dependency.R | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/R/utils-get_code_dependency.R b/R/utils-get_code_dependency.R
index 05c8c8c3..8ad771e9 100644
--- a/R/utils-get_code_dependency.R
+++ b/R/utils-get_code_dependency.R
@@ -473,7 +473,7 @@ get_call_breaks <- function(code) {
       matrix(c(max(x$line2), max(x$col2)))
     }
   ))
-  if (nrow(call_breaks) > 1) call_breaks <- call_breaks[-nrow(call_breaks), ] # breaks in between needed only
+  call_breaks <- call_breaks[-nrow(call_breaks), ] # breaks in between needed only
   colnames(call_breaks) <- c("line", "col")
   call_breaks
 }
@@ -488,7 +488,7 @@ get_call_breaks <- function(code) {
 #' @noRd
 split_code <- function(code) {
   call_breaks <- get_call_breaks(code)
-  if (nrow(call_breaks) == 1) {
+  if (nrow(call_breaks) == 0) {
     return(code)
   }
   call_breaks <- call_breaks[order(call_breaks[, "line"], call_breaks[, "col"]), ]

From 39363c61ddf6e004cfbbfebd4687512745083c33 Mon Sep 17 00:00:00 2001
From: m7pr <marcin.kosinski.mk1@roche.com>
Date: Thu, 31 Oct 2024 15:31:43 +0100
Subject: [PATCH 44/98] add drop FALSE to split_code

---
 R/utils-get_code_dependency.R | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/R/utils-get_code_dependency.R b/R/utils-get_code_dependency.R
index 8ad771e9..67649deb 100644
--- a/R/utils-get_code_dependency.R
+++ b/R/utils-get_code_dependency.R
@@ -473,7 +473,7 @@ get_call_breaks <- function(code) {
       matrix(c(max(x$line2), max(x$col2)))
     }
   ))
-  call_breaks <- call_breaks[-nrow(call_breaks), ] # breaks in between needed only
+  call_breaks <- call_breaks[-nrow(call_breaks), , drop = FALSE] # breaks in between needed only
   colnames(call_breaks) <- c("line", "col")
   call_breaks
 }
@@ -491,7 +491,7 @@ split_code <- function(code) {
   if (nrow(call_breaks) == 0) {
     return(code)
   }
-  call_breaks <- call_breaks[order(call_breaks[, "line"], call_breaks[, "col"]), ]
+  call_breaks <- call_breaks[order(call_breaks[, "line"], call_breaks[, "col"]), , drop = FALSE]
   code_split <- strsplit(code, split = "\n", fixed = TRUE)[[1]]
   char_count_lines <- c(0, cumsum(sapply(code_split, nchar, USE.NAMES = FALSE) + 1), -1)[seq_along(code_split)]
 

From 043414a28143c24ff0476c1a01b9ba17f8493dd4 Mon Sep 17 00:00:00 2001
From: m7pr <marcin.kosinski.mk1@roche.com>
Date: Thu, 31 Oct 2024 15:32:05 +0100
Subject: [PATCH 45/98] fix warning messages for skipped objects

---
 R/qenv-extract.R                   | 11 +++++++++--
 tests/testthat/test-qenv_extract.R |  4 ++--
 2 files changed, 11 insertions(+), 4 deletions(-)

diff --git a/R/qenv-extract.R b/R/qenv-extract.R
index a3b8c2d4..aa740325 100644
--- a/R/qenv-extract.R
+++ b/R/qenv-extract.R
@@ -22,14 +22,21 @@
   names_warn <- setdiff(names, possible_names)
   names <- intersect(names, possible_names)
   if (!length(names)) {
-    warning("None of `names` elements exist in `qenv`. Returning empty `qenv`.")
+    warning(
+      sprintf(
+        "None of 'names' elements exist in '%s'. Returning empty '%s'.",
+        class(x)[1],
+        class(x)[1]
+      )
+    )
     return(qenv())
   }
 
   if (length(names_warn)) {
     warning(
       sprintf(
-        "Some elements of `names` do not exist in `qenv`. Skipping those: %s.",
+        "Some elements of 'names' do not exist in '%s'. Skipping those: %s.",
+        class(x)[1],
         paste(names_warn, collapse = ", ")
       )
     )
diff --git a/tests/testthat/test-qenv_extract.R b/tests/testthat/test-qenv_extract.R
index 869d610e..d56ce1ff 100644
--- a/tests/testthat/test-qenv_extract.R
+++ b/tests/testthat/test-qenv_extract.R
@@ -6,7 +6,7 @@ testthat::test_that("`[.` returns empty qenv for names not in qenv", {
   })
   testthat::expect_warning(
     testthat::expect_equal(data["y"], qenv()),
-    "None of `names` elements exist in `qenv`. Returning empty `qenv`."
+    "None of 'names' elements exist in 'qenv'. Returning empty 'qenv'."
   )
 })
 
@@ -17,7 +17,7 @@ testthat::test_that("`[.` returns limited qenv for some names not in qenv", {
   })
   testthat::expect_warning(
     testthat::expect_equal(data[c("y", "a")], data["a"]),
-    "Some elements of `names` do not exist in `qenv`. Skipping those: y."
+    "Some elements of 'names' do not exist in 'qenv'. Skipping those: y."
   )
 })
 

From 9304459c44d755df6eaf4969bf077644c45d26ff Mon Sep 17 00:00:00 2001
From: m7pr <marcin.kosinski.mk1@roche.com>
Date: Thu, 31 Oct 2024 16:06:51 +0100
Subject: [PATCH 46/98] fix some tests

---
 tests/testthat/test-qenv_eval_code.R |   2 +-
 tests/testthat/test-qenv_extract.R   |   4 +-
 tests/testthat/test-qenv_get_code.R  | 167 ++++++++++++++-------------
 3 files changed, 87 insertions(+), 86 deletions(-)

diff --git a/tests/testthat/test-qenv_eval_code.R b/tests/testthat/test-qenv_eval_code.R
index 4b188ff2..0f296d7e 100644
--- a/tests/testthat/test-qenv_eval_code.R
+++ b/tests/testthat/test-qenv_eval_code.R
@@ -70,7 +70,7 @@ testthat::test_that("eval_code works with quoted code block", {
 
   testthat::expect_equal(
     unlist(q1@code),
-    c("a <- 1", "b <- 2")
+    c("a <- 1\n", "b <- 2")
   )
   testthat::expect_equal(q1@env, list2env(list(a = 1, b = 2)))
 })
diff --git a/tests/testthat/test-qenv_extract.R b/tests/testthat/test-qenv_extract.R
index d56ce1ff..feb44482 100644
--- a/tests/testthat/test-qenv_extract.R
+++ b/tests/testthat/test-qenv_extract.R
@@ -38,7 +38,7 @@ testthat::test_that("`[.` extract proper code", {
   qs <- q[object_names]
   testthat::expect_identical(
     unlist(qs@code),
-    c("x<-1", "a<-1")
+    c("x<-1\n", "a<-1;")
   )
 })
 
@@ -49,7 +49,7 @@ testthat::test_that("`[.` preservers comments in the code", {
   qs <- q[c("x", "a")]
   testthat::expect_identical(
     unlist(qs@code),
-    c("x<-1 #comment", "a<-1")
+    c("x<-1 #comment\n", "a<-1;")
   )
 })
 
diff --git a/tests/testthat/test-qenv_get_code.R b/tests/testthat/test-qenv_get_code.R
index bd7c9671..d15ef166 100644
--- a/tests/testthat/test-qenv_get_code.R
+++ b/tests/testthat/test-qenv_get_code.R
@@ -1,8 +1,12 @@
+get_code_g <- function(qenv, ...){
+  gsub("\n", "", get_code(qenv, ...), fixed = TRUE)
+}
+
 testthat::test_that("get_code returns code (character by default) of qenv object", {
   q <- qenv() |>
     eval_code(quote(x <- 1)) |>
     eval_code(quote(y <- x))
-  testthat::expect_equal(get_code(q), c("x <- 1", "y <- x"))
+  testthat::expect_equal(get_code_g(q), c("x <- 1", "y <- x"))
 })
 
 testthat::test_that("get_code handles code elements being code-blocks", {
@@ -15,7 +19,7 @@ testthat::test_that("get_code handles code elements being code-blocks", {
       z <- 5
     })
   )
-  testthat::expect_equal(get_code(q), c("x <- 1", "y <- x", "z <- 5"))
+  testthat::expect_equal(get_code_g(q), c("x <- 1", "y <- x", "z <- 5"))
 })
 
 testthat::test_that("get_code returns expression of qenv object if deparse = FALSE", {
@@ -23,8 +27,8 @@ testthat::test_that("get_code returns expression of qenv object if deparse = FAL
   q <- eval_code(q, quote(x <- 1))
   q <- eval_code(q, quote(y <- x))
   testthat::expect_equivalent(
-    toString(get_code(q, deparse = FALSE)),
-    toString(parse(text = paste(c("{", unlist(q@code), "}"), collapse = "\n"), keep.source = TRUE))
+    toString(get_code_g(q, deparse = FALSE)),
+    "{    x <- 1    y <- x}"
   )
 })
 
@@ -35,7 +39,7 @@ testthat::test_that("get_code called with qenv.error returns error with trace in
   q3 <- eval_code(q2, quote(w <- v))
 
   code <- tryCatch(
-    get_code(q3),
+    get_code_g(q3),
     error = function(e) e
   )
   testthat::expect_equal(class(code), c("validation", "try-error", "simpleError", "error", "condition"))
@@ -56,7 +60,7 @@ testthat::test_that("get_code returns code with comments and empty spaces", {
     # closing comment
     "
   q <- eval_code(qenv(), code)
-  testthat::expect_equal(paste(get_code(q), collapse = ""), code)
+  testthat::expect_equal(paste0(get_code(q), collapse = ""), code)
 })
 
 # names parameter -------------------------------------------------------------------------------------------------
@@ -79,7 +83,7 @@ testthat::test_that("handles the code without symbols on rhs", {
 
   testthat::expect_identical(
     get_code(eval_code(qenv(), code), names = "a"),
-    "a <- 5"
+    "a <- 5\n"
   )
 })
 
@@ -98,7 +102,7 @@ testthat::test_that("handles the code of length > 1 when at least one is enclose
   q <- eval_code(eval_code(qenv(), code[1]), code[2])
 
   testthat::expect_identical(
-    get_code(q, names = "a"),
+    get_code_g(q, names = "a"),
     "{a<-5}"
   )
 })
@@ -110,11 +114,11 @@ testthat::test_that("extracts the code of a binding from character vector contai
   )
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
-    get_code(q, names = "a"),
+    get_code_g(q, names = "a"),
     "a <- 1"
   )
   testthat::expect_identical(
-    get_code(q, names = "b"),
+    get_code_g(q, names = "b"),
     "b <- 2"
   )
 })
@@ -126,7 +130,7 @@ testthat::test_that("extracts the code without downstream usage", {
   )
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
-    get_code(q, names = "a"),
+    get_code_g(q, names = "a"),
     "a <- 1"
   )
 })
@@ -138,7 +142,7 @@ testthat::test_that("works for names of length > 1", {
   )
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
-    get_code(q, names = c("a", "b")),
+    get_code_g(q, names = c("a", "b")),
     code
   )
 })
@@ -147,7 +151,7 @@ testthat::test_that("warns if binding doesn't exist in code", {
   code <- c("a <- 1")
   q <- eval_code(qenv(), code)
   testthat::expect_warning(
-    get_code(q, names = "c"),
+    get_code_g(q, names = "c"),
     "Object\\(s\\) not found in code: c"
   )
 })
@@ -161,15 +165,15 @@ testthat::test_that("does not fall into a loop", {
   )
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
-    get_code(q, names = "a"),
+    get_code_g(q, names = "a"),
     code
   )
   testthat::expect_identical(
-    get_code(q, names = "b"),
+    get_code_g(q, names = "b"),
     code[1:2]
   )
   testthat::expect_identical(
-    get_code(q, names = "c"),
+    get_code_g(q, names = "c"),
     code[1:3]
   )
 })
@@ -182,7 +186,7 @@ testthat::test_that("extracts code of a parent binding but only those evaluated
   )
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
-    get_code(q, names = "b"),
+    get_code_g(q, names = "b"),
     c("a <- 1", "b <- a")
   )
 })
@@ -195,7 +199,7 @@ testthat::test_that("extracts the code of a parent binding if used as an arg in
   )
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
-    get_code(q, names = "b"),
+    get_code_g(q, names = "b"),
     c("a <- 1", "b <- identity(x = a)")
   )
 })
@@ -208,7 +212,7 @@ testthat::test_that("extracts the code when using <<-", {
   )
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
-    get_code(q, names = "b"),
+    get_code_g(q, names = "b"),
     c("a <- 1", "b <- a", "b <<- b + 2")
   )
 })
@@ -221,7 +225,7 @@ testthat::test_that("detects every assign calls even if not evaluated, if there
   )
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
-    get_code(q, names = "b"),
+    get_code_g(q, names = "b"),
     code[2:3]
   )
 })
@@ -234,7 +238,7 @@ testthat::test_that("returns result of length 1 for non-empty input and deparse
     c <- list(x = 2)
   })
 
-  testthat::expect_length(get_code(q1, deparse = FALSE), 1)
+  testthat::expect_length(get_code_g(q1, deparse = FALSE), 1)
 })
 
 testthat::test_that("does not break if code is separated by ;", {
@@ -243,8 +247,8 @@ testthat::test_that("does not break if code is separated by ;", {
   )
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
-    get_code(q, names = "a"),
-    c("a <- 1", "a <- a + 1")
+    get_code_g(q, names = "a"),
+    c("a <- 1;", "a <- a + 1")
   )
 })
 
@@ -256,7 +260,7 @@ testthat::test_that("does not break if code uses quote()", {
   )
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
-    get_code(q, names = "x"),
+    get_code_g(q, names = "x"),
     code[2]
   )
 })
@@ -269,7 +273,7 @@ testthat::test_that("does not break if object is used in a function on lhs", {
   )
   q <- eval_code(qenv(), code = code)
   testthat::expect_identical(
-    get_code(q, names = "iris"),
+    get_code_g(q, names = "iris"),
     code[c(1, 3)]
   )
 })
@@ -284,7 +288,7 @@ testthat::test_that(
     )
     q <- eval_code(qenv(), code = code)
     testthat::expect_identical(
-      get_code(q, names = "x"),
+      get_code_g(q, names = "x"),
       code
     )
   }
@@ -304,15 +308,15 @@ testthat::test_that("extracts the code for assign() where \"x\" is a literal str
   )
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
-    get_code(q, names = "b"),
+    get_code_g(q, names = "b"),
     code[c(2, 5)]
   )
   testthat::expect_identical(
-    get_code(q, names = "c"),
+    get_code_g(q, names = "c"),
     code[c(2, 3, 5, 6)]
   )
   testthat::expect_identical(
-    get_code(q, names = "d"),
+    get_code_g(q, names = "d"),
     c("assign(value = 15, x = \"d\")", "d <- d * 2")
   )
 })
@@ -326,7 +330,7 @@ testthat::test_that("extracts the code for assign() where \"x\" is variable", {
   )
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
-    get_code(q, names = "b"),
+    get_code_g(q, names = "b"),
     code
   )
 })
@@ -343,7 +347,7 @@ testthat::test_that("works for assign() detection no matter how many parametrers
   q <- eval_code(qenv(), code)
 
   testthat::expect_identical(
-    get_code(q, names = "y"),
+    get_code_g(q, names = "y"),
     code
   )
 })
@@ -359,11 +363,11 @@ testthat::test_that("detects function usage of the assignment operator", {
   q2 <- eval_code(qenv(), code2)
 
   testthat::expect_identical(
-    get_code(q, names = "y"),
+    get_code_g(q, names = "y"),
     code
   )
   testthat::expect_identical(
-    get_code(q2, names = "y"),
+    get_code_g(q2, names = "y"),
     code2
   )
 })
@@ -382,20 +386,19 @@ testthat::test_that("get_code does not break if @linksto is put in the last line
   )
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
-    get_code(q, names = "x"),
+    get_code_g(q, names = "x"),
     code
   )
 })
 
 testthat::test_that("@linksto makes a line being returned for an affected binding", {
-  code <- "
-  a <- 1 # @linksto b
-  b <- 2
-  "
+  code <-
+  "a <- 1 # @linksto b
+  b <- 2"
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
-    get_code(q, names = "b"),
-    c("  a <- 1 # @linksto b", "  b <- 2")
+    get_code_g(q, names = "b"),
+    c("a <- 1 # @linksto b", "  b <- 2")
   )
 })
 
@@ -409,7 +412,7 @@ testthat::test_that(
     )
     q <- eval_code(qenv(), code)
     testthat::expect_identical(
-      get_code(q, names = "b"),
+      get_code_g(q, names = "b"),
       code
     )
   }
@@ -426,11 +429,11 @@ testthat::test_that(
     )
     q <- eval_code(qenv(), code)
     testthat::expect_identical(
-      get_code(q, names = "a"),
+      get_code_g(q, names = "a"),
       code[1:3]
     )
     testthat::expect_identical(
-      get_code(q, names = "b"),
+      get_code_g(q, names = "b"),
       code[c(2, 4)]
     )
   }
@@ -447,7 +450,7 @@ testthat::test_that(
     )
     q <- eval_code(qenv(), code)
     testthat::expect_identical(
-      get_code(q, names = "classes"),
+      get_code_g(q, names = "classes"),
       code
     )
   }
@@ -472,11 +475,10 @@ testthat::test_that("comments fall into proper calls", {
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
     get_code(q),
-    c(
-      "    # initial comment\n    a <- 1",
-      "    b <- 2 # inline comment",
-      "    c <- 3\n    # inbetween comment",
-      "    d <- 4\n    # finishing comment"
+    c("\n    # initial comment\n    a <- 1\n    b <- 2 ",
+      "# inline comment\n",
+      "    c <- 3\n",
+      "    # inbetween comment\n    d <- 4\n    # finishing comment\n  "
     )
   )
 })
@@ -498,11 +500,10 @@ testthat::test_that("comments get pasted when they fall into calls", {
   q <- qenv() |> eval_code(code)
   testthat::expect_identical(
     get_code(q),
-    c(
-      "    # initial comment\n    a <- 1 # A comment",
-      "    b <- 2 # inline comment",
-      "    c <- 3 # C comment\n    # inbetween comment",
-      "    d <- 4\n    # finishing comment"
+    c("\n    # initial comment\n    a <- 1 # A comment\n",
+      "    b <- 2 # inline comment\n",
+      "    c <- 3 # C comment\n",
+      "    # inbetween comment\n    d <- 4\n    # finishing comment\n  "
     )
   )
 })
@@ -516,11 +517,11 @@ testthat::test_that("ignores occurrence in a function definition", {
   )
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
-    get_code(q, names = "b"),
+    get_code_g(q, names = "b"),
     "b <- 2"
   )
   testthat::expect_identical(
-    get_code(q, names = "foo"),
+    get_code_g(q, names = "foo"),
     code[2]
   )
 })
@@ -532,11 +533,11 @@ testthat::test_that("ignores occurrence in a function definition that has functi
   )
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
-    get_code(q, names = "b"),
+    get_code_g(q, names = "b"),
     code[1]
   )
   testthat::expect_identical(
-    get_code(q, names = "foo"),
+    get_code_g(q, names = "foo"),
     code[2]
   )
 })
@@ -550,11 +551,11 @@ testthat::test_that("ignores occurrence in a function definition if there is mul
   )
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
-    get_code(q, names = "b"),
+    get_code_g(q, names = "b"),
     code[c(1, 3)]
   )
   testthat::expect_identical(
-    get_code(q, names = "foo"),
+    get_code_g(q, names = "foo"),
     code[2]
   )
 })
@@ -569,7 +570,7 @@ testthat::test_that("ignores occurrence in a function definition in lapply", {
   )
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
-    get_code(q, names = "x"),
+    get_code_g(q, names = "x"),
     "x <- 1"
   )
 })
@@ -584,7 +585,7 @@ testthat::test_that("does not ignore occurrence in function body if object exsit
   )
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
-    get_code(q, names = "b"),
+    get_code_g(q, names = "b"),
     code
   )
 })
@@ -596,11 +597,11 @@ testthat::test_that("ignores occurrence in function definition without { curly b
   )
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
-    get_code(q, names = "foo"),
+    get_code_g(q, names = "foo"),
     "foo <- function(b) b <- b + 2"
   )
   testthat::expect_identical(
-    get_code(q, names = "b"),
+    get_code_g(q, names = "b"),
     "b <- 2"
   )
 })
@@ -614,7 +615,7 @@ testthat::test_that("detects occurrence of the function object", {
   )
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
-    get_code(q, names = "b"),
+    get_code_g(q, names = "b"),
     code
   )
 })
@@ -627,7 +628,7 @@ testthat::test_that("detects occurrence of a function definition when a formal i
   )
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
-    get_code(q, names = "a"),
+    get_code_g(q, names = "a"),
     code
   )
 })
@@ -644,7 +645,7 @@ testthat::test_that("detects occurrence of a function definition with a @linksto
   )
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
-    get_code(q, names = "x"),
+    get_code_g(q, names = "x"),
     c(
       "        foo <- function() {\n          env <- parent.frame()\n          env$x <- 0\n        }",
       "foo() # @linksto x"
@@ -663,11 +664,11 @@ testthat::test_that("understands $ usage and do not treat rhs of $ as objects (o
   )
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
-    get_code(q, names = "x"),
+    get_code_g(q, names = "x"),
     "x <- data.frame(a = 1:3)"
   )
   testthat::expect_identical(
-    get_code(q, names = "a"),
+    get_code_g(q, names = "a"),
     code
   )
 })
@@ -680,7 +681,7 @@ testthat::test_that("detects cooccurrence properly even if all objects are on lh
   )
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
-    get_code(q, names = "b"),
+    get_code_g(q, names = "b"),
     code
   )
 })
@@ -700,12 +701,12 @@ testthat::test_that("understands @ usage and do not treat rhs of @ as objects (o
   q <- qenv()
   q@code <- code # we don't use eval_code so the code is not run
   testthat::expect_identical(
-    get_code(q, names = "x"),
+    get_code_g(q, names = "x"),
     unlist(code[1:2])
   )
   testthat::expect_identical(
-    get_code(q, names = "a"),
-    unlist(code)
+    get_code_g(q, names = "a"),
+    unlist(code)[-1]
   )
 })
 
@@ -723,7 +724,7 @@ testthat::test_that("library() and require() are always returned", {
   )
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
-    get_code(q, names = "x"),
+    get_code_g(q, names = "x"),
     code[c(2, 3, 4)]
   )
 })
@@ -741,7 +742,7 @@ testthat::test_that("data() call is returned when data name is provided as is",
   )
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
-    get_code(q, names = "x"),
+    get_code_g(q, names = "x"),
     code[-1]
   )
 })
@@ -756,7 +757,7 @@ testthat::test_that("data() call is returned when data name is provided as a cha
   )
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
-    get_code(q, names = "z"),
+    get_code_g(q, names = "z"),
     code[-1]
   )
 })
@@ -774,7 +775,7 @@ testthat::describe("Backticked symbol", {
 
     testthat::expect_identical(
       get_code(td, names = "%cbind%"),
-      "`%cbind%` <- function(lhs, rhs) cbind(lhs, rhs)"
+      "`%cbind%` <- function(lhs, rhs) cbind(lhs, rhs)\n"
     )
   })
 
@@ -789,7 +790,7 @@ testthat::describe("Backticked symbol", {
 
     testthat::expect_identical(
       get_code(td, names = "`%cbind%`"),
-      "`%cbind%` <- function(lhs, rhs) cbind(lhs, rhs)"
+      "`%cbind%` <- function(lhs, rhs) cbind(lhs, rhs)\n"
     )
   })
 
@@ -805,7 +806,7 @@ testthat::describe("Backticked symbol", {
     testthat::expect_identical(
       get_code(td, names = "iris_ds"),
       c(
-        "`_add_column_` <- function(lhs, rhs) cbind(lhs, rhs)",
+        "`_add_column_` <- function(lhs, rhs) cbind(lhs, rhs)\n",
         "iris_ds <- `_add_column_`(iris, data.frame(new_col = \"new column\"))"
       )
     )
@@ -823,7 +824,7 @@ testthat::describe("Backticked symbol", {
     testthat::expect_identical(
       get_code(td, names = "iris_ds"),
       c(
-        "`add column` <- function(lhs, rhs) cbind(lhs, rhs)",
+        "`add column` <- function(lhs, rhs) cbind(lhs, rhs)\n",
         "iris_ds <- `add column`(iris, data.frame(new_col = \"new column\"))"
       )
     )
@@ -841,7 +842,7 @@ testthat::describe("Backticked symbol", {
     testthat::expect_identical(
       get_code(td, names = "iris_ds"),
       c(
-        "add_column <- function(lhs, rhs) cbind(lhs, rhs)",
+        "add_column <- function(lhs, rhs) cbind(lhs, rhs)\n",
         "iris_ds <- add_column(iris, data.frame(new_col = \"new column\"))"
       )
     )
@@ -861,7 +862,7 @@ testthat::describe("Backticked symbol", {
     testthat::expect_identical(
       get_code(td, names = "iris_ds"),
       c(
-        "`%add_column%` <- function(lhs, rhs) cbind(lhs, rhs)",
+        "`%add_column%` <- function(lhs, rhs) cbind(lhs, rhs)\n",
         "iris_ds <- iris %add_column% data.frame(new_col = \"new column\")"
       )
     )
@@ -881,7 +882,7 @@ testthat::describe("Backticked symbol", {
     testthat::expect_identical(
       get_code(td, names = "iris_ds"),
       c(
-        "`%add_column%` <- function(lhs, rhs) cbind(lhs, rhs)",
+        "`%add_column%` <- function(lhs, rhs) cbind(lhs, rhs)\n",
         "iris_ds <- iris %add_column% data.frame(new_col = \"new column\")"
       )
     )

From 6338ce13a034595c19bac9c305cf607d00d65073 Mon Sep 17 00:00:00 2001
From: m7pr <marcin.kosinski.mk1@roche.com>
Date: Mon, 4 Nov 2024 11:53:27 +0100
Subject: [PATCH 47/98] documentation changes for @names param - move to
 qenv-consrtuctor

---
 R/qenv-constructor.R | 3 +++
 R/qenv-extract.R     | 1 -
 R/qenv-get_code.R    | 4 +---
 man/qenv.Rd          | 3 ++-
 4 files changed, 6 insertions(+), 5 deletions(-)

diff --git a/R/qenv-constructor.R b/R/qenv-constructor.R
index fa2fa333..6f6f909e 100644
--- a/R/qenv-constructor.R
+++ b/R/qenv-constructor.R
@@ -33,6 +33,9 @@ qenv <- function() {
 #'  (`character(1)` or `language`) code to evaluate. Accepts and stores comments also.
 #' @param env `r badge("deprecated")` (`environment`)
 #'  Environment being a result of the `code` evaluation.
+#' @param names (`character`) for `x[names]`, names of objects included in `qenv` to subset. Names not present in `qenv`
+#' are skipped. For `get_code` `r lifecycle::badge("experimental")` vector of object names to return the code for.
+#' For more details see the "Extracting dataset-specific code" section.
 #'
 #' @examples
 #' # create qenv with data and code (deprecated)
diff --git a/R/qenv-extract.R b/R/qenv-extract.R
index aa740325..b57b6563 100644
--- a/R/qenv-extract.R
+++ b/R/qenv-extract.R
@@ -2,7 +2,6 @@
 #' @section Subsetting:
 #' `x[names]` subsets objects in `qenv` environment and limit the code to the necessary needed to build limited objects.
 #'
-#' @param names (`character`) names of objects included in `qenv` to subset
 #' @param x (`qenv`)
 #'
 #' @examples
diff --git a/R/qenv-get_code.R b/R/qenv-get_code.R
index a96579d6..b569cbaf 100644
--- a/R/qenv-get_code.R
+++ b/R/qenv-get_code.R
@@ -5,13 +5,11 @@
 #'
 #' @param object (`qenv`)
 #' @param deparse (`logical(1)`) flag specifying whether to return code as `character` or `expression`.
-#' @param names `r lifecycle::badge("experimental")` (`character`) vector of object names to return the code for.
-#' For more details see the "Extracting dataset-specific code" section.
 #' @param ... see `Details`
 #'
 #'
 #' @section Extracting dataset-specific code:
-#' When `names` is specified, the code returned will be limited  to the lines needed to _create_
+#' When `names` for `get_code` is specified, the code returned will be limited  to the lines needed to _create_
 #' the requested objects. The code stored in the `@code` slot is analyzed statically to determine
 #' which lines the objects of interest depend upon. The analysis works well when objects are created
 #' with standard infix assignment operators (see `?assignOps`) but it can fail in some situations.
diff --git a/man/qenv.Rd b/man/qenv.Rd
index b4c6fb85..b789c7e0 100644
--- a/man/qenv.Rd
+++ b/man/qenv.Rd
@@ -43,7 +43,8 @@ Environment being a result of the \code{code} evaluation.}
 
 \item{x}{(\code{qenv})}
 
-\item{names}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} (\code{character}) vector of object names to return the code for.
+\item{names}{(\code{character}) for \verb{[.}, names of objects included in \code{qenv} to subset.
+For \code{get_code} \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} vector of object names to return the code for.
 For more details see the "Extracting dataset-specific code" section.}
 
 \item{deparse}{(\code{logical(1)}) flag specifying whether to return code as \code{character} or \code{expression}.}

From 930503fd9ae25a733c7972af4874222e1d872867 Mon Sep 17 00:00:00 2001
From: m7pr <marcin.kosinski.mk1@roche.com>
Date: Mon, 4 Nov 2024 13:00:06 +0100
Subject: [PATCH 48/98] fix typos in tests

---
 tests/testthat/test-qenv_join.R   | 4 ++--
 tests/testthat/test-qenv_within.R | 2 +-
 2 files changed, 3 insertions(+), 3 deletions(-)

diff --git a/tests/testthat/test-qenv_join.R b/tests/testthat/test-qenv_join.R
index 6690326d..18fa2eae 100644
--- a/tests/testthat/test-qenv_join.R
+++ b/tests/testthat/test-qenv_join.R
@@ -40,7 +40,7 @@ testthat::test_that("Joined qenv does not duplicate common code", {
 
   testthat::expect_identical(
     unlist(q@code),
-    c("iris1 <- iris", "mtcars1 <- mtcars", "mtcars2 <- mtcars")
+    c("iris1 <- iris\n", "mtcars1 <- mtcars", "mtcars2 <- mtcars")
   )
   testthat::expect_identical(get_code_attr(q, "id"), c(get_code_attr(q1, "id"), get_code_attr(q2, "id")[3]))
 })
@@ -64,7 +64,7 @@ testthat::test_that("join does not duplicate code but adds only extra code", {
 
   testthat::expect_identical(
     unlist(q@code),
-    c("iris1 <- iris", "mtcars1 <- mtcars", "iris2 <- iris", "mtcars2 <- mtcars")
+    c("iris1 <- iris\n", "mtcars1 <- mtcars", "iris2 <- iris", "mtcars2 <- mtcars")
   )
 
   testthat::expect_equal(
diff --git a/tests/testthat/test-qenv_within.R b/tests/testthat/test-qenv_within.R
index a05d0a03..7bc54432 100644
--- a/tests/testthat/test-qenv_within.R
+++ b/tests/testthat/test-qenv_within.R
@@ -48,7 +48,7 @@ testthat::test_that("styling of input code does not impact evaluation results",
   all_code <- get_code(q)
   testthat::expect_identical(
     all_code,
-    rep(c("1 + 1", "2 + 2"), 4L)
+    rep(c("1 + 1\n", "2 + 2"), 4L)
   )
 })
 

From 0afef8388f8804df5d6006078edd650bb8bee52a Mon Sep 17 00:00:00 2001
From: m7pr <marcin.kosinski.mk1@roche.com>
Date: Mon, 4 Nov 2024 13:17:35 +0100
Subject: [PATCH 49/98] extract_calls do not drop @linksto tags

---
 R/utils-get_code_dependency.R | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/R/utils-get_code_dependency.R b/R/utils-get_code_dependency.R
index 67649deb..7e05e2af 100644
--- a/R/utils-get_code_dependency.R
+++ b/R/utils-get_code_dependency.R
@@ -110,7 +110,7 @@ find_call <- function(call_pd, text) {
 #' @noRd
 extract_calls <- function(pd) {
   calls <- lapply(
-    pd[pd$parent == 0 & pd$token != "COMMENT", "id"],
+    pd[pd$parent == 0 & (pd$token != "COMMENT" | grepl("@linksto", pd$text, fixed = TRUE)), "id"],
     function(parent) {
       rbind(
         pd[pd$id == parent, ],
@@ -120,6 +120,7 @@ extract_calls <- function(pd) {
   )
   calls <- Filter(function(call) !(nrow(call) == 1 && call$token == "';'"), calls)
   calls <- Filter(Negate(is.null), calls)
+  calls <- fix_shifted_comments(calls)
   fix_arrows(calls)
 }
 

From 86e5d9588b732e4a4ee635c08db83dc645f73235 Mon Sep 17 00:00:00 2001
From: m7pr <marcin.kosinski.mk1@roche.com>
Date: Mon, 4 Nov 2024 13:20:20 +0100
Subject: [PATCH 50/98] first clone object, then return

---
 R/qenv-eval_code.R                | 3 +--
 tests/testthat/test-qenv_within.R | 2 --
 2 files changed, 1 insertion(+), 4 deletions(-)

diff --git a/R/qenv-eval_code.R b/R/qenv-eval_code.R
index ff6dd27d..07797351 100644
--- a/R/qenv-eval_code.R
+++ b/R/qenv-eval_code.R
@@ -29,11 +29,10 @@ setGeneric("eval_code", function(object, code) standardGeneric("eval_code"))
 
 setMethod("eval_code", signature = c("qenv", "character"), function(object, code) {
   parsed_code <- parse(text = code, keep.source = TRUE)
+  object@env <- rlang::env_clone(object@env, parent = parent.env(.GlobalEnv))
   if (length(parsed_code) == 0) {
     return(object)
   }
-
-  object@env <- rlang::env_clone(object@env, parent = parent.env(.GlobalEnv))
   code_split <- split_code(paste(code, collapse = "\n"))
 
   for (i in seq_along(code_split)) {
diff --git a/tests/testthat/test-qenv_within.R b/tests/testthat/test-qenv_within.R
index 7bc54432..7d37ee0e 100644
--- a/tests/testthat/test-qenv_within.R
+++ b/tests/testthat/test-qenv_within.R
@@ -60,8 +60,6 @@ testthat::test_that("within.qenv renturns a `qenv` where `@env` is a deep copy o
   qq <- within(q, {})
   testthat::expect_equal(q@env, qq@env)
   testthat::expect_false(identical(q@env, qq@env))
-  # TODO: fix
-  # dunno what's going on yet
 })
 
 testthat::test_that("within.qenv renturns qenv.error even if evaluation raises error", {

From d91395a96a9aab4db1442ed53116ef6800616d1e Mon Sep 17 00:00:00 2001
From: m7pr <marcin.kosinski.mk1@roche.com>
Date: Mon, 4 Nov 2024 13:22:49 +0100
Subject: [PATCH 51/98] revert the state of the test

---
 tests/testthat/test-qenv_get_code.R | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/tests/testthat/test-qenv_get_code.R b/tests/testthat/test-qenv_get_code.R
index d15ef166..c6f49bbc 100644
--- a/tests/testthat/test-qenv_get_code.R
+++ b/tests/testthat/test-qenv_get_code.R
@@ -706,7 +706,7 @@ testthat::test_that("understands @ usage and do not treat rhs of @ as objects (o
   )
   testthat::expect_identical(
     get_code_g(q, names = "a"),
-    unlist(code)[-1]
+    unlist(code)
   )
 })
 

From b175c5826019cd883cc88d6cc0f21c8ade768d87 Mon Sep 17 00:00:00 2001
From: m7pr <marcin.kosinski.mk1@roche.com>
Date: Mon, 4 Nov 2024 14:16:29 +0100
Subject: [PATCH 52/98] fix tests for comments

---
 R/utils-get_code_dependency.R       |  6 +++---
 tests/testthat/test-qenv_get_code.R | 12 +++++-------
 2 files changed, 8 insertions(+), 10 deletions(-)

diff --git a/R/utils-get_code_dependency.R b/R/utils-get_code_dependency.R
index 7e05e2af..83dcd2ec 100644
--- a/R/utils-get_code_dependency.R
+++ b/R/utils-get_code_dependency.R
@@ -150,9 +150,9 @@ fix_shifted_comments <- function(calls) {
       if (isTRUE(comment_idx[1] <= 2)) {
         calls[[i - 1]] <- rbind(
           calls[[i - 1]],
-          calls[[i]][seq_len(comment_idx[1]), ]
+          calls[[i]][comment_idx[1], ]
         )
-        calls[[i]] <- calls[[i]][-seq_len(comment_idx[1]), ]
+        calls[[i]] <- calls[[i]][-comment_idx[1], ]
       }
     }
   }
@@ -471,7 +471,7 @@ get_call_breaks <- function(code) {
   call_breaks <- t(sapply(
     extract_calls(pd),
     function(x) {
-      matrix(c(max(x$line2), max(x$col2)))
+      matrix(c(max(x$line2), max(x$col2[x$line2 == max(x$line2)])))
     }
   ))
   call_breaks <- call_breaks[-nrow(call_breaks), , drop = FALSE] # breaks in between needed only
diff --git a/tests/testthat/test-qenv_get_code.R b/tests/testthat/test-qenv_get_code.R
index c6f49bbc..5c417c3b 100644
--- a/tests/testthat/test-qenv_get_code.R
+++ b/tests/testthat/test-qenv_get_code.R
@@ -475,8 +475,8 @@ testthat::test_that("comments fall into proper calls", {
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
     get_code(q),
-    c("\n    # initial comment\n    a <- 1\n    b <- 2 ",
-      "# inline comment\n",
+    c("\n    # initial comment\n    a <- 1\n",
+      "    b <- 2 # inline comment\n",
       "    c <- 3\n",
       "    # inbetween comment\n    d <- 4\n    # finishing comment\n  "
     )
@@ -645,11 +645,9 @@ testthat::test_that("detects occurrence of a function definition with a @linksto
   )
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
-    get_code_g(q, names = "x"),
-    c(
-      "        foo <- function() {\n          env <- parent.frame()\n          env$x <- 0\n        }",
-      "foo() # @linksto x"
-    )
+    get_code(q, names = "x"),
+    c("\n        foo <- function() {\n          env <- parent.frame()\n          env$x <- 0\n        }\n",
+      "foo() # @linksto x\n")
   )
 })
 # $ ---------------------------------------------------------------------------------------------------------------

From 894f8193bc152babd2736f181675e7c6b5ec54bd Mon Sep 17 00:00:00 2001
From: m7pr <marcin.kosinski.mk1@roche.com>
Date: Mon, 4 Nov 2024 14:30:54 +0100
Subject: [PATCH 53/98] fix warnings test

---
 tests/testthat/test-qenv_get_warnings.R | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/tests/testthat/test-qenv_get_warnings.R b/tests/testthat/test-qenv_get_warnings.R
index 01100a75..aef810de 100644
--- a/tests/testthat/test-qenv_get_warnings.R
+++ b/tests/testthat/test-qenv_get_warnings.R
@@ -49,12 +49,12 @@ testthat::test_that("get_warnings accepts a qenv object with a single eval_code
         "~~~ Warnings ~~~\n",
         "> This is a warning 1!",
         "when running code:",
-        "warning(\"This is a warning 1!\")\n",
+        "warning(\"This is a warning 1!\")\n\n",
         "> This is a warning 2!",
         "when running code:",
         "warning(\"This is a warning 2!\")\n",
         "~~~ Trace ~~~\n",
-        "warning(\"This is a warning 1!\")",
+        "warning(\"This is a warning 1!\")\n",
         "warning(\"This is a warning 2!\")"
       ),
       collapse = "\n"

From 2971a17425feb2576131a1251239c6ddd7846d84 Mon Sep 17 00:00:00 2001
From: m7pr <marcin.kosinski.mk1@roche.com>
Date: Mon, 4 Nov 2024 14:44:49 +0100
Subject: [PATCH 54/98] update documentation for qenv slots

---
 R/qenv-class.R    | 15 ++++++++++-----
 man/qenv-class.Rd | 17 +++++++++++------
 man/qenv.Rd       |  6 +++---
 3 files changed, 24 insertions(+), 14 deletions(-)

diff --git a/R/qenv-class.R b/R/qenv-class.R
index 3bf7e03e..676041ad 100644
--- a/R/qenv-class.R
+++ b/R/qenv-class.R
@@ -3,13 +3,18 @@
 #' Reproducible class with environment and code.
 #' @name qenv-class
 #' @rdname qenv-class
-#' @slot code (`character`) representing code necessary to reproduce the environment
+#' @slot code (`list` of `character`) representing code necessary to reproduce the environment.
+#' Read more in Code section.
 #' @slot env (`environment`) environment which content was generated by the evaluation
 #'  of the `code` slot.
-#' @slot id (`integer`) random identifier of the code element to make sure uniqueness
-#'  when joining.
-#' @slot warnings (`character`) the warnings output when evaluating the code
-#' @slot messages (`character`) the messages output when evaluating the code
+#'
+#' @section Code:
+#'
+#' Each code element is a character representing one call. Each element has possible attributes:
+#' - warnings (`character`) the warnings output when evaluating the code element
+#' - messages (`character`) the messages output when evaluating the code element
+#' - id (`integer`) random identifier of the code element to make sure uniqueness when joining.
+#'
 #' @keywords internal
 #' @exportClass qenv
 setClass(
diff --git a/man/qenv-class.Rd b/man/qenv-class.Rd
index acb66ffe..cbc49fb5 100644
--- a/man/qenv-class.Rd
+++ b/man/qenv-class.Rd
@@ -10,17 +10,22 @@ Reproducible class with environment and code.
 \section{Slots}{
 
 \describe{
-\item{\code{code}}{(\code{character}) representing code necessary to reproduce the environment}
+\item{\code{code}}{(\code{list} of \code{character}) representing code necessary to reproduce the environment.
+Read more in Code section.}
 
 \item{\code{env}}{(\code{environment}) environment which content was generated by the evaluation
 of the \code{code} slot.}
+}}
 
-\item{\code{id}}{(\code{integer}) random identifier of the code element to make sure uniqueness
-when joining.}
+\section{Code}{
 
-\item{\code{warnings}}{(\code{character}) the warnings output when evaluating the code}
 
-\item{\code{messages}}{(\code{character}) the messages output when evaluating the code}
-}}
+Each code element is a character representing one call. Each element has possible attributes:
+\itemize{
+\item warnings (\code{character}) the warnings output when evaluating the code element
+\item messages (\code{character}) the messages output when evaluating the code element
+\item id (\code{integer}) random identifier of the code element to make sure uniqueness when joining.
+}
+}
 
 \keyword{internal}
diff --git a/man/qenv.Rd b/man/qenv.Rd
index b789c7e0..53f5ff36 100644
--- a/man/qenv.Rd
+++ b/man/qenv.Rd
@@ -43,8 +43,8 @@ Environment being a result of the \code{code} evaluation.}
 
 \item{x}{(\code{qenv})}
 
-\item{names}{(\code{character}) for \verb{[.}, names of objects included in \code{qenv} to subset.
-For \code{get_code} \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} vector of object names to return the code for.
+\item{names}{(\code{character}) for \code{x[names]}, names of objects included in \code{qenv} to subset. Names not present in \code{qenv}
+are skipped. For \code{get_code} \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} vector of object names to return the code for.
 For more details see the "Extracting dataset-specific code" section.}
 
 \item{deparse}{(\code{logical(1)}) flag specifying whether to return code as \code{character} or \code{expression}.}
@@ -94,7 +94,7 @@ as \code{name:value} pairs are passed to \code{...}, \code{name} in \code{expr}
 
 \section{Extracting dataset-specific code}{
 
-When \code{names} is specified, the code returned will be limited  to the lines needed to \emph{create}
+When \code{names} for \code{get_code} is specified, the code returned will be limited  to the lines needed to \emph{create}
 the requested objects. The code stored in the \verb{@code} slot is analyzed statically to determine
 which lines the objects of interest depend upon. The analysis works well when objects are created
 with standard infix assignment operators (see \code{?assignOps}) but it can fail in some situations.

From f18d55acfe39b00fd41cc72011c27813dae9ddd5 Mon Sep 17 00:00:00 2001
From: m7pr <marcin.kosinski.mk1@roche.com>
Date: Mon, 4 Nov 2024 15:03:36 +0100
Subject: [PATCH 55/98] bring @param names documentation

---
 R/qenv-constructor.R | 4 ++++
 man/qenv.Rd          | 2 --
 2 files changed, 4 insertions(+), 2 deletions(-)

diff --git a/R/qenv-constructor.R b/R/qenv-constructor.R
index 504b1259..71964e48 100644
--- a/R/qenv-constructor.R
+++ b/R/qenv-constructor.R
@@ -5,6 +5,10 @@
 #'
 #' Create a `qenv` object and evaluate code in it to track code history.
 #'
+#' @param names (`character`) for `x[names]`, names of objects included in `qenv` to subset. Names not present in `qenv`
+#' are skipped. For `get_code` `r lifecycle::badge("experimental")` vector of object names to return the code for.
+#' For more details see the "Extracting dataset-specific code" section.
+#'
 #' @details
 #'
 #' `qenv()` instantiates a `qenv` with an empty environment.
diff --git a/man/qenv.Rd b/man/qenv.Rd
index a24600cc..0ede17c9 100644
--- a/man/qenv.Rd
+++ b/man/qenv.Rd
@@ -30,8 +30,6 @@ get_code(object, deparse = TRUE, names = NULL, ...)
 
 \item{code}{(\code{character} or \code{language}) code to evaluate. If \code{character}, comments are retained.}
 
-\item{object}{(\code{qenv})}
-
 \item{x}{(\code{qenv})}
 
 \item{names}{(\code{character}) for \code{x[names]}, names of objects included in \code{qenv} to subset. Names not present in \code{qenv}

From 187350c6f7e0746e8f70e1d02b57effed5e8d936 Mon Sep 17 00:00:00 2001
From: m7pr <marcin.kosinski.mk1@roche.com>
Date: Tue, 5 Nov 2024 11:45:27 +0100
Subject: [PATCH 56/98] remove @ usage in vignette

---
 vignettes/qenv.Rmd | 10 ++++------
 1 file changed, 4 insertions(+), 6 deletions(-)

diff --git a/vignettes/qenv.Rmd b/vignettes/qenv.Rmd
index 484e081b..903aad4c 100644
--- a/vignettes/qenv.Rmd
+++ b/vignettes/qenv.Rmd
@@ -122,19 +122,17 @@ The feasibility of joining `qenv` objects hinges on the contents of the environm
 
 ### Warnings and messages in `qenv` objects
 
-In cases where warnings or messages arise while evaluating code within a `qenv` environment, these are captured and stored within the `qenv` object. Access these messages and warnings using attributes of `@code` slot
+In cases where warnings or messages arise while evaluating code within a `qenv` environment, these are captured and stored within the `qenv` object. Access these messages and warnings using below
 
 ```{r}
 q_message <- eval_code(qenv(), quote(message("this is a message")))
-lapply(q_message@code, "attr", "messages")
+# get_messages(q_message) # TODO - this function does not exist
 
 q_warning <- eval_code(qenv(), quote(warning("and this is a warning")))
-lapply(q_warning@code, "attr", "warnings")
+get_warnings(q_warning)
 ```
 
-If a particular line of code doesn't trigger any warnings or messages, the corresponding message/warning value will be `NULL`.
-
-Additionally, a helper function, `get_warnings()`, is available to generate a formatted string comprising the warnings and the code responsible for generating them. It returns `NULL` when no warnings are present.
+If any of above returns `NULL`m then no warnings nor messages were present.
 
 ## Utilizing `qenv` inside `shiny` applications
 

From a84f2bce5ccbebbe402b9c613b31d0e147d14a58 Mon Sep 17 00:00:00 2001
From: Marcin <133694481+m7pr@users.noreply.github.com>
Date: Wed, 6 Nov 2024 09:15:59 +0100
Subject: [PATCH 57/98] Update tests/testthat/test-qenv_extract.R
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

Co-authored-by: Dawid Kałędkowski <dawid.kaledkowski@gmail.com>
Signed-off-by: Marcin <133694481+m7pr@users.noreply.github.com>
---
 tests/testthat/test-qenv_extract.R | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/tests/testthat/test-qenv_extract.R b/tests/testthat/test-qenv_extract.R
index feb44482..25149af3 100644
--- a/tests/testthat/test-qenv_extract.R
+++ b/tests/testthat/test-qenv_extract.R
@@ -21,7 +21,7 @@ testthat::test_that("`[.` returns limited qenv for some names not in qenv", {
   )
 })
 
-testthat::test_that("`[.` extracts proper objects", {
+testthat::test_that("`[.` subsets environment and code to specified object names", {
   q <- qenv()
   code <- c("x<-1", "a<-1;b<-2")
   q <- eval_code(q, code)

From 084382a3b6021705c6e1ab968ae4fcc26074d426 Mon Sep 17 00:00:00 2001
From: m7pr <marcin.kosinski.mk1@roche.com>
Date: Wed, 6 Nov 2024 09:17:39 +0100
Subject: [PATCH 58/98] adjust description in test

---
 tests/testthat/test-qenv_extract.R | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/tests/testthat/test-qenv_extract.R b/tests/testthat/test-qenv_extract.R
index 25149af3..825463b9 100644
--- a/tests/testthat/test-qenv_extract.R
+++ b/tests/testthat/test-qenv_extract.R
@@ -30,7 +30,7 @@ testthat::test_that("`[.` subsets environment and code to specified object names
   testthat::expect_true(all(ls(get_env(qs)) %in% object_names))
 })
 
-testthat::test_that("`[.` extract proper code", {
+testthat::test_that("`[.` extracts the code only needed to recreate objects passed through 'names'", {
   q <- qenv()
   code <- c("x<-1", "a<-1;b<-2")
   q <- eval_code(q, code)

From 6a5d14930142d687ff8107d9d105ee9bc330daf3 Mon Sep 17 00:00:00 2001
From: m7pr <marcin.kosinski.mk1@roche.com>
Date: Wed, 6 Nov 2024 09:25:42 +0100
Subject: [PATCH 59/98] fix descriptions in few more tests

---
 tests/testthat/test-qenv_eval_code.R | 12 ++++++++----
 1 file changed, 8 insertions(+), 4 deletions(-)

diff --git a/tests/testthat/test-qenv_eval_code.R b/tests/testthat/test-qenv_eval_code.R
index 0f296d7e..798b6cf6 100644
--- a/tests/testthat/test-qenv_eval_code.R
+++ b/tests/testthat/test-qenv_eval_code.R
@@ -91,7 +91,8 @@ testthat::test_that("an error when calling eval_code returns a qenv.error object
   testthat::expect_equal(q$message, "object 'w' not found \n when evaluating qenv code:\nexpression(z <- w * x)")
 })
 
-testthat::test_that("a warning when calling eval_code returns a qenv object which has warnings", {
+testthat::test_that(
+  "a warning when calling eval_code returns a qenv object which has warnings as attributes of code", {
   q <- eval_code(qenv(), quote("iris_data <- iris"))
   q <- eval_code(q, quote("p <- hist(iris_data[, 'Sepal.Length'], ff = '')"))
   testthat::expect_s4_class(q, "qenv")
@@ -101,7 +102,8 @@ testthat::test_that("a warning when calling eval_code returns a qenv object whic
   )
 })
 
-testthat::test_that("eval_code with a vector of code produces one warning element per code element", {
+testthat::test_that(
+  "eval_code associates warnings with call by adding attribute to code element", {
   q <- eval_code(qenv(), c("x <- 1", "y <- 1", "warning('warn1')"))
   testthat::expect_equal(
     lapply(q@code, attr, "warning"),
@@ -110,7 +112,8 @@ testthat::test_that("eval_code with a vector of code produces one warning elemen
 })
 
 
-testthat::test_that("a message when calling eval_code returns a qenv object which has messages", {
+testthat::test_that(
+  "eval_code associates messages with call by adding attribute to code element", {
   q <- eval_code(qenv(), quote("iris_data <- head(iris)"))
   q <- eval_code(q, quote("message('This is a message')"))
   testthat::expect_s4_class(q, "qenv")
@@ -123,7 +126,8 @@ testthat::test_that("a message when calling eval_code returns a qenv object whic
   )
 })
 
-testthat::test_that("eval_code returns a qenv object with empty messages and warnings when none are returned", {
+testthat::test_that(
+  "eval_code returns a qenv object with empty messages and warnings as code attributes, when none are returned", {
   q <- eval_code(qenv(), quote("iris_data <- head(iris)"))
   testthat::expect_s4_class(q, "qenv")
   testthat::expect_null(attr(q@code, "message"))

From 26efa3fdc6bf42b32c422dba20b3a85d3ce092ab Mon Sep 17 00:00:00 2001
From: m7pr <marcin.kosinski.mk1@roche.com>
Date: Wed, 6 Nov 2024 12:18:36 +0100
Subject: [PATCH 60/98] extend possible_names to hidden names in extract/subset
 function

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

diff --git a/R/qenv-extract.R b/R/qenv-extract.R
index b57b6563..fe35ac79 100644
--- a/R/qenv-extract.R
+++ b/R/qenv-extract.R
@@ -17,7 +17,7 @@
 #' @export
 `[.qenv` <- function(x, names) {
   checkmate::assert_class(names, "character")
-  possible_names <- ls(get_env(x))
+  possible_names <- ls(get_env(x), all.names = TRUE)
   names_warn <- setdiff(names, possible_names)
   names <- intersect(names, possible_names)
   if (!length(names)) {

From 6f032925fc3105bd4c9e0651a347fd9c036a8500 Mon Sep 17 00:00:00 2001
From: Marcin <133694481+m7pr@users.noreply.github.com>
Date: Wed, 6 Nov 2024 14:09:12 +0100
Subject: [PATCH 61/98] assign `side_effects` and `occurrence` as attributes of
 `@code` (#223)
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

Part of #216

Changes:
- [x] moved `dependency` extraction from `get_code_dependency` to
`eval_code`
- [x] removed `extract_code_graph`
- [x] extended documentation of `qenv` with 1 new attributes:
`dependency`, `occurrence`
- [x] merged `side_effects` and `occurrence` inside `eval_code` as they
were previously joined in `extract_code_graph` anyway
- [x] created tests for `qenv() |> eval_code |>
get_code_attr("dependency")`
- [x] changed `extract_side_effects` and `extract_occurrence` so they
work on an element, and they don't use `lapply`

---------

Signed-off-by: Marcin <133694481+m7pr@users.noreply.github.com>
Co-authored-by: Dawid Kałędkowski <dawid.kaledkowski@gmail.com>
---
 R/qenv-class.R                       |   8 +-
 R/qenv-eval_code.R                   |   3 +-
 R/utils-get_code_dependency.R        | 150 +++++++++++----------------
 man/qenv-class.Rd                    |   8 +-
 tests/testthat/test-qenv_eval_code.R |  27 +++++
 tests/testthat/test-qenv_get_code.R  |  17 ++-
 6 files changed, 111 insertions(+), 102 deletions(-)

diff --git a/R/qenv-class.R b/R/qenv-class.R
index 676041ad..35c4d74a 100644
--- a/R/qenv-class.R
+++ b/R/qenv-class.R
@@ -11,9 +11,11 @@
 #' @section Code:
 #'
 #' Each code element is a character representing one call. Each element has possible attributes:
-#' - warnings (`character`) the warnings output when evaluating the code element
-#' - messages (`character`) the messages output when evaluating the code element
-#' - id (`integer`) random identifier of the code element to make sure uniqueness when joining.
+#' - `warnings` (`character`) the warnings output when evaluating the code element
+#' - `messages` (`character`) the messages output when evaluating the code element
+#' - `id (`integer`) random identifier of the code element to make sure uniqueness when joining
+#' - `dependency` (`character`) names of objects that appear in this call and gets affected by this call,
+#' separated by `<-` (objects on LHS of `<-` are affected by this line, and objects on RHS are affecting this line)
 #'
 #' @keywords internal
 #' @exportClass qenv
diff --git a/R/qenv-eval_code.R b/R/qenv-eval_code.R
index 07797351..09de4809 100644
--- a/R/qenv-eval_code.R
+++ b/R/qenv-eval_code.R
@@ -37,7 +37,7 @@ setMethod("eval_code", signature = c("qenv", "character"), function(object, code
 
   for (i in seq_along(code_split)) {
     current_code <- code_split[[i]]
-    current_call <- parse(text = current_code, keep.source = FALSE)
+    current_call <- parse(text = current_code, keep.source = TRUE)
 
     # Using withCallingHandlers to capture warnings and messages.
     # Using tryCatch to capture the error and abort further evaluation.
@@ -79,6 +79,7 @@ setMethod("eval_code", signature = c("qenv", "character"), function(object, code
     }
 
     attr(current_code, "id") <- sample.int(.Machine$integer.max, size = 1)
+    attr(current_code, "dependency") <- extract_dependency(current_call)
     object@code <- c(object@code, list(current_code))
   }
 
diff --git a/R/utils-get_code_dependency.R b/R/utils-get_code_dependency.R
index 83dcd2ec..c9e0024a 100644
--- a/R/utils-get_code_dependency.R
+++ b/R/utils-get_code_dependency.R
@@ -33,37 +33,22 @@ get_code_dependency <- function(code, names, check_names = TRUE) {
     return(code)
   }
 
-  # If code is bound in curly brackets, remove them.
-  # TODO: rethink if this is still needed when code is divided by calls?
-  tcode <- trimws(code)
-  if (any(grepl("^\\{.*\\}$", tcode))) {
-    tcode <- sub("^\\{(.*)\\}$", "\\1", tcode)
-  }
-
-  parsed_code <- parse(text = tcode, keep.source = TRUE)
-
-  pd <- utils::getParseData(parsed_code)
-  pd <- normalize_pd(pd)
-  calls_pd <- extract_calls(pd)
+  graph <- lapply(code, attr, "dependency")
 
   if (check_names) {
-    # Detect if names are actually in code.
-    symbols <- unlist(lapply(calls_pd, function(call) call[call$token == "SYMBOL", "text"]))
-    if (any(pd$text == "assign")) {
-      assign_calls <- Filter(function(call) find_call(call, "assign"), calls_pd)
-      ass_str <- unlist(lapply(assign_calls, function(call) call[call$token == "STR_CONST", "text"]))
-      ass_str <- gsub("^['\"]|['\"]$", "", ass_str)
-      symbols <- c(ass_str, symbols)
-    }
+    symbols <- unlist(lapply(graph, function(call) {
+      ind <- match("<-", call, nomatch = length(call) + 1L)
+      call[seq_len(ind - 1L)]
+    }))
+
     if (!all(names %in% unique(symbols))) {
       warning("Object(s) not found in code: ", toString(setdiff(names, symbols)))
     }
   }
 
-  graph <- code_graph(calls_pd)
   ind <- unlist(lapply(names, function(x) graph_parser(x, graph)))
 
-  lib_ind <- detect_libraries(calls_pd)
+  lib_ind <- detect_libraries(graph)
 
   code_ids <- sort(unique(c(lib_ind, ind)))
   code[code_ids]
@@ -189,45 +174,17 @@ sub_arrows <- function(call) {
 
 # code_graph ----
 
-#' Create object dependencies graph within parsed code
-#'
-#' Builds dependency graph that identifies dependencies between objects in parsed code.
-#' Helps understand which objects depend on which.
-#'
-#' @param calls_pd `list` of `data.frame`s;
-#'  result of `utils::getParseData()` split into subsets representing individual calls;
-#'  created by `extract_calls()` function
-#'
-#' @return
-#' A list (of length of input `calls_pd`) where each element represents one call.
-#' Each element is a character vector listing names of objects that depend on this call
-#' and names of objects that this call depends on.
-#' Dependencies are listed after the `"<-"` string, e.g. `c("a", "<-", "b", "c")` means that in this call object `a`
-#' depends on objects `b` and `c`.
-#' If a call is tagged with `@linksto a`, then object `a` is understood to depend on that call.
-#'
-#' @keywords internal
-#' @noRd
-code_graph <- function(calls_pd) {
-  cooccurrence <- extract_occurrence(calls_pd)
-
-  side_effects <- extract_side_effects(calls_pd)
-
-  mapply(c, side_effects, cooccurrence, SIMPLIFY = FALSE)
-}
-
 #' Extract object occurrence
 #'
-#' Extracts objects occurrence within calls passed by `calls_pd`.
+#' Extracts objects occurrence within calls passed by `pd`.
 #' Also detects which objects depend on which within a call.
 #'
-#' @param calls_pd `list` of `data.frame`s;
-#'  result of `utils::getParseData()` split into subsets representing individual calls;
+#' @param pd `data.frame`;
+#'  one of the results of `utils::getParseData()` split into subsets representing individual calls;
 #'  created by `extract_calls()` function
 #'
 #' @return
-#' A list (of length of input `calls_pd`) where each element represents one call.
-#' Each element is a character vector listing names of objects that depend on this call
+#' A character vector listing names of objects that depend on this call
 #' and names of objects that this call depends on.
 #' Dependencies are listed after the `"<-"` string, e.g. `c("a", "<-", "b", "c")` means that in this call object `a`
 #' depends on objects `b` and `c`.
@@ -235,7 +192,7 @@ code_graph <- function(calls_pd) {
 #'
 #' @keywords internal
 #' @noRd
-extract_occurrence <- function(calls_pd) {
+extract_occurrence <- function(pd) {
   is_in_function <- function(x) {
     # If an object is a function parameter,
     # then in calls_pd there is a `SYMBOL_FORMALS` entry for that object.
@@ -253,23 +210,21 @@ extract_occurrence <- function(calls_pd) {
       x$text[x$token == "SYMBOL" & x$id > id_start & x$id < id_end]
     }
   }
-  lapply(
-    calls_pd,
-    function(call_pd) {
+
       # Handle data(object)/data("object")/data(object, envir = ) independently.
-      data_call <- find_call(call_pd, "data")
+      data_call <- find_call(pd, "data")
       if (data_call) {
-        sym <- call_pd[data_call + 1, "text"]
+        sym <- pd[data_call + 1, "text"]
         return(c(gsub("^['\"]|['\"]$", "", sym), "<-"))
       }
       # Handle assign(x = ).
-      assign_call <- find_call(call_pd, "assign")
+      assign_call <- find_call(pd, "assign")
       if (assign_call) {
         # Check if parameters were named.
         # "','" is for unnamed parameters, where "SYMBOL_SUB" is for named.
         # "EQ_SUB" is for `=` appearing after the name of the named parameter.
-        if (any(call_pd$token == "SYMBOL_SUB")) {
-          params <- call_pd[call_pd$token %in% c("SYMBOL_SUB", "','", "EQ_SUB"), "text"]
+        if (any(pd$token == "SYMBOL_SUB")) {
+          params <- pd[pd$token %in% c("SYMBOL_SUB", "','", "EQ_SUB"), "text"]
           # Remove sequence of "=", ",".
           if (length(params > 1)) {
             remove <- integer(0)
@@ -294,12 +249,12 @@ extract_occurrence <- function(calls_pd) {
           # Object is the first entry after 'assign'.
           pos <- 1
         }
-        sym <- call_pd[assign_call + pos, "text"]
+        sym <- pd[assign_call + pos, "text"]
         return(c(gsub("^['\"]|['\"]$", "", sym), "<-"))
       }
 
       # What occurs in a function body is not tracked.
-      x <- call_pd[!is_in_function(call_pd), ]
+      x <- pd[!is_in_function(pd), ]
       sym_cond <- which(x$token %in% c("SPECIAL", "SYMBOL", "SYMBOL_FUNCTION_CALL"))
 
       if (length(sym_cond) == 0) {
@@ -327,7 +282,7 @@ extract_occurrence <- function(calls_pd) {
 
       after <- match(min(x$id[ass_cond]), sort(x$id[c(min(ass_cond), sym_cond)])) - 1
       ans <- append(x[sym_cond, "text"], "<-", after = max(1, after))
-      roll <- in_parenthesis(call_pd)
+      roll <- in_parenthesis(pd)
       if (length(roll)) {
         c(setdiff(ans, roll), roll)
       } else {
@@ -336,8 +291,6 @@ extract_occurrence <- function(calls_pd) {
 
       ### NOTE 2: What if there are 2 assignments: e.g. a <- b -> c.
       ### NOTE 1: For cases like 'eval(expression(b <- b + 2))' removes 'eval(expression('.
-    }
-  )
 }
 
 #' Extract side effects
@@ -350,24 +303,32 @@ extract_occurrence <- function(calls_pd) {
 #' With this tag a complete object dependency structure can be established.
 #' Read more about side effects and the usage of `@linksto` tag in [`get_code_dependencies()`] function.
 #'
-#' @param calls_pd `list` of `data.frame`s;
-#'  result of `utils::getParseData()` split into subsets representing individual calls;
+#' @param pd `data.frame`;
+#'  one of the results of `utils::getParseData()` split into subsets representing individual calls;
 #'  created by `extract_calls()` function
 #'
 #' @return
-#' A list of length equal to that of `calls_pd`, where each element is a character vector of names of objects
-#' depending a call tagged with `@linksto` in a corresponding element of `calls_pd`.
+#' A character vector of names of objects
+#' depending a call tagged with `@linksto` in a corresponding element of `pd`.
 #'
 #' @keywords internal
 #' @noRd
-extract_side_effects <- function(calls_pd) {
-  lapply(
-    calls_pd,
-    function(x) {
-      linksto <- grep("@linksto", x[x$token == "COMMENT", "text"], value = TRUE)
-      unlist(strsplit(sub("\\s*#\\s*@linksto\\s+", "", linksto), "\\s+"))
-    }
-  )
+extract_side_effects <- function(pd) {
+  linksto <- grep("@linksto", pd[pd$token == "COMMENT", "text"], value = TRUE)
+  unlist(strsplit(sub("\\s*#\\s*@linksto\\s+", "", linksto), "\\s+"))
+}
+
+#' @param parsed_code results of `parse(text = code, keep.source = TRUE` (parsed text)
+#' @keywords internal
+#' @noRd
+extract_dependency <- function(parsed_code) {
+  pd <- normalize_pd(utils::getParseData(parsed_code))
+  reordered_pd <- extract_calls(pd)[[1]]
+  # extract_calls is needed to reorder the pd so that assignment operator comes before symbol names
+  # extract_calls is needed also to substitute assignment operators into specific format with fix_arrows
+  # extract_calls is needed to omit empty calls that contain only one token `"';'"`
+  # This cleaning is needed as extract_occurrence assumes arrows are fixed, and order is different than in original pd.
+  c(extract_side_effects(reordered_pd), extract_occurrence(reordered_pd))
 }
 
 # graph_parser ----
@@ -414,30 +375,32 @@ graph_parser <- function(x, graph) {
 #'
 #' Detects `library()` and `require()` function calls.
 #'
-#' @param calls_pd `list` of `data.frame`s;
-#'  result of `utils::getParseData()` split into subsets representing individual calls;
-#'  created by `extract_calls()` function
+#' @param `graph` the dependency graph, result of `lapply(code, attr, "dependency")`
 #'
 #' @return
-#' Integer vector of indices that can be applied to `graph` (result of `code_graph()`) to obtain all calls containing
+#' Integer vector of indices that can be applied to `graph` to obtain all calls containing
 #' `library()` or `require()` calls that are always returned for reproducibility.
 #'
 #' @keywords internal
 #' @noRd
-detect_libraries <- function(calls_pd) {
+detect_libraries <- function(graph) {
   defaults <- c("library", "require")
 
   which(
-    vapply(
-      calls_pd,
-      function(call) {
-        any(call$token == "SYMBOL_FUNCTION_CALL" & call$text %in% defaults)
-      },
-      logical(1)
+    unlist(
+      lapply(
+        graph, function(x){
+          any(grepl(pattern = paste(defaults, collapse = "|"), x = x))
+        }
+      )
     )
   )
 }
 
+
+# utils -----------------------------------------------------------------------------------------------------------
+
+
 #' Normalize parsed data removing backticks from symbols
 #'
 #' @param pd `data.frame` resulting from `utils::getParseData()` call.
@@ -454,6 +417,10 @@ normalize_pd <- function(pd) {
   pd
 }
 
+
+# split_code ------------------------------------------------------------------------------------------------------
+
+
 #' Get line/column in the source where the calls end
 #'
 #'
@@ -511,3 +478,4 @@ split_code <- function(code) {
   #  semicolon is treated by R parser as a separate call.
   gsub("^([[:space:]])*;(.+)$", "\\1\\2", new_code, perl = TRUE)
 }
+
diff --git a/man/qenv-class.Rd b/man/qenv-class.Rd
index cbc49fb5..38125193 100644
--- a/man/qenv-class.Rd
+++ b/man/qenv-class.Rd
@@ -22,9 +22,11 @@ of the \code{code} slot.}
 
 Each code element is a character representing one call. Each element has possible attributes:
 \itemize{
-\item warnings (\code{character}) the warnings output when evaluating the code element
-\item messages (\code{character}) the messages output when evaluating the code element
-\item id (\code{integer}) random identifier of the code element to make sure uniqueness when joining.
+\item \code{warnings} (\code{character}) the warnings output when evaluating the code element
+\item \code{messages} (\code{character}) the messages output when evaluating the code element
+\item \verb{id (}integer`) random identifier of the code element to make sure uniqueness when joining
+\item \code{dependency} (\code{character}) names of objects that appear in this call and gets affected by this call,
+separated by \verb{<-} (objects on LHS of \verb{<-} are affected by this line, and objects on RHS are affecting this line)
 }
 }
 
diff --git a/tests/testthat/test-qenv_eval_code.R b/tests/testthat/test-qenv_eval_code.R
index 798b6cf6..febb7280 100644
--- a/tests/testthat/test-qenv_eval_code.R
+++ b/tests/testthat/test-qenv_eval_code.R
@@ -133,3 +133,30 @@ testthat::test_that(
   testthat::expect_null(attr(q@code, "message"))
   testthat::expect_null(attr(q@code, "warning"))
 })
+
+testthat::test_that("eval_code returns a qenv object with dependency attribute", {
+  q <- eval_code(qenv(), "iris_data <- head(iris)")
+  testthat::expect_identical(get_code_attr(q, "dependency"), c("iris_data", "<-", "head", "iris"))
+})
+testthat::test_that("eval_code returns a qenv object with dependency attribute that contains linksto information", {
+  q2 <- eval_code(qenv(), c("x <- 5", "iris_data <- head(iris)", "nrow(iris_data) #@linksto x"))
+  testthat::expect_identical(
+    lapply(q2@code, attr, "dependency"),
+    list(
+      c("x", "<-"),
+      c("iris_data", "<-", "head", "iris"),
+      c("x", "<-", "nrow", "iris_data")
+    )
+  )
+})
+testthat::test_that(
+  "eval_code returns a qenv object with dependency attribute that extracts functions after '<-' part", {
+  q3 <- eval_code(qenv(), c("library(survival)", "head(iris)"))
+  testthat::expect_identical(
+    lapply(q3@code, attr, "dependency"),
+    list(
+      c("<-", "library", "survival"),
+      c("<-", "head", "iris")
+    )
+  )
+})
diff --git a/tests/testthat/test-qenv_get_code.R b/tests/testthat/test-qenv_get_code.R
index 5c417c3b..5944fac7 100644
--- a/tests/testthat/test-qenv_get_code.R
+++ b/tests/testthat/test-qenv_get_code.R
@@ -688,7 +688,7 @@ testthat::test_that("detects cooccurrence properly even if all objects are on lh
 # @ ---------------------------------------------------------------------------------------------------------------
 
 testthat::test_that("understands @ usage and do not treat rhs of @ as objects (only lhs)", {
-  code <- list(
+  code <- c(
     "setClass('aclass', slots = c(a = 'numeric', x = 'numeric', y = 'numeric')) # @linksto a x",
     "x <- new('aclass', a = 1:3, x = 1:3, y = 1:3)",
     "a <- new('aclass', a = 1:3, x = 1:3, y = 1:3)",
@@ -697,14 +697,14 @@ testthat::test_that("understands @ usage and do not treat rhs of @ as objects (o
     "a@x <- x@a"
   )
   q <- qenv()
-  q@code <- code # we don't use eval_code so the code is not run
+  q <- eval_code(q, code)
   testthat::expect_identical(
     get_code_g(q, names = "x"),
-    unlist(code[1:2])
+    code[1:2]
   )
   testthat::expect_identical(
     get_code_g(q, names = "a"),
-    unlist(code)
+    code
   )
 })
 
@@ -886,3 +886,12 @@ testthat::describe("Backticked symbol", {
     )
   })
 })
+
+
+# missing objects -------------------------------------------------------------------------------------------------
+
+testthat::test_that("get_code raises warning for missing names", {
+  q <- eval_code(qenv(), code = c("a<-1;b<-2"))
+  testthat::expect_null(get_code(q, names = 'c'))
+  testthat::expect_warning(get_code(q, names = 'c'), " not found in code: c")
+})

From 4c7fa7a0b9c344d0cffdcefc5606d6feb32a7293 Mon Sep 17 00:00:00 2001
From: github-actions <41898282+github-actions[bot]@users.noreply.github.com>
Date: Wed, 6 Nov 2024 13:14:00 +0000
Subject: [PATCH 62/98] [skip style] [skip vbump] Restyle files

---
 R/utils-get_code_dependency.R        | 145 +++++++++++++--------------
 tests/testthat/test-qenv_eval_code.R |  94 +++++++++--------
 tests/testthat/test-qenv_extract.R   |   2 -
 tests/testthat/test-qenv_get_code.R  |  20 ++--
 4 files changed, 136 insertions(+), 125 deletions(-)

diff --git a/R/utils-get_code_dependency.R b/R/utils-get_code_dependency.R
index c9e0024a..856f20db 100644
--- a/R/utils-get_code_dependency.R
+++ b/R/utils-get_code_dependency.R
@@ -211,86 +211,86 @@ extract_occurrence <- function(pd) {
     }
   }
 
-      # Handle data(object)/data("object")/data(object, envir = ) independently.
-      data_call <- find_call(pd, "data")
-      if (data_call) {
-        sym <- pd[data_call + 1, "text"]
-        return(c(gsub("^['\"]|['\"]$", "", sym), "<-"))
-      }
-      # Handle assign(x = ).
-      assign_call <- find_call(pd, "assign")
-      if (assign_call) {
-        # Check if parameters were named.
-        # "','" is for unnamed parameters, where "SYMBOL_SUB" is for named.
-        # "EQ_SUB" is for `=` appearing after the name of the named parameter.
-        if (any(pd$token == "SYMBOL_SUB")) {
-          params <- pd[pd$token %in% c("SYMBOL_SUB", "','", "EQ_SUB"), "text"]
-          # Remove sequence of "=", ",".
-          if (length(params > 1)) {
-            remove <- integer(0)
-            for (i in 2:length(params)) {
-              if (params[i - 1] == "=" & params[i] == ",") {
-                remove <- c(remove, i - 1, i)
-              }
-            }
-            if (length(remove)) params <- params[-remove]
-          }
-          pos <- match("x", setdiff(params, ","), nomatch = match(",", params, nomatch = 0))
-          if (!pos) {
-            return(character(0L))
+  # Handle data(object)/data("object")/data(object, envir = ) independently.
+  data_call <- find_call(pd, "data")
+  if (data_call) {
+    sym <- pd[data_call + 1, "text"]
+    return(c(gsub("^['\"]|['\"]$", "", sym), "<-"))
+  }
+  # Handle assign(x = ).
+  assign_call <- find_call(pd, "assign")
+  if (assign_call) {
+    # Check if parameters were named.
+    # "','" is for unnamed parameters, where "SYMBOL_SUB" is for named.
+    # "EQ_SUB" is for `=` appearing after the name of the named parameter.
+    if (any(pd$token == "SYMBOL_SUB")) {
+      params <- pd[pd$token %in% c("SYMBOL_SUB", "','", "EQ_SUB"), "text"]
+      # Remove sequence of "=", ",".
+      if (length(params > 1)) {
+        remove <- integer(0)
+        for (i in 2:length(params)) {
+          if (params[i - 1] == "=" & params[i] == ",") {
+            remove <- c(remove, i - 1, i)
           }
-          # pos is indicator of the place of 'x'
-          # 1. All parameters are named, but none is 'x' - return(character(0L))
-          # 2. Some parameters are named, 'x' is in named parameters: match("x", setdiff(params, ","))
-          # - check "x" in params being just a vector of named parameters.
-          # 3. Some parameters are named, 'x' is not in named parameters
-          # - check first appearance of "," (unnamed parameter) in vector parameters.
-        } else {
-          # Object is the first entry after 'assign'.
-          pos <- 1
         }
-        sym <- pd[assign_call + pos, "text"]
-        return(c(gsub("^['\"]|['\"]$", "", sym), "<-"))
+        if (length(remove)) params <- params[-remove]
       }
-
-      # What occurs in a function body is not tracked.
-      x <- pd[!is_in_function(pd), ]
-      sym_cond <- which(x$token %in% c("SPECIAL", "SYMBOL", "SYMBOL_FUNCTION_CALL"))
-
-      if (length(sym_cond) == 0) {
+      pos <- match("x", setdiff(params, ","), nomatch = match(",", params, nomatch = 0))
+      if (!pos) {
         return(character(0L))
       }
-      # Watch out for SYMBOLS after $ and @. For x$a x@a: x is object, a is not.
-      # For x$a, a's ID is $'s ID-2 so we need to remove all IDs that have ID = $ID - 2.
-      dollar_ids <- x[x$token %in% c("'$'", "'@'"), "id"]
-      if (length(dollar_ids)) {
-        object_ids <- x[sym_cond, "id"]
-        after_dollar <- object_ids[(object_ids - 2) %in% dollar_ids]
-        sym_cond <- setdiff(sym_cond, which(x$id %in% after_dollar))
-      }
+      # pos is indicator of the place of 'x'
+      # 1. All parameters are named, but none is 'x' - return(character(0L))
+      # 2. Some parameters are named, 'x' is in named parameters: match("x", setdiff(params, ","))
+      # - check "x" in params being just a vector of named parameters.
+      # 3. Some parameters are named, 'x' is not in named parameters
+      # - check first appearance of "," (unnamed parameter) in vector parameters.
+    } else {
+      # Object is the first entry after 'assign'.
+      pos <- 1
+    }
+    sym <- pd[assign_call + pos, "text"]
+    return(c(gsub("^['\"]|['\"]$", "", sym), "<-"))
+  }
 
-      ass_cond <- grep("ASSIGN", x$token)
-      if (!length(ass_cond)) {
-        return(c("<-", unique(x[sym_cond, "text"])))
-      }
+  # What occurs in a function body is not tracked.
+  x <- pd[!is_in_function(pd), ]
+  sym_cond <- which(x$token %in% c("SPECIAL", "SYMBOL", "SYMBOL_FUNCTION_CALL"))
 
-      sym_cond <- sym_cond[sym_cond > ass_cond] # NOTE 1
-      # If there was an assignment operation detect direction of it.
-      if (unique(x$text[ass_cond]) == "->") { # NOTE 2
-        sym_cond <- rev(sym_cond)
-      }
+  if (length(sym_cond) == 0) {
+    return(character(0L))
+  }
+  # Watch out for SYMBOLS after $ and @. For x$a x@a: x is object, a is not.
+  # For x$a, a's ID is $'s ID-2 so we need to remove all IDs that have ID = $ID - 2.
+  dollar_ids <- x[x$token %in% c("'$'", "'@'"), "id"]
+  if (length(dollar_ids)) {
+    object_ids <- x[sym_cond, "id"]
+    after_dollar <- object_ids[(object_ids - 2) %in% dollar_ids]
+    sym_cond <- setdiff(sym_cond, which(x$id %in% after_dollar))
+  }
 
-      after <- match(min(x$id[ass_cond]), sort(x$id[c(min(ass_cond), sym_cond)])) - 1
-      ans <- append(x[sym_cond, "text"], "<-", after = max(1, after))
-      roll <- in_parenthesis(pd)
-      if (length(roll)) {
-        c(setdiff(ans, roll), roll)
-      } else {
-        ans
-      }
+  ass_cond <- grep("ASSIGN", x$token)
+  if (!length(ass_cond)) {
+    return(c("<-", unique(x[sym_cond, "text"])))
+  }
+
+  sym_cond <- sym_cond[sym_cond > ass_cond] # NOTE 1
+  # If there was an assignment operation detect direction of it.
+  if (unique(x$text[ass_cond]) == "->") { # NOTE 2
+    sym_cond <- rev(sym_cond)
+  }
 
-      ### NOTE 2: What if there are 2 assignments: e.g. a <- b -> c.
-      ### NOTE 1: For cases like 'eval(expression(b <- b + 2))' removes 'eval(expression('.
+  after <- match(min(x$id[ass_cond]), sort(x$id[c(min(ass_cond), sym_cond)])) - 1
+  ans <- append(x[sym_cond, "text"], "<-", after = max(1, after))
+  roll <- in_parenthesis(pd)
+  if (length(roll)) {
+    c(setdiff(ans, roll), roll)
+  } else {
+    ans
+  }
+
+  ### NOTE 2: What if there are 2 assignments: e.g. a <- b -> c.
+  ### NOTE 1: For cases like 'eval(expression(b <- b + 2))' removes 'eval(expression('.
 }
 
 #' Extract side effects
@@ -389,7 +389,7 @@ detect_libraries <- function(graph) {
   which(
     unlist(
       lapply(
-        graph, function(x){
+        graph, function(x) {
           any(grepl(pattern = paste(defaults, collapse = "|"), x = x))
         }
       )
@@ -478,4 +478,3 @@ split_code <- function(code) {
   #  semicolon is treated by R parser as a separate call.
   gsub("^([[:space:]])*;(.+)$", "\\1\\2", new_code, perl = TRUE)
 }
-
diff --git a/tests/testthat/test-qenv_eval_code.R b/tests/testthat/test-qenv_eval_code.R
index febb7280..e86d29f4 100644
--- a/tests/testthat/test-qenv_eval_code.R
+++ b/tests/testthat/test-qenv_eval_code.R
@@ -92,47 +92,55 @@ testthat::test_that("an error when calling eval_code returns a qenv.error object
 })
 
 testthat::test_that(
-  "a warning when calling eval_code returns a qenv object which has warnings as attributes of code", {
-  q <- eval_code(qenv(), quote("iris_data <- iris"))
-  q <- eval_code(q, quote("p <- hist(iris_data[, 'Sepal.Length'], ff = '')"))
-  testthat::expect_s4_class(q, "qenv")
-  testthat::expect_equal(
-    lapply(q@code, attr, "warning"),
-    list(NULL, "> \"ff\" is not a graphical parameter\n")
-  )
-})
+  "a warning when calling eval_code returns a qenv object which has warnings as attributes of code",
+  {
+    q <- eval_code(qenv(), quote("iris_data <- iris"))
+    q <- eval_code(q, quote("p <- hist(iris_data[, 'Sepal.Length'], ff = '')"))
+    testthat::expect_s4_class(q, "qenv")
+    testthat::expect_equal(
+      lapply(q@code, attr, "warning"),
+      list(NULL, "> \"ff\" is not a graphical parameter\n")
+    )
+  }
+)
 
 testthat::test_that(
-  "eval_code associates warnings with call by adding attribute to code element", {
-  q <- eval_code(qenv(), c("x <- 1", "y <- 1", "warning('warn1')"))
-  testthat::expect_equal(
-    lapply(q@code, attr, "warning"),
-    list(NULL, NULL, "> warn1\n")
-  )
-})
+  "eval_code associates warnings with call by adding attribute to code element",
+  {
+    q <- eval_code(qenv(), c("x <- 1", "y <- 1", "warning('warn1')"))
+    testthat::expect_equal(
+      lapply(q@code, attr, "warning"),
+      list(NULL, NULL, "> warn1\n")
+    )
+  }
+)
 
 
 testthat::test_that(
-  "eval_code associates messages with call by adding attribute to code element", {
-  q <- eval_code(qenv(), quote("iris_data <- head(iris)"))
-  q <- eval_code(q, quote("message('This is a message')"))
-  testthat::expect_s4_class(q, "qenv")
-  testthat::expect_equal(
-    lapply(q@code, attr, "message"),
-    list(
-      NULL,
-      "> This is a message\n"
+  "eval_code associates messages with call by adding attribute to code element",
+  {
+    q <- eval_code(qenv(), quote("iris_data <- head(iris)"))
+    q <- eval_code(q, quote("message('This is a message')"))
+    testthat::expect_s4_class(q, "qenv")
+    testthat::expect_equal(
+      lapply(q@code, attr, "message"),
+      list(
+        NULL,
+        "> This is a message\n"
+      )
     )
-  )
-})
+  }
+)
 
 testthat::test_that(
-  "eval_code returns a qenv object with empty messages and warnings as code attributes, when none are returned", {
-  q <- eval_code(qenv(), quote("iris_data <- head(iris)"))
-  testthat::expect_s4_class(q, "qenv")
-  testthat::expect_null(attr(q@code, "message"))
-  testthat::expect_null(attr(q@code, "warning"))
-})
+  "eval_code returns a qenv object with empty messages and warnings as code attributes, when none are returned",
+  {
+    q <- eval_code(qenv(), quote("iris_data <- head(iris)"))
+    testthat::expect_s4_class(q, "qenv")
+    testthat::expect_null(attr(q@code, "message"))
+    testthat::expect_null(attr(q@code, "warning"))
+  }
+)
 
 testthat::test_that("eval_code returns a qenv object with dependency attribute", {
   q <- eval_code(qenv(), "iris_data <- head(iris)")
@@ -150,13 +158,15 @@ testthat::test_that("eval_code returns a qenv object with dependency attribute t
   )
 })
 testthat::test_that(
-  "eval_code returns a qenv object with dependency attribute that extracts functions after '<-' part", {
-  q3 <- eval_code(qenv(), c("library(survival)", "head(iris)"))
-  testthat::expect_identical(
-    lapply(q3@code, attr, "dependency"),
-    list(
-      c("<-", "library", "survival"),
-      c("<-", "head", "iris")
+  "eval_code returns a qenv object with dependency attribute that extracts functions after '<-' part",
+  {
+    q3 <- eval_code(qenv(), c("library(survival)", "head(iris)"))
+    testthat::expect_identical(
+      lapply(q3@code, attr, "dependency"),
+      list(
+        c("<-", "library", "survival"),
+        c("<-", "head", "iris")
+      )
     )
-  )
-})
+  }
+)
diff --git a/tests/testthat/test-qenv_extract.R b/tests/testthat/test-qenv_extract.R
index 825463b9..8e01a1b0 100644
--- a/tests/testthat/test-qenv_extract.R
+++ b/tests/testthat/test-qenv_extract.R
@@ -1,4 +1,3 @@
-
 testthat::test_that("`[.` returns empty qenv for names not in qenv", {
   data <- within(qenv(), {
     x <- 1
@@ -65,4 +64,3 @@ testthat::test_that("`[.` extract proper elements of @id, @warnings and @message
   testthat::expect_null(get_code_attr(qs, "warning"))
   testthat::expect_null(get_code_attr(qs, "message"))
 })
-
diff --git a/tests/testthat/test-qenv_get_code.R b/tests/testthat/test-qenv_get_code.R
index 5944fac7..95675321 100644
--- a/tests/testthat/test-qenv_get_code.R
+++ b/tests/testthat/test-qenv_get_code.R
@@ -1,4 +1,4 @@
-get_code_g <- function(qenv, ...){
+get_code_g <- function(qenv, ...) {
   gsub("\n", "", get_code(qenv, ...), fixed = TRUE)
 }
 
@@ -393,7 +393,7 @@ testthat::test_that("get_code does not break if @linksto is put in the last line
 
 testthat::test_that("@linksto makes a line being returned for an affected binding", {
   code <-
-  "a <- 1 # @linksto b
+    "a <- 1 # @linksto b
   b <- 2"
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
@@ -475,7 +475,8 @@ testthat::test_that("comments fall into proper calls", {
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
     get_code(q),
-    c("\n    # initial comment\n    a <- 1\n",
+    c(
+      "\n    # initial comment\n    a <- 1\n",
       "    b <- 2 # inline comment\n",
       "    c <- 3\n",
       "    # inbetween comment\n    d <- 4\n    # finishing comment\n  "
@@ -500,7 +501,8 @@ testthat::test_that("comments get pasted when they fall into calls", {
   q <- qenv() |> eval_code(code)
   testthat::expect_identical(
     get_code(q),
-    c("\n    # initial comment\n    a <- 1 # A comment\n",
+    c(
+      "\n    # initial comment\n    a <- 1 # A comment\n",
       "    b <- 2 # inline comment\n",
       "    c <- 3 # C comment\n",
       "    # inbetween comment\n    d <- 4\n    # finishing comment\n  "
@@ -646,8 +648,10 @@ testthat::test_that("detects occurrence of a function definition with a @linksto
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
     get_code(q, names = "x"),
-    c("\n        foo <- function() {\n          env <- parent.frame()\n          env$x <- 0\n        }\n",
-      "foo() # @linksto x\n")
+    c(
+      "\n        foo <- function() {\n          env <- parent.frame()\n          env$x <- 0\n        }\n",
+      "foo() # @linksto x\n"
+    )
   )
 })
 # $ ---------------------------------------------------------------------------------------------------------------
@@ -892,6 +896,6 @@ testthat::describe("Backticked symbol", {
 
 testthat::test_that("get_code raises warning for missing names", {
   q <- eval_code(qenv(), code = c("a<-1;b<-2"))
-  testthat::expect_null(get_code(q, names = 'c'))
-  testthat::expect_warning(get_code(q, names = 'c'), " not found in code: c")
+  testthat::expect_null(get_code(q, names = "c"))
+  testthat::expect_warning(get_code(q, names = "c"), " not found in code: c")
 })

From 7bd1c2d376e76427dab232585c06938d8e266095 Mon Sep 17 00:00:00 2001
From: m7pr <marcin.kosinski.mk1@roche.com>
Date: Thu, 7 Nov 2024 12:43:52 +0100
Subject: [PATCH 63/98] simplify get_warnings

---
 R/qenv-get_warnings.R | 8 +++++---
 1 file changed, 5 insertions(+), 3 deletions(-)

diff --git a/R/qenv-get_warnings.R b/R/qenv-get_warnings.R
index b5d3c582..ea2c0e89 100644
--- a/R/qenv-get_warnings.R
+++ b/R/qenv-get_warnings.R
@@ -34,7 +34,9 @@ setGeneric("get_warnings", function(object) {
 
 setMethod("get_warnings", signature = c("qenv"), function(object) {
   warnings <- lapply(object@code, "attr", "warning")
-  code <- object@code[unlist(lapply(warnings, Negate(is.null)))]
+  idx_warn <- which(sapply(warnings, Negate(is.null)))
+  warnings <- warnings[idx_warn]
+  code <- object@code[idx_warn]
   if (length(unlist(warnings)) == 0) {
     return(NULL)
   }
@@ -46,8 +48,8 @@ setMethod("get_warnings", signature = c("qenv"), function(object) {
       }
       sprintf("%swhen running code:\n%s", warn, paste(lang2calls(expr), collapse = "\n"))
     },
-    warn = as.list(unlist(warnings)),
-    expr = as.list(unlist(code))
+    warn = warnings,
+    expr = code
   )
   lines <- Filter(Negate(is.null), lines)
 

From 7fa236931185c91dccc7df526696732991280625 Mon Sep 17 00:00:00 2001
From: m7pr <marcin.kosinski.mk1@roche.com>
Date: Thu, 7 Nov 2024 13:39:47 +0100
Subject: [PATCH 64/98] revert get_code so it returns vector of length 1
 (concatened with \n)

---
 R/qenv-get_code.R                       |   2 +-
 tests/testthat/test-qenv_get_code.R     | 283 ++++++++++++------------
 tests/testthat/test-qenv_get_warnings.R |   2 +-
 tests/testthat/test-qenv_within.R       |   4 +-
 4 files changed, 148 insertions(+), 143 deletions(-)

diff --git a/R/qenv-get_code.R b/R/qenv-get_code.R
index b569cbaf..8728f56c 100644
--- a/R/qenv-get_code.R
+++ b/R/qenv-get_code.R
@@ -122,7 +122,7 @@ setMethod("get_code", signature = "qenv", function(object, deparse = TRUE, names
   }
 
   if (deparse) {
-    unlist(code)
+    gsub(";\n", ";", paste(gsub("\n$", "", unlist(code)), collapse = "\n"))
   } else {
     parse(text = paste(c("{", unlist(code), "}"), collapse = "\n"), keep.source = TRUE)
   }
diff --git a/tests/testthat/test-qenv_get_code.R b/tests/testthat/test-qenv_get_code.R
index 95675321..d62b9365 100644
--- a/tests/testthat/test-qenv_get_code.R
+++ b/tests/testthat/test-qenv_get_code.R
@@ -1,12 +1,10 @@
-get_code_g <- function(qenv, ...) {
-  gsub("\n", "", get_code(qenv, ...), fixed = TRUE)
-}
+pasten <- function(...) paste(..., collapse = "\n")
 
 testthat::test_that("get_code returns code (character by default) of qenv object", {
   q <- qenv() |>
     eval_code(quote(x <- 1)) |>
     eval_code(quote(y <- x))
-  testthat::expect_equal(get_code_g(q), c("x <- 1", "y <- x"))
+  testthat::expect_equal(get_code(q), pasten(c("x <- 1", "y <- x")))
 })
 
 testthat::test_that("get_code handles code elements being code-blocks", {
@@ -19,7 +17,7 @@ testthat::test_that("get_code handles code elements being code-blocks", {
       z <- 5
     })
   )
-  testthat::expect_equal(get_code_g(q), c("x <- 1", "y <- x", "z <- 5"))
+  testthat::expect_equal(get_code(q), pasten(c("x <- 1", "y <- x", "z <- 5")))
 })
 
 testthat::test_that("get_code returns expression of qenv object if deparse = FALSE", {
@@ -27,8 +25,8 @@ testthat::test_that("get_code returns expression of qenv object if deparse = FAL
   q <- eval_code(q, quote(x <- 1))
   q <- eval_code(q, quote(y <- x))
   testthat::expect_equivalent(
-    toString(get_code_g(q, deparse = FALSE)),
-    "{    x <- 1    y <- x}"
+    toString(get_code(q, deparse = FALSE)),
+    "{\n    x <- 1\n    y <- x\n}"
   )
 })
 
@@ -39,7 +37,7 @@ testthat::test_that("get_code called with qenv.error returns error with trace in
   q3 <- eval_code(q2, quote(w <- v))
 
   code <- tryCatch(
-    get_code_g(q3),
+    get_code(q3),
     error = function(e) e
   )
   testthat::expect_equal(class(code), c("validation", "try-error", "simpleError", "error", "condition"))
@@ -60,17 +58,19 @@ testthat::test_that("get_code returns code with comments and empty spaces", {
     # closing comment
     "
   q <- eval_code(qenv(), code)
-  testthat::expect_equal(paste0(get_code(q), collapse = ""), code)
+  testthat::expect_equal(get_code(q), code)
 })
 
 # names parameter -------------------------------------------------------------------------------------------------
 
 testthat::test_that("handles empty @code slot", {
-  testthat::expect_null(
-    get_code(qenv(), names = "a")
+  testthat::expect_equal(
+    get_code(qenv(), names = "a"),
+    ""
   )
-  testthat::expect_null(
-    get_code(eval_code(qenv(), code = ""), names = "a")
+  testthat::expect_equal(
+    get_code(eval_code(qenv(), code = ""), names = "a"),
+    ""
   )
 })
 
@@ -83,14 +83,14 @@ testthat::test_that("handles the code without symbols on rhs", {
 
   testthat::expect_identical(
     get_code(eval_code(qenv(), code), names = "a"),
-    "a <- 5\n"
+    "a <- 5"
   )
 })
 
 testthat::test_that("handles the code included in curly brackets", {
   code <- "{1 + 1;a <- 5}"
 
-  testthat::skip("# TODO: to be fixed")
+  testthat::skip("SHOULD THIS BE FIXED? it gives the whole code {1 + 1;a <- 5}")
   testthat::expect_identical(
     get_code(eval_code(qenv(), code), names = "a"),
     "a <- 5"
@@ -102,7 +102,7 @@ testthat::test_that("handles the code of length > 1 when at least one is enclose
   q <- eval_code(eval_code(qenv(), code[1]), code[2])
 
   testthat::expect_identical(
-    get_code_g(q, names = "a"),
+    get_code(q, names = "a"),
     "{a<-5}"
   )
 })
@@ -114,11 +114,11 @@ testthat::test_that("extracts the code of a binding from character vector contai
   )
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
-    get_code_g(q, names = "a"),
+    get_code(q, names = "a"),
     "a <- 1"
   )
   testthat::expect_identical(
-    get_code_g(q, names = "b"),
+    get_code(q, names = "b"),
     "b <- 2"
   )
 })
@@ -130,7 +130,7 @@ testthat::test_that("extracts the code without downstream usage", {
   )
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
-    get_code_g(q, names = "a"),
+    get_code(q, names = "a"),
     "a <- 1"
   )
 })
@@ -142,8 +142,8 @@ testthat::test_that("works for names of length > 1", {
   )
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
-    get_code_g(q, names = c("a", "b")),
-    code
+    get_code(q, names = c("a", "b")),
+    pasten(code)
   )
 })
 
@@ -151,7 +151,7 @@ testthat::test_that("warns if binding doesn't exist in code", {
   code <- c("a <- 1")
   q <- eval_code(qenv(), code)
   testthat::expect_warning(
-    get_code_g(q, names = "c"),
+    get_code(q, names = "c"),
     "Object\\(s\\) not found in code: c"
   )
 })
@@ -165,16 +165,16 @@ testthat::test_that("does not fall into a loop", {
   )
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
-    get_code_g(q, names = "a"),
-    code
+    get_code(q, names = "a"),
+    pasten(code)
   )
   testthat::expect_identical(
-    get_code_g(q, names = "b"),
-    code[1:2]
+    get_code(q, names = "b"),
+    pasten(code[1:2])
   )
   testthat::expect_identical(
-    get_code_g(q, names = "c"),
-    code[1:3]
+    get_code(q, names = "c"),
+    pasten(code[1:3])
   )
 })
 
@@ -186,8 +186,8 @@ testthat::test_that("extracts code of a parent binding but only those evaluated
   )
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
-    get_code_g(q, names = "b"),
-    c("a <- 1", "b <- a")
+    get_code(q, names = "b"),
+    pasten(c("a <- 1", "b <- a"))
   )
 })
 
@@ -199,8 +199,8 @@ testthat::test_that("extracts the code of a parent binding if used as an arg in
   )
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
-    get_code_g(q, names = "b"),
-    c("a <- 1", "b <- identity(x = a)")
+    get_code(q, names = "b"),
+    pasten(c("a <- 1", "b <- identity(x = a)"))
   )
 })
 
@@ -212,8 +212,8 @@ testthat::test_that("extracts the code when using <<-", {
   )
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
-    get_code_g(q, names = "b"),
-    c("a <- 1", "b <- a", "b <<- b + 2")
+    get_code(q, names = "b"),
+    pasten(c("a <- 1", "b <- a", "b <<- b + 2"))
   )
 })
 
@@ -225,8 +225,8 @@ testthat::test_that("detects every assign calls even if not evaluated, if there
   )
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
-    get_code_g(q, names = "b"),
-    code[2:3]
+    get_code(q, names = "b"),
+    pasten(code[2:3])
   )
 })
 
@@ -238,7 +238,7 @@ testthat::test_that("returns result of length 1 for non-empty input and deparse
     c <- list(x = 2)
   })
 
-  testthat::expect_length(get_code_g(q1, deparse = FALSE), 1)
+  testthat::expect_length(get_code(q1, deparse = FALSE), 1)
 })
 
 testthat::test_that("does not break if code is separated by ;", {
@@ -247,8 +247,8 @@ testthat::test_that("does not break if code is separated by ;", {
   )
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
-    get_code_g(q, names = "a"),
-    c("a <- 1;", "a <- a + 1")
+    get_code(q, names = "a"),
+    code
   )
 })
 
@@ -260,7 +260,7 @@ testthat::test_that("does not break if code uses quote()", {
   )
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
-    get_code_g(q, names = "x"),
+    get_code(q, names = "x"),
     code[2]
   )
 })
@@ -273,8 +273,8 @@ testthat::test_that("does not break if object is used in a function on lhs", {
   )
   q <- eval_code(qenv(), code = code)
   testthat::expect_identical(
-    get_code_g(q, names = "iris"),
-    code[c(1, 3)]
+    get_code(q, names = "iris"),
+    pasten(code[c(1, 3)])
   )
 })
 
@@ -288,8 +288,8 @@ testthat::test_that(
     )
     q <- eval_code(qenv(), code = code)
     testthat::expect_identical(
-      get_code_g(q, names = "x"),
-      code
+      get_code(q, names = "x"),
+      pasten(code)
     )
   }
 )
@@ -308,16 +308,16 @@ testthat::test_that("extracts the code for assign() where \"x\" is a literal str
   )
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
-    get_code_g(q, names = "b"),
-    code[c(2, 5)]
+    get_code(q, names = "b"),
+    pasten(code[c(2, 5)])
   )
   testthat::expect_identical(
-    get_code_g(q, names = "c"),
-    code[c(2, 3, 5, 6)]
+    get_code(q, names = "c"),
+    pasten(code[c(2, 3, 5, 6)])
   )
   testthat::expect_identical(
-    get_code_g(q, names = "d"),
-    c("assign(value = 15, x = \"d\")", "d <- d * 2")
+    get_code(q, names = "d"),
+    pasten(c("assign(value = 15, x = \"d\")", "d <- d * 2"))
   )
 })
 
@@ -330,8 +330,8 @@ testthat::test_that("extracts the code for assign() where \"x\" is variable", {
   )
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
-    get_code_g(q, names = "b"),
-    code
+    get_code(q, names = "b"),
+    pasten(code)
   )
 })
 
@@ -347,8 +347,8 @@ testthat::test_that("works for assign() detection no matter how many parametrers
   q <- eval_code(qenv(), code)
 
   testthat::expect_identical(
-    get_code_g(q, names = "y"),
-    code
+    get_code(q, names = "y"),
+    pasten(code)
   )
 })
 
@@ -363,12 +363,12 @@ testthat::test_that("detects function usage of the assignment operator", {
   q2 <- eval_code(qenv(), code2)
 
   testthat::expect_identical(
-    get_code_g(q, names = "y"),
-    code
+    get_code(q, names = "y"),
+    pasten(code)
   )
   testthat::expect_identical(
-    get_code_g(q2, names = "y"),
-    code2
+    get_code(q2, names = "y"),
+    pasten(code2)
   )
 })
 
@@ -386,8 +386,8 @@ testthat::test_that("get_code does not break if @linksto is put in the last line
   )
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
-    get_code_g(q, names = "x"),
-    code
+    get_code(q, names = "x"),
+    pasten(code)
   )
 })
 
@@ -397,8 +397,8 @@ testthat::test_that("@linksto makes a line being returned for an affected bindin
   b <- 2"
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
-    get_code_g(q, names = "b"),
-    c("a <- 1 # @linksto b", "  b <- 2")
+    get_code(q, names = "b"),
+    pasten(c("a <- 1 # @linksto b", "  b <- 2"))
   )
 })
 
@@ -412,8 +412,8 @@ testthat::test_that(
     )
     q <- eval_code(qenv(), code)
     testthat::expect_identical(
-      get_code_g(q, names = "b"),
-      code
+      get_code(q, names = "b"),
+      pasten(code)
     )
   }
 )
@@ -429,12 +429,12 @@ testthat::test_that(
     )
     q <- eval_code(qenv(), code)
     testthat::expect_identical(
-      get_code_g(q, names = "a"),
-      code[1:3]
+      get_code(q, names = "a"),
+      pasten(code[1:3])
     )
     testthat::expect_identical(
-      get_code_g(q, names = "b"),
-      code[c(2, 4)]
+      get_code(q, names = "b"),
+      pasten(code[c(2, 4)])
     )
   }
 )
@@ -450,8 +450,8 @@ testthat::test_that(
     )
     q <- eval_code(qenv(), code)
     testthat::expect_identical(
-      get_code_g(q, names = "classes"),
-      code
+      get_code(q, names = "classes"),
+      pasten(code)
     )
   }
 )
@@ -475,12 +475,7 @@ testthat::test_that("comments fall into proper calls", {
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
     get_code(q),
-    c(
-      "\n    # initial comment\n    a <- 1\n",
-      "    b <- 2 # inline comment\n",
-      "    c <- 3\n",
-      "    # inbetween comment\n    d <- 4\n    # finishing comment\n  "
-    )
+    code
   )
 })
 
@@ -501,12 +496,7 @@ testthat::test_that("comments get pasted when they fall into calls", {
   q <- qenv() |> eval_code(code)
   testthat::expect_identical(
     get_code(q),
-    c(
-      "\n    # initial comment\n    a <- 1 # A comment\n",
-      "    b <- 2 # inline comment\n",
-      "    c <- 3 # C comment\n",
-      "    # inbetween comment\n    d <- 4\n    # finishing comment\n  "
-    )
+    code
   )
 })
 
@@ -519,11 +509,11 @@ testthat::test_that("ignores occurrence in a function definition", {
   )
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
-    get_code_g(q, names = "b"),
-    "b <- 2"
+    get_code(q, names = "b"),
+    code[1]
   )
   testthat::expect_identical(
-    get_code_g(q, names = "foo"),
+    get_code(q, names = "foo"),
     code[2]
   )
 })
@@ -535,11 +525,11 @@ testthat::test_that("ignores occurrence in a function definition that has functi
   )
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
-    get_code_g(q, names = "b"),
+    get_code(q, names = "b"),
     code[1]
   )
   testthat::expect_identical(
-    get_code_g(q, names = "foo"),
+    get_code(q, names = "foo"),
     code[2]
   )
 })
@@ -553,11 +543,11 @@ testthat::test_that("ignores occurrence in a function definition if there is mul
   )
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
-    get_code_g(q, names = "b"),
-    code[c(1, 3)]
+    get_code(q, names = "b"),
+    pasten(code[c(1, 3)])
   )
   testthat::expect_identical(
-    get_code_g(q, names = "foo"),
+    get_code(q, names = "foo"),
     code[2]
   )
 })
@@ -572,7 +562,7 @@ testthat::test_that("ignores occurrence in a function definition in lapply", {
   )
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
-    get_code_g(q, names = "x"),
+    get_code(q, names = "x"),
     "x <- 1"
   )
 })
@@ -587,7 +577,7 @@ testthat::test_that("does not ignore occurrence in function body if object exsit
   )
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
-    get_code_g(q, names = "b"),
+    get_code(q, names = "b"),
     code
   )
 })
@@ -599,12 +589,12 @@ testthat::test_that("ignores occurrence in function definition without { curly b
   )
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
-    get_code_g(q, names = "foo"),
-    "foo <- function(b) b <- b + 2"
+    get_code(q, names = "foo"),
+    code[2]
   )
   testthat::expect_identical(
-    get_code_g(q, names = "b"),
-    "b <- 2"
+    get_code(q, names = "b"),
+    code[1]
   )
 })
 
@@ -617,8 +607,8 @@ testthat::test_that("detects occurrence of the function object", {
   )
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
-    get_code_g(q, names = "b"),
-    code
+    get_code(q, names = "b"),
+    pasten(code)
   )
 })
 
@@ -630,8 +620,8 @@ testthat::test_that("detects occurrence of a function definition when a formal i
   )
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
-    get_code_g(q, names = "a"),
-    code
+    get_code(q, names = "a"),
+    pasten(code)
   )
 })
 
@@ -648,10 +638,7 @@ testthat::test_that("detects occurrence of a function definition with a @linksto
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
     get_code(q, names = "x"),
-    c(
-      "\n        foo <- function() {\n          env <- parent.frame()\n          env$x <- 0\n        }\n",
-      "foo() # @linksto x\n"
-    )
+    pasten(code[1:2])
   )
 })
 # $ ---------------------------------------------------------------------------------------------------------------
@@ -666,12 +653,12 @@ testthat::test_that("understands $ usage and do not treat rhs of $ as objects (o
   )
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
-    get_code_g(q, names = "x"),
-    "x <- data.frame(a = 1:3)"
+    get_code(q, names = "x"),
+    code[1]
   )
   testthat::expect_identical(
-    get_code_g(q, names = "a"),
-    code
+    get_code(q, names = "a"),
+    pasten(code)
   )
 })
 
@@ -683,8 +670,8 @@ testthat::test_that("detects cooccurrence properly even if all objects are on lh
   )
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
-    get_code_g(q, names = "b"),
-    code
+    get_code(q, names = "b"),
+    pasten(code)
   )
 })
 
@@ -703,12 +690,12 @@ testthat::test_that("understands @ usage and do not treat rhs of @ as objects (o
   q <- qenv()
   q <- eval_code(q, code)
   testthat::expect_identical(
-    get_code_g(q, names = "x"),
-    code[1:2]
+    get_code(q, names = "x"),
+    pasten(code[1:2])
   )
   testthat::expect_identical(
-    get_code_g(q, names = "a"),
-    code
+    get_code(q, names = "a"),
+    pasten(code)
   )
 })
 
@@ -726,8 +713,8 @@ testthat::test_that("library() and require() are always returned", {
   )
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
-    get_code_g(q, names = "x"),
-    code[c(2, 3, 4)]
+    get_code(q, names = "x"),
+    pasten(code[c(2, 3, 4)])
   )
 })
 
@@ -744,8 +731,8 @@ testthat::test_that("data() call is returned when data name is provided as is",
   )
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
-    get_code_g(q, names = "x"),
-    code[-1]
+    get_code(q, names = "x"),
+    pasten(code[-1])
   )
 })
 
@@ -759,13 +746,14 @@ testthat::test_that("data() call is returned when data name is provided as a cha
   )
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
-    get_code_g(q, names = "z"),
-    code[-1]
+    get_code(q, names = "z"),
+    pasten(code[-1])
   )
 })
 
 
 testthat::describe("Backticked symbol", {
+
   testthat::it("code can be retrieved with get_code", {
     td <- within(
       qenv(),
@@ -777,7 +765,7 @@ testthat::describe("Backticked symbol", {
 
     testthat::expect_identical(
       get_code(td, names = "%cbind%"),
-      "`%cbind%` <- function(lhs, rhs) cbind(lhs, rhs)\n"
+      "`%cbind%` <- function(lhs, rhs) cbind(lhs, rhs)"
     )
   })
 
@@ -792,7 +780,7 @@ testthat::describe("Backticked symbol", {
 
     testthat::expect_identical(
       get_code(td, names = "`%cbind%`"),
-      "`%cbind%` <- function(lhs, rhs) cbind(lhs, rhs)\n"
+      "`%cbind%` <- function(lhs, rhs) cbind(lhs, rhs)"
     )
   })
 
@@ -807,9 +795,12 @@ testthat::describe("Backticked symbol", {
 
     testthat::expect_identical(
       get_code(td, names = "iris_ds"),
-      c(
-        "`_add_column_` <- function(lhs, rhs) cbind(lhs, rhs)\n",
-        "iris_ds <- `_add_column_`(iris, data.frame(new_col = \"new column\"))"
+      paste(
+        c(
+          "`_add_column_` <- function(lhs, rhs) cbind(lhs, rhs)",
+          "iris_ds <- `_add_column_`(iris, data.frame(new_col = \"new column\"))"
+        ),
+        collapse = "\n"
       )
     )
   })
@@ -825,9 +816,12 @@ testthat::describe("Backticked symbol", {
 
     testthat::expect_identical(
       get_code(td, names = "iris_ds"),
-      c(
-        "`add column` <- function(lhs, rhs) cbind(lhs, rhs)\n",
-        "iris_ds <- `add column`(iris, data.frame(new_col = \"new column\"))"
+      paste(
+        c(
+          "`add column` <- function(lhs, rhs) cbind(lhs, rhs)",
+          "iris_ds <- `add column`(iris, data.frame(new_col = \"new column\"))"
+        ),
+        collapse = "\n"
       )
     )
   })
@@ -843,9 +837,12 @@ testthat::describe("Backticked symbol", {
 
     testthat::expect_identical(
       get_code(td, names = "iris_ds"),
-      c(
-        "add_column <- function(lhs, rhs) cbind(lhs, rhs)\n",
-        "iris_ds <- add_column(iris, data.frame(new_col = \"new column\"))"
+      paste(
+        c(
+          "add_column <- function(lhs, rhs) cbind(lhs, rhs)",
+          "iris_ds <- add_column(iris, data.frame(new_col = \"new column\"))"
+        ),
+        collapse = "\n"
       )
     )
   })
@@ -863,9 +860,12 @@ testthat::describe("Backticked symbol", {
     # correctly.
     testthat::expect_identical(
       get_code(td, names = "iris_ds"),
-      c(
-        "`%add_column%` <- function(lhs, rhs) cbind(lhs, rhs)\n",
-        "iris_ds <- iris %add_column% data.frame(new_col = \"new column\")"
+      paste(
+        c(
+          "`%add_column%` <- function(lhs, rhs) cbind(lhs, rhs)",
+          "iris_ds <- iris %add_column% data.frame(new_col = \"new column\")"
+        ),
+        collapse = "\n"
       )
     )
   })
@@ -883,9 +883,12 @@ testthat::describe("Backticked symbol", {
     # correctly.
     testthat::expect_identical(
       get_code(td, names = "iris_ds"),
-      c(
-        "`%add_column%` <- function(lhs, rhs) cbind(lhs, rhs)\n",
-        "iris_ds <- iris %add_column% data.frame(new_col = \"new column\")"
+      paste(
+        c(
+          "`%add_column%` <- function(lhs, rhs) cbind(lhs, rhs)",
+          "iris_ds <- iris %add_column% data.frame(new_col = \"new column\")"
+        ),
+        collapse = "\n"
       )
     )
   })
@@ -896,6 +899,8 @@ testthat::describe("Backticked symbol", {
 
 testthat::test_that("get_code raises warning for missing names", {
   q <- eval_code(qenv(), code = c("a<-1;b<-2"))
-  testthat::expect_null(get_code(q, names = "c"))
-  testthat::expect_warning(get_code(q, names = "c"), " not found in code: c")
+  testthat::expect_warning(
+    testthat::expect_equal(get_code(q, names = "c"), ""),
+    " not found in code: c"
+  )
 })
diff --git a/tests/testthat/test-qenv_get_warnings.R b/tests/testthat/test-qenv_get_warnings.R
index aef810de..6eb88a15 100644
--- a/tests/testthat/test-qenv_get_warnings.R
+++ b/tests/testthat/test-qenv_get_warnings.R
@@ -54,7 +54,7 @@ testthat::test_that("get_warnings accepts a qenv object with a single eval_code
         "when running code:",
         "warning(\"This is a warning 2!\")\n",
         "~~~ Trace ~~~\n",
-        "warning(\"This is a warning 1!\")\n",
+        "warning(\"This is a warning 1!\")",
         "warning(\"This is a warning 2!\")"
       ),
       collapse = "\n"
diff --git a/tests/testthat/test-qenv_within.R b/tests/testthat/test-qenv_within.R
index 7d37ee0e..6b56c608 100644
--- a/tests/testthat/test-qenv_within.R
+++ b/tests/testthat/test-qenv_within.R
@@ -29,7 +29,7 @@ testthat::test_that("styling of input code does not impact evaluation results",
   all_code <- get_code(q)
   testthat::expect_identical(
     all_code,
-    rep("1 + 1", 4L)
+    paste(rep("1 + 1", 4L), collapse = "\n")
   )
 
   q <- qenv()
@@ -48,7 +48,7 @@ testthat::test_that("styling of input code does not impact evaluation results",
   all_code <- get_code(q)
   testthat::expect_identical(
     all_code,
-    rep(c("1 + 1\n", "2 + 2"), 4L)
+    paste(rep(c("1 + 1", "2 + 2"), 4L), collapse = "\n")
   )
 })
 

From 344f528bf8dc61b64c4cb0b86b2f6bdfeb238a78 Mon Sep 17 00:00:00 2001
From: github-actions <41898282+github-actions[bot]@users.noreply.github.com>
Date: Thu, 7 Nov 2024 12:42:04 +0000
Subject: [PATCH 65/98] [skip style] [skip vbump] Restyle files

---
 tests/testthat/test-qenv_get_code.R | 1 -
 1 file changed, 1 deletion(-)

diff --git a/tests/testthat/test-qenv_get_code.R b/tests/testthat/test-qenv_get_code.R
index d62b9365..f423ca2b 100644
--- a/tests/testthat/test-qenv_get_code.R
+++ b/tests/testthat/test-qenv_get_code.R
@@ -753,7 +753,6 @@ testthat::test_that("data() call is returned when data name is provided as a cha
 
 
 testthat::describe("Backticked symbol", {
-
   testthat::it("code can be retrieved with get_code", {
     td <- within(
       qenv(),

From 20b2c8fc00128c37d46d4eeeed403e72a658a4fc Mon Sep 17 00:00:00 2001
From: m7pr <marcin.kosinski.mk1@roche.com>
Date: Thu, 7 Nov 2024 13:55:24 +0100
Subject: [PATCH 66/98] fix warning tests

---
 R/qenv-eval_code.R                   | 2 +-
 tests/testthat/test-qenv_eval_code.R | 2 +-
 tests/testthat/test-qenv_get_code.R  | 2 +-
 3 files changed, 3 insertions(+), 3 deletions(-)

diff --git a/R/qenv-eval_code.R b/R/qenv-eval_code.R
index 09de4809..bfb6da0c 100644
--- a/R/qenv-eval_code.R
+++ b/R/qenv-eval_code.R
@@ -57,7 +57,7 @@ setMethod("eval_code", signature = c("qenv", "character"), function(object, code
             message = sprintf(
               "%s \n when evaluating qenv code:\n%s",
               .ansi_strip(conditionMessage(e)),
-              deparse1(current_call)
+              deparse1(current_code)
             ),
             class = c("qenv.error", "try-error", "simpleError"),
             trace = unlist(c(object@code, list(current_code)))
diff --git a/tests/testthat/test-qenv_eval_code.R b/tests/testthat/test-qenv_eval_code.R
index e86d29f4..b08b9544 100644
--- a/tests/testthat/test-qenv_eval_code.R
+++ b/tests/testthat/test-qenv_eval_code.R
@@ -88,7 +88,7 @@ testthat::test_that("an error when calling eval_code returns a qenv.error object
     unname(q$trace),
     c("x <- 1", "y <- 2", "z <- w * x")
   )
-  testthat::expect_equal(q$message, "object 'w' not found \n when evaluating qenv code:\nexpression(z <- w * x)")
+  testthat::expect_equal(q$message, "object 'w' not found \n when evaluating qenv code:\n\"z <- w * x\"")
 })
 
 testthat::test_that(
diff --git a/tests/testthat/test-qenv_get_code.R b/tests/testthat/test-qenv_get_code.R
index d62b9365..5f240ba9 100644
--- a/tests/testthat/test-qenv_get_code.R
+++ b/tests/testthat/test-qenv_get_code.R
@@ -43,7 +43,7 @@ testthat::test_that("get_code called with qenv.error returns error with trace in
   testthat::expect_equal(class(code), c("validation", "try-error", "simpleError", "error", "condition"))
   testthat::expect_equal(
     code$message,
-    "object 'v' not found \n when evaluating qenv code:\nexpression(w <- v)\n\ntrace: \n x <- 1\n y <- x\n w <- v\n"
+    "object 'v' not found \n when evaluating qenv code:\n\"w <- v\"\n\ntrace: \n x <- 1\n y <- x\n w <- v\n"
   )
 })
 

From b4e119c98bbe1555aec552920a4ed72c3027be3c Mon Sep 17 00:00:00 2001
From: m7pr <marcin.kosinski.mk1@roche.com>
Date: Thu, 7 Nov 2024 13:57:32 +0100
Subject: [PATCH 67/98] no need to deparse

---
 R/qenv-eval_code.R                   | 2 +-
 tests/testthat/test-qenv_eval_code.R | 2 +-
 tests/testthat/test-qenv_get_code.R  | 2 +-
 3 files changed, 3 insertions(+), 3 deletions(-)

diff --git a/R/qenv-eval_code.R b/R/qenv-eval_code.R
index bfb6da0c..dda1cf05 100644
--- a/R/qenv-eval_code.R
+++ b/R/qenv-eval_code.R
@@ -57,7 +57,7 @@ setMethod("eval_code", signature = c("qenv", "character"), function(object, code
             message = sprintf(
               "%s \n when evaluating qenv code:\n%s",
               .ansi_strip(conditionMessage(e)),
-              deparse1(current_code)
+              current_code
             ),
             class = c("qenv.error", "try-error", "simpleError"),
             trace = unlist(c(object@code, list(current_code)))
diff --git a/tests/testthat/test-qenv_eval_code.R b/tests/testthat/test-qenv_eval_code.R
index b08b9544..1bc5fa9b 100644
--- a/tests/testthat/test-qenv_eval_code.R
+++ b/tests/testthat/test-qenv_eval_code.R
@@ -88,7 +88,7 @@ testthat::test_that("an error when calling eval_code returns a qenv.error object
     unname(q$trace),
     c("x <- 1", "y <- 2", "z <- w * x")
   )
-  testthat::expect_equal(q$message, "object 'w' not found \n when evaluating qenv code:\n\"z <- w * x\"")
+  testthat::expect_equal(q$message, "object 'w' not found \n when evaluating qenv code:\nz <- w * x")
 })
 
 testthat::test_that(
diff --git a/tests/testthat/test-qenv_get_code.R b/tests/testthat/test-qenv_get_code.R
index 7f3826d5..e680493b 100644
--- a/tests/testthat/test-qenv_get_code.R
+++ b/tests/testthat/test-qenv_get_code.R
@@ -43,7 +43,7 @@ testthat::test_that("get_code called with qenv.error returns error with trace in
   testthat::expect_equal(class(code), c("validation", "try-error", "simpleError", "error", "condition"))
   testthat::expect_equal(
     code$message,
-    "object 'v' not found \n when evaluating qenv code:\n\"w <- v\"\n\ntrace: \n x <- 1\n y <- x\n w <- v\n"
+    "object 'v' not found \n when evaluating qenv code:\nw <- v\n\ntrace: \n x <- 1\n y <- x\n w <- v\n"
   )
 })
 

From e28b937bdc3e927c576de4d86eb163d26dbf17ed Mon Sep 17 00:00:00 2001
From: m7pr <marcin.kosinski.mk1@roche.com>
Date: Thu, 7 Nov 2024 14:21:03 +0100
Subject: [PATCH 68/98] extend comments testing and remove |>

---
 R/qenv-get_code.R                    |  12 ++--
 README.md                            |   5 +-
 tests/testthat/test-qenv_eval_code.R | 101 +++++++++++++++++++++++++++
 tests/testthat/test-qenv_extract.R   |   2 +-
 tests/testthat/test-qenv_get_code.R  |  50 +------------
 5 files changed, 114 insertions(+), 56 deletions(-)

diff --git a/R/qenv-get_code.R b/R/qenv-get_code.R
index 8728f56c..8daf1410 100644
--- a/R/qenv-get_code.R
+++ b/R/qenv-get_code.R
@@ -18,8 +18,8 @@
 #'
 #' _Case 1: Usual assignments._
 #' ```r
-#' q1 <- qenv() |>
-#'   within({
+#' q1 <-
+#'   within(qenv(), {
 #'     foo <- function(x) {
 #'       x + 1
 #'     }
@@ -33,8 +33,8 @@
 #'
 #' _Case 2: Some objects are created by a function's side effects._
 #' ```r
-#' q2 <- qenv() |>
-#'   within({
+#' q2 <-
+#'   within(qenv(){
 #'     foo <- function() {
 #'       x <<- x + 1
 #'     }
@@ -52,8 +52,8 @@
 #' In order to include comments in code one must use the `eval_code` function instead.
 #'
 #' ```r
-#' q3 <- qenv() |>
-#'   eval_code("
+#' q3 <-
+#'   eval_code(qenv(), "
 #'     foo <- function() {
 #'       x <<- x + 1
 #'     }
diff --git a/README.md b/README.md
index 27c7921f..ed9187fd 100644
--- a/README.md
+++ b/README.md
@@ -56,7 +56,7 @@ Below is the showcase of the example usage
 
 ```r
 library(teal.code)
-my_qenv <- qenv() |> eval_code("x <- 5")
+my_qenv <- eval_code(qenv(), "x <- 5")
 my_qenv
 #> <environment: 0x00000225cc85c7a0> [L]
 #> Parent: <environment: package:teal.code>
@@ -69,7 +69,8 @@ ls(get_env(my_qenv))
 ```
 
 ```r
-qenv_2 <- eval_code(my_qenv, "y <- x * 2") |> eval_code("z <- y * 2")
+qenv_2 <- eval_code(my_qenv, "y <- x * 2") 
+qenv_2 <- eval_code(qenv_2, "z <- y * 2")
 qenv_2
 #> <environment: 0x00000225ca866d68> [L]
 #> Parent: <environment: package:teal.code>
diff --git a/tests/testthat/test-qenv_eval_code.R b/tests/testthat/test-qenv_eval_code.R
index 1bc5fa9b..353fc95e 100644
--- a/tests/testthat/test-qenv_eval_code.R
+++ b/tests/testthat/test-qenv_eval_code.R
@@ -170,3 +170,104 @@ testthat::test_that(
     )
   }
 )
+
+
+
+# comments --------------------------------------------------------------------------------------------------------
+
+
+# comments --------------------------------------------------------------------------------------------------------
+
+testthat::test_that("comments fall into proper calls", {
+  # If comment is on top, it gets moved to the first call.
+  # Any other comment gets moved to the call above.
+  code <- "
+    # initial comment
+    a <- 1
+    b <- 2 # inline comment
+    c <- 3
+    # inbetween comment
+    d <- 4
+    # finishing comment
+  "
+
+  q <- eval_code(qenv(), code)
+  testthat::expect_identical(
+    get_code(q),
+    code
+  )
+})
+
+testthat::test_that("comments get pasted when they fall into calls", {
+  # If comment is on top, it gets moved to the first call.
+  # Any other comment gets moved to the call above.
+  # Comments get pasted if there are two assigned to the same call.
+  code <- "
+    # initial comment
+    a <- 1 # A comment
+    b <- 2 # inline comment
+    c <- 3 # C comment
+    # inbetween comment
+    d <- 4
+    # finishing comment
+  "
+
+  q <- eval_code(qenv(), code)
+  testthat::expect_identical(
+    get_code(q),
+    code
+  )
+})
+
+testthat::test_that("comments alone are pasted to the next/following call element",{
+  code <- c("x <- 5", "# comment", "y <- 6")
+  q <- eval_code(qenv(), code)
+  testthat::expect_identical(
+    unlist(q@code)[2],
+    pasten(code[2:3])
+  )
+  testthat::expect_identical(
+    get_code(q),
+    pasten(code)
+  )
+})
+
+testthat::test_that("comments at the end of src are added to the previous call element",{
+  code <- c("x <- 5", "# comment")
+  q <- eval_code(qenv(), code)
+  testthat::expect_identical(
+    unlist(q@code),
+    pasten(code[1:2])
+  )
+  testthat::expect_identical(
+    get_code(q),
+    pasten(code)
+  )
+})
+
+testthat::test_that("comments from the same line are associated with it's call",{
+  code <- c("x <- 5", " y <- 4 # comment", "z <- 5")
+  q <- eval_code(qenv(), code)
+  testthat::expect_identical(
+    unlist(q@code)[2],
+    paste0(code[2], "\n")
+  )
+  testthat::expect_identical(
+    get_code(q),
+    pasten(code)
+  )
+})
+
+testthat::test_that("comments alone passed to eval_code are skipped",{
+  code <- c("x <- 5", "# comment")
+  q <- eval_code(eval_code(qenv(), code[1]), code[2])
+  testthat::expect_identical(
+    unlist(q@code),
+    pasten(code[1:2])
+  )
+  testthat::expect_identical(
+    get_code(q),
+    pasten(code)
+  )
+})
+
diff --git a/tests/testthat/test-qenv_extract.R b/tests/testthat/test-qenv_extract.R
index 8e01a1b0..e7ae0a77 100644
--- a/tests/testthat/test-qenv_extract.R
+++ b/tests/testthat/test-qenv_extract.R
@@ -41,7 +41,7 @@ testthat::test_that("`[.` extracts the code only needed to recreate objects pass
   )
 })
 
-testthat::test_that("`[.` preservers comments in the code", {
+testthat::test_that("`[.` comments are preserved in the code and associated with the following call", {
   q <- qenv()
   code <- c("x<-1 #comment", "a<-1;b<-2")
   q <- eval_code(q, code)
diff --git a/tests/testthat/test-qenv_get_code.R b/tests/testthat/test-qenv_get_code.R
index e680493b..9b8e2d09 100644
--- a/tests/testthat/test-qenv_get_code.R
+++ b/tests/testthat/test-qenv_get_code.R
@@ -1,9 +1,9 @@
 pasten <- function(...) paste(..., collapse = "\n")
 
 testthat::test_that("get_code returns code (character by default) of qenv object", {
-  q <- qenv() |>
-    eval_code(quote(x <- 1)) |>
-    eval_code(quote(y <- x))
+  q <- qenv()
+  q <- eval_code(q, quote(x <- 1))
+  q <- eval_code(q, quote(y <- x))
   testthat::expect_equal(get_code(q), pasten(c("x <- 1", "y <- x")))
 })
 
@@ -456,50 +456,6 @@ testthat::test_that(
   }
 )
 
-
-# comments --------------------------------------------------------------------------------------------------------
-
-testthat::test_that("comments fall into proper calls", {
-  # If comment is on top, it gets moved to the first call.
-  # Any other comment gets moved to the call above.
-  code <- "
-    # initial comment
-    a <- 1
-    b <- 2 # inline comment
-    c <- 3
-    # inbetween comment
-    d <- 4
-    # finishing comment
-  "
-
-  q <- eval_code(qenv(), code)
-  testthat::expect_identical(
-    get_code(q),
-    code
-  )
-})
-
-testthat::test_that("comments get pasted when they fall into calls", {
-  # If comment is on top, it gets moved to the first call.
-  # Any other comment gets moved to the call above.
-  # Comments get pasted if there are two assigned to the same call.
-  code <- "
-    # initial comment
-    a <- 1 # A comment
-    b <- 2 # inline comment
-    c <- 3 # C comment
-    # inbetween comment
-    d <- 4
-    # finishing comment
-  "
-
-  q <- qenv() |> eval_code(code)
-  testthat::expect_identical(
-    get_code(q),
-    code
-  )
-})
-
 # functions -------------------------------------------------------------------------------------------------------
 
 testthat::test_that("ignores occurrence in a function definition", {

From c37941942504277bf22a43284db02e51c6021100 Mon Sep 17 00:00:00 2001
From: "27856297+dependabot-preview[bot]@users.noreply.github.com"
 <27856297+dependabot-preview[bot]@users.noreply.github.com>
Date: Thu, 7 Nov 2024 13:23:15 +0000
Subject: [PATCH 69/98] [skip roxygen] [skip vbump] Roxygen Man Pages Auto
 Update

---
 man/qenv.Rd | 12 ++++++------
 1 file changed, 6 insertions(+), 6 deletions(-)

diff --git a/man/qenv.Rd b/man/qenv.Rd
index 0ede17c9..63b95576 100644
--- a/man/qenv.Rd
+++ b/man/qenv.Rd
@@ -89,8 +89,8 @@ Consider the following examples:
 
 \emph{Case 1: Usual assignments.}
 
-\if{html}{\out{<div class="sourceCode r">}}\preformatted{q1 <- qenv() |>
-  within(\{
+\if{html}{\out{<div class="sourceCode r">}}\preformatted{q1 <-
+  within(qenv(), \{
     foo <- function(x) \{
       x + 1
     \}
@@ -105,8 +105,8 @@ get_code(q1, names = "y")
 
 \emph{Case 2: Some objects are created by a function's side effects.}
 
-\if{html}{\out{<div class="sourceCode r">}}\preformatted{q2 <- qenv() |>
-  within(\{
+\if{html}{\out{<div class="sourceCode r">}}\preformatted{q2 <-
+  within(qenv()\{
     foo <- function() \{
       x <<- x + 1
     \}
@@ -124,8 +124,8 @@ Lines where side effects occur can be flagged by adding "\verb{# @linksto <objec
 Note that \code{within} evaluates code passed to \code{expr} as is and comments are ignored.
 In order to include comments in code one must use the \code{eval_code} function instead.
 
-\if{html}{\out{<div class="sourceCode r">}}\preformatted{q3 <- qenv() |>
-  eval_code("
+\if{html}{\out{<div class="sourceCode r">}}\preformatted{q3 <-
+  eval_code(qenv(), "
     foo <- function() \{
       x <<- x + 1
     \}

From 115ea5129da120d056ab2e26e18e12f6d24c1e2f Mon Sep 17 00:00:00 2001
From: github-actions <41898282+github-actions[bot]@users.noreply.github.com>
Date: Thu, 7 Nov 2024 13:23:22 +0000
Subject: [PATCH 70/98] [skip style] [skip vbump] Restyle files

---
 tests/testthat/test-qenv_eval_code.R | 9 ++++-----
 1 file changed, 4 insertions(+), 5 deletions(-)

diff --git a/tests/testthat/test-qenv_eval_code.R b/tests/testthat/test-qenv_eval_code.R
index 353fc95e..bc86a17a 100644
--- a/tests/testthat/test-qenv_eval_code.R
+++ b/tests/testthat/test-qenv_eval_code.R
@@ -219,7 +219,7 @@ testthat::test_that("comments get pasted when they fall into calls", {
   )
 })
 
-testthat::test_that("comments alone are pasted to the next/following call element",{
+testthat::test_that("comments alone are pasted to the next/following call element", {
   code <- c("x <- 5", "# comment", "y <- 6")
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
@@ -232,7 +232,7 @@ testthat::test_that("comments alone are pasted to the next/following call elemen
   )
 })
 
-testthat::test_that("comments at the end of src are added to the previous call element",{
+testthat::test_that("comments at the end of src are added to the previous call element", {
   code <- c("x <- 5", "# comment")
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
@@ -245,7 +245,7 @@ testthat::test_that("comments at the end of src are added to the previous call e
   )
 })
 
-testthat::test_that("comments from the same line are associated with it's call",{
+testthat::test_that("comments from the same line are associated with it's call", {
   code <- c("x <- 5", " y <- 4 # comment", "z <- 5")
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
@@ -258,7 +258,7 @@ testthat::test_that("comments from the same line are associated with it's call",
   )
 })
 
-testthat::test_that("comments alone passed to eval_code are skipped",{
+testthat::test_that("comments alone passed to eval_code are skipped", {
   code <- c("x <- 5", "# comment")
   q <- eval_code(eval_code(qenv(), code[1]), code[2])
   testthat::expect_identical(
@@ -270,4 +270,3 @@ testthat::test_that("comments alone passed to eval_code are skipped",{
     pasten(code)
   )
 })
-

From 080e27f831d7415c271950a2f023721a0a6463f7 Mon Sep 17 00:00:00 2001
From: m7pr <marcin.kosinski.mk1@roche.com>
Date: Thu, 7 Nov 2024 14:30:25 +0100
Subject: [PATCH 71/98] substitute pasten with paste

---
 tests/testthat/test-qenv_eval_code.R | 14 +++++++-------
 1 file changed, 7 insertions(+), 7 deletions(-)

diff --git a/tests/testthat/test-qenv_eval_code.R b/tests/testthat/test-qenv_eval_code.R
index 353fc95e..2508810c 100644
--- a/tests/testthat/test-qenv_eval_code.R
+++ b/tests/testthat/test-qenv_eval_code.R
@@ -224,11 +224,11 @@ testthat::test_that("comments alone are pasted to the next/following call elemen
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
     unlist(q@code)[2],
-    pasten(code[2:3])
+    paste(code[2:3], collapse = "\n")
   )
   testthat::expect_identical(
     get_code(q),
-    pasten(code)
+    paste(code, collapse = "\n")
   )
 })
 
@@ -237,11 +237,11 @@ testthat::test_that("comments at the end of src are added to the previous call e
   q <- eval_code(qenv(), code)
   testthat::expect_identical(
     unlist(q@code),
-    pasten(code[1:2])
+    paste(code[1:2], collapse = "\n")
   )
   testthat::expect_identical(
     get_code(q),
-    pasten(code)
+    paste(code, collapse = "\n")
   )
 })
 
@@ -254,7 +254,7 @@ testthat::test_that("comments from the same line are associated with it's call",
   )
   testthat::expect_identical(
     get_code(q),
-    pasten(code)
+    paste(code, collapse = "\n")
   )
 })
 
@@ -263,11 +263,11 @@ testthat::test_that("comments alone passed to eval_code are skipped",{
   q <- eval_code(eval_code(qenv(), code[1]), code[2])
   testthat::expect_identical(
     unlist(q@code),
-    pasten(code[1:2])
+    paste(code[1:2], collapse = "\n")
   )
   testthat::expect_identical(
     get_code(q),
-    pasten(code)
+    paste(code, collapse = "\n")
   )
 })
 

From c3b25e6e2a58314dcf5fe3b85ab162246b705a41 Mon Sep 17 00:00:00 2001
From: m7pr <marcin.kosinski.mk1@roche.com>
Date: Thu, 7 Nov 2024 14:31:40 +0100
Subject: [PATCH 72/98] skip the test that breaks on CI but not locally

---
 tests/testthat/test-qenv_get_code.R | 1 +
 1 file changed, 1 insertion(+)

diff --git a/tests/testthat/test-qenv_get_code.R b/tests/testthat/test-qenv_get_code.R
index 9b8e2d09..58187042 100644
--- a/tests/testthat/test-qenv_get_code.R
+++ b/tests/testthat/test-qenv_get_code.R
@@ -635,6 +635,7 @@ testthat::test_that("detects cooccurrence properly even if all objects are on lh
 # @ ---------------------------------------------------------------------------------------------------------------
 
 testthat::test_that("understands @ usage and do not treat rhs of @ as objects (only lhs)", {
+  testthat::skip("This breaks on CI but not locally with: Error: cannot add bindings to a locked environment")
   code <- c(
     "setClass('aclass', slots = c(a = 'numeric', x = 'numeric', y = 'numeric')) # @linksto a x",
     "x <- new('aclass', a = 1:3, x = 1:3, y = 1:3)",

From 7cf13ac0b003be831c3d7dc0d9027dfecc99ba7a Mon Sep 17 00:00:00 2001
From: m7pr <marcin.kosinski.mk1@roche.com>
Date: Thu, 7 Nov 2024 14:38:52 +0100
Subject: [PATCH 73/98] fix the test where we dont want to eval the code

---
 tests/testthat/test-qenv_get_code.R | 19 +++++++++++++++++--
 1 file changed, 17 insertions(+), 2 deletions(-)

diff --git a/tests/testthat/test-qenv_get_code.R b/tests/testthat/test-qenv_get_code.R
index 58187042..7c04eafb 100644
--- a/tests/testthat/test-qenv_get_code.R
+++ b/tests/testthat/test-qenv_get_code.R
@@ -635,7 +635,7 @@ testthat::test_that("detects cooccurrence properly even if all objects are on lh
 # @ ---------------------------------------------------------------------------------------------------------------
 
 testthat::test_that("understands @ usage and do not treat rhs of @ as objects (only lhs)", {
-  testthat::skip("This breaks on CI but not locally with: Error: cannot add bindings to a locked environment")
+
   code <- c(
     "setClass('aclass', slots = c(a = 'numeric', x = 'numeric', y = 'numeric')) # @linksto a x",
     "x <- new('aclass', a = 1:3, x = 1:3, y = 1:3)",
@@ -645,7 +645,22 @@ testthat::test_that("understands @ usage and do not treat rhs of @ as objects (o
     "a@x <- x@a"
   )
   q <- qenv()
-  q <- eval_code(q, code)
+  code_split <- as.list(split_code(paste(code, collapse = "\n")))
+
+  dependency <-
+    lapply(
+      code_split,
+      function(current_code){
+        parsed_code <- parse(text = current_code, keep.source = TRUE)
+        extract_dependency(parsed_code)
+      }
+    )
+
+  for(i in seq_along(code_split)){
+    attr(code_split[[i]], "dependency") <- dependency[[i]]
+  }
+
+  q@code <- code_split
   testthat::expect_identical(
     get_code(q, names = "x"),
     pasten(code[1:2])

From 109877d9dad529aa085416c8670b34395f5f7ef8 Mon Sep 17 00:00:00 2001
From: github-actions <41898282+github-actions[bot]@users.noreply.github.com>
Date: Thu, 7 Nov 2024 13:40:59 +0000
Subject: [PATCH 74/98] [skip style] [skip vbump] Restyle files

---
 tests/testthat/test-qenv_get_code.R | 5 ++---
 1 file changed, 2 insertions(+), 3 deletions(-)

diff --git a/tests/testthat/test-qenv_get_code.R b/tests/testthat/test-qenv_get_code.R
index 7c04eafb..9d619a32 100644
--- a/tests/testthat/test-qenv_get_code.R
+++ b/tests/testthat/test-qenv_get_code.R
@@ -635,7 +635,6 @@ testthat::test_that("detects cooccurrence properly even if all objects are on lh
 # @ ---------------------------------------------------------------------------------------------------------------
 
 testthat::test_that("understands @ usage and do not treat rhs of @ as objects (only lhs)", {
-
   code <- c(
     "setClass('aclass', slots = c(a = 'numeric', x = 'numeric', y = 'numeric')) # @linksto a x",
     "x <- new('aclass', a = 1:3, x = 1:3, y = 1:3)",
@@ -650,13 +649,13 @@ testthat::test_that("understands @ usage and do not treat rhs of @ as objects (o
   dependency <-
     lapply(
       code_split,
-      function(current_code){
+      function(current_code) {
         parsed_code <- parse(text = current_code, keep.source = TRUE)
         extract_dependency(parsed_code)
       }
     )
 
-  for(i in seq_along(code_split)){
+  for (i in seq_along(code_split)) {
     attr(code_split[[i]], "dependency") <- dependency[[i]]
   }
 

From 3e4582e83c041b47c99cf8f15677ec7ef6899786 Mon Sep 17 00:00:00 2001
From: Marcin <133694481+m7pr@users.noreply.github.com>
Date: Thu, 7 Nov 2024 15:18:52 +0100
Subject: [PATCH 75/98] Update R/qenv-get_warnings.R
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

Co-authored-by: Dawid Kałędkowski <dawid.kaledkowski@gmail.com>
Signed-off-by: Marcin <133694481+m7pr@users.noreply.github.com>
---
 R/qenv-get_warnings.R | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/R/qenv-get_warnings.R b/R/qenv-get_warnings.R
index ea2c0e89..db99afc4 100644
--- a/R/qenv-get_warnings.R
+++ b/R/qenv-get_warnings.R
@@ -37,7 +37,7 @@ setMethod("get_warnings", signature = c("qenv"), function(object) {
   idx_warn <- which(sapply(warnings, Negate(is.null)))
   warnings <- warnings[idx_warn]
   code <- object@code[idx_warn]
-  if (length(unlist(warnings)) == 0) {
+  if (length(warnings) == 0) {
     return(NULL)
   }
 

From da9a69beb25a211294f7c635b80156bf8ddfbc13 Mon Sep 17 00:00:00 2001
From: m7pr <marcin.kosinski.mk1@roche.com>
Date: Thu, 7 Nov 2024 15:37:02 +0100
Subject: [PATCH 76/98] fix a test

---
 tests/testthat/test-qenv_eval_code.R | 6 +-----
 1 file changed, 1 insertion(+), 5 deletions(-)

diff --git a/tests/testthat/test-qenv_eval_code.R b/tests/testthat/test-qenv_eval_code.R
index e5be8ad0..6bb9b8d6 100644
--- a/tests/testthat/test-qenv_eval_code.R
+++ b/tests/testthat/test-qenv_eval_code.R
@@ -261,12 +261,8 @@ testthat::test_that("comments from the same line are associated with it's call",
 testthat::test_that("comments alone passed to eval_code are skipped", {
   code <- c("x <- 5", "# comment")
   q <- eval_code(eval_code(qenv(), code[1]), code[2])
-  testthat::expect_identical(
-    unlist(q@code),
-    paste(code[1:2], collapse = "\n")
-  )
   testthat::expect_identical(
     get_code(q),
-    paste(code, collapse = "\n")
+    code[1]
   )
 })

From ef00c584b843b50ab038bc9c25423e9eebbf52b3 Mon Sep 17 00:00:00 2001
From: m7pr <marcin.kosinski.mk1@roche.com>
Date: Thu, 7 Nov 2024 15:38:15 +0100
Subject: [PATCH 77/98] adjust test so it does not load libraries

---
 tests/testthat/test-qenv_eval_code.R | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/tests/testthat/test-qenv_eval_code.R b/tests/testthat/test-qenv_eval_code.R
index 6bb9b8d6..cab64a91 100644
--- a/tests/testthat/test-qenv_eval_code.R
+++ b/tests/testthat/test-qenv_eval_code.R
@@ -160,11 +160,11 @@ testthat::test_that("eval_code returns a qenv object with dependency attribute t
 testthat::test_that(
   "eval_code returns a qenv object with dependency attribute that extracts functions after '<-' part",
   {
-    q3 <- eval_code(qenv(), c("library(survival)", "head(iris)"))
+    q3 <- eval_code(qenv(), c("nrow(iris)", "head(iris)"))
     testthat::expect_identical(
       lapply(q3@code, attr, "dependency"),
       list(
-        c("<-", "library", "survival"),
+        c("<-", "nrow", "iris"),
         c("<-", "head", "iris")
       )
     )

From 6fcb8b96051b1490683fb2e346ce04cf4259e993 Mon Sep 17 00:00:00 2001
From: Marcin <133694481+m7pr@users.noreply.github.com>
Date: Thu, 7 Nov 2024 15:39:27 +0100
Subject: [PATCH 78/98] Update tests/testthat/test-qenv_eval_code.R

Signed-off-by: Marcin <133694481+m7pr@users.noreply.github.com>
---
 tests/testthat/test-qenv_eval_code.R | 3 ---
 1 file changed, 3 deletions(-)

diff --git a/tests/testthat/test-qenv_eval_code.R b/tests/testthat/test-qenv_eval_code.R
index cab64a91..09e839d9 100644
--- a/tests/testthat/test-qenv_eval_code.R
+++ b/tests/testthat/test-qenv_eval_code.R
@@ -173,9 +173,6 @@ testthat::test_that(
 
 
 
-# comments --------------------------------------------------------------------------------------------------------
-
-
 # comments --------------------------------------------------------------------------------------------------------
 
 testthat::test_that("comments fall into proper calls", {

From 3ba65f2727f6247d69e26a4eced04d167e994c4a Mon Sep 17 00:00:00 2001
From: m7pr <marcin.kosinski.mk1@roche.com>
Date: Thu, 7 Nov 2024 16:30:33 +0100
Subject: [PATCH 79/98] treat empty calls or comments as separate calls

---
 R/qenv-eval_code.R                   |  4 ++++
 R/utils-get_code_dependency.R        | 16 +++++++++-------
 tests/testthat/test-qenv_eval_code.R | 21 +++++++++++++++++++--
 3 files changed, 32 insertions(+), 9 deletions(-)

diff --git a/R/qenv-eval_code.R b/R/qenv-eval_code.R
index dda1cf05..1edfa497 100644
--- a/R/qenv-eval_code.R
+++ b/R/qenv-eval_code.R
@@ -31,6 +31,10 @@ setMethod("eval_code", signature = c("qenv", "character"), function(object, code
   parsed_code <- parse(text = code, keep.source = TRUE)
   object@env <- rlang::env_clone(object@env, parent = parent.env(.GlobalEnv))
   if (length(parsed_code) == 0) {
+    # empty code, or just comments
+    attr(code, "id") <- sample.int(.Machine$integer.max, size = 1)
+    attr(code, "dependency") <- extract_dependency(parsed_code) # in case comment contains @linksto tag
+    object@code <- c(object@code, list(code))
     return(object)
   }
   code_split <- split_code(paste(code, collapse = "\n"))
diff --git a/R/utils-get_code_dependency.R b/R/utils-get_code_dependency.R
index 856f20db..0d2c9043 100644
--- a/R/utils-get_code_dependency.R
+++ b/R/utils-get_code_dependency.R
@@ -315,7 +315,7 @@ extract_occurrence <- function(pd) {
 #' @noRd
 extract_side_effects <- function(pd) {
   linksto <- grep("@linksto", pd[pd$token == "COMMENT", "text"], value = TRUE)
-  unlist(strsplit(sub("\\s*#\\s*@linksto\\s+", "", linksto), "\\s+"))
+  unlist(strsplit(sub("\\s*#.*@linksto\\s+", "", linksto), "\\s+"))
 }
 
 #' @param parsed_code results of `parse(text = code, keep.source = TRUE` (parsed text)
@@ -323,12 +323,14 @@ extract_side_effects <- function(pd) {
 #' @noRd
 extract_dependency <- function(parsed_code) {
   pd <- normalize_pd(utils::getParseData(parsed_code))
-  reordered_pd <- extract_calls(pd)[[1]]
-  # extract_calls is needed to reorder the pd so that assignment operator comes before symbol names
-  # extract_calls is needed also to substitute assignment operators into specific format with fix_arrows
-  # extract_calls is needed to omit empty calls that contain only one token `"';'"`
-  # This cleaning is needed as extract_occurrence assumes arrows are fixed, and order is different than in original pd.
-  c(extract_side_effects(reordered_pd), extract_occurrence(reordered_pd))
+  reordered_pd <- extract_calls(pd)
+  if (length(reordered_pd) > 0) {
+    # extract_calls is needed to reorder the pd so that assignment operator comes before symbol names
+    # extract_calls is needed also to substitute assignment operators into specific format with fix_arrows
+    # extract_calls is needed to omit empty calls that contain only one token `"';'"`
+    # This cleaning is needed as extract_occurrence assumes arrows are fixed, and order is different than in original pd.
+    c(extract_side_effects(reordered_pd[[1]]), extract_occurrence(reordered_pd[[1]]))
+  }
 }
 
 # graph_parser ----
diff --git a/tests/testthat/test-qenv_eval_code.R b/tests/testthat/test-qenv_eval_code.R
index cab64a91..d9f24f88 100644
--- a/tests/testthat/test-qenv_eval_code.R
+++ b/tests/testthat/test-qenv_eval_code.R
@@ -258,11 +258,28 @@ testthat::test_that("comments from the same line are associated with it's call",
   )
 })
 
-testthat::test_that("comments alone passed to eval_code are skipped", {
+testthat::test_that("comments passed alone to eval_code are separate calls", {
   code <- c("x <- 5", "# comment")
   q <- eval_code(eval_code(qenv(), code[1]), code[2])
   testthat::expect_identical(
     get_code(q),
-    code[1]
+    pasten(code)
+  )
+})
+
+testthat::test_that("comments passed alone to eval_code that contain @linksto tag have detected dependency", {
+  code <- c("x <- 5", "# comment @linksto x")
+  q <- eval_code(eval_code(qenv(), code[1]), code[2])
+  testthat::expect_identical(
+    get_code(q),
+    pasten(code)
+  )
+  testthat::expect_identical(
+    get_code(q, names = 'x'),
+    pasten(code)
+  )
+  testthat::expect_identical(
+    attr(q@code[[2]], "dependency"),
+    "x"
   )
 })

From 888faa832c0774230bc166fe854e9e9b94a75ea7 Mon Sep 17 00:00:00 2001
From: github-actions <41898282+github-actions[bot]@users.noreply.github.com>
Date: Thu, 7 Nov 2024 15:33:15 +0000
Subject: [PATCH 80/98] [skip style] [skip vbump] Restyle files

---
 tests/testthat/test-qenv_eval_code.R | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/tests/testthat/test-qenv_eval_code.R b/tests/testthat/test-qenv_eval_code.R
index 412c59d1..a4f86ac8 100644
--- a/tests/testthat/test-qenv_eval_code.R
+++ b/tests/testthat/test-qenv_eval_code.R
@@ -272,7 +272,7 @@ testthat::test_that("comments passed alone to eval_code that contain @linksto ta
     pasten(code)
   )
   testthat::expect_identical(
-    get_code(q, names = 'x'),
+    get_code(q, names = "x"),
     pasten(code)
   )
   testthat::expect_identical(

From fae245225f8638b4fdbbba45057931f8d426ce64 Mon Sep 17 00:00:00 2001
From: m7pr <marcin.kosinski.mk1@roche.com>
Date: Fri, 8 Nov 2024 09:06:07 +0100
Subject: [PATCH 81/98] replace pasten with paste

---
 tests/testthat/test-qenv_eval_code.R | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/tests/testthat/test-qenv_eval_code.R b/tests/testthat/test-qenv_eval_code.R
index a4f86ac8..1a677896 100644
--- a/tests/testthat/test-qenv_eval_code.R
+++ b/tests/testthat/test-qenv_eval_code.R
@@ -260,7 +260,7 @@ testthat::test_that("comments passed alone to eval_code are separate calls", {
   q <- eval_code(eval_code(qenv(), code[1]), code[2])
   testthat::expect_identical(
     get_code(q),
-    pasten(code)
+    paste(code, collapse = "\n")
   )
 })
 
@@ -269,11 +269,11 @@ testthat::test_that("comments passed alone to eval_code that contain @linksto ta
   q <- eval_code(eval_code(qenv(), code[1]), code[2])
   testthat::expect_identical(
     get_code(q),
-    pasten(code)
+    paste(code, collapse = "\n")
   )
   testthat::expect_identical(
     get_code(q, names = "x"),
-    pasten(code)
+    paste(code, collapse = "\n")
   )
   testthat::expect_identical(
     attr(q@code[[2]], "dependency"),

From 49d342b280f8d5a0bb05df7122b5af6b3a185d16 Mon Sep 17 00:00:00 2001
From: go_gonzo <dawid.kaledkowski@gmail.com>
Date: Fri, 8 Nov 2024 09:09:46 +0100
Subject: [PATCH 82/98] preserve original src when available

---
 R/qenv-eval_code.R                   |  8 ++++++--
 tests/testthat/test-qenv_eval_code.R | 19 +++++++++++++++++++
 2 files changed, 25 insertions(+), 2 deletions(-)

diff --git a/R/qenv-eval_code.R b/R/qenv-eval_code.R
index 1edfa497..8fbb1084 100644
--- a/R/qenv-eval_code.R
+++ b/R/qenv-eval_code.R
@@ -96,8 +96,12 @@ setMethod("eval_code", signature = c("qenv", "language"), function(object, code)
 })
 
 setMethod("eval_code", signature = c("qenv", "expression"), function(object, code) {
-  # todo: if has srcfile then get original text!
-  eval_code(object, code = paste(lang2calls(code), collapse = "\n"))
+  srcref <- attr(code, "wholeSrcref")
+  if (length(srcref)) {
+    eval_code(object, code = paste(attr(code, "wholeSrcref"), collapse = "\n"))
+  } else {
+    eval_code(object, code = paste(lang2calls(code), collapse = "\n"))
+  }
 })
 
 setMethod("eval_code", signature = c("qenv.error", "ANY"), function(object, code) {
diff --git a/tests/testthat/test-qenv_eval_code.R b/tests/testthat/test-qenv_eval_code.R
index 1a677896..b97332ab 100644
--- a/tests/testthat/test-qenv_eval_code.R
+++ b/tests/testthat/test-qenv_eval_code.R
@@ -280,3 +280,22 @@ testthat::test_that("comments passed alone to eval_code that contain @linksto ta
     "x"
   )
 })
+
+testthat::test_that("original formatting and comments are preserved when expression has a srcref", {
+  code <- "# comment
+    a <- 1\n
+
+    # comment
+    \n
+  "
+  expr <- parse(text = code, keep.source = TRUE)
+  testthat::expect_identical(get_code(eval_code(qenv(), expr)), code)
+})
+
+testthat::test_that("eval_code accepts calls containing only comments and empty spaces", {
+  code <- "# comment
+    \n\n# comment
+    \n
+  "
+  testthat::expect_identical(get_code(eval_code(qenv(), code)), code)
+})

From b967cddec57a53875c48f64fe05f7a5f46686db1 Mon Sep 17 00:00:00 2001
From: go_gonzo <dawid.kaledkowski@gmail.com>
Date: Fri, 8 Nov 2024 09:10:15 +0100
Subject: [PATCH 83/98] bquote not needed

---
 tests/testthat/test-qenv_get_warnings.R | 16 ++++++++--------
 1 file changed, 8 insertions(+), 8 deletions(-)

diff --git a/tests/testthat/test-qenv_get_warnings.R b/tests/testthat/test-qenv_get_warnings.R
index 6eb88a15..2547f6b2 100644
--- a/tests/testthat/test-qenv_get_warnings.R
+++ b/tests/testthat/test-qenv_get_warnings.R
@@ -1,5 +1,5 @@
 testthat::test_that("get_warnings accepts a qenv object and returns character", {
-  q <- eval_code(qenv(), bquote(warning("This is a warning!")))
+  q <- eval_code(qenv(), quote(warning("This is a warning!")))
   testthat::expect_identical(
     get_warnings(q),
     paste0(
@@ -10,7 +10,7 @@ testthat::test_that("get_warnings accepts a qenv object and returns character",
 })
 
 testthat::test_that("get_warnings accepts a qenv.error object and returns NULL", {
-  q <- eval_code(qenv(), bquote(error("This is a error!")))
+  q <- eval_code(qenv(), quote(error("This is a error!")))
   testthat::expect_null(get_warnings(q))
 })
 
@@ -19,14 +19,14 @@ testthat::test_that("get_warnings accepts a NULL object and returns NULL", {
 })
 
 testthat::test_that("get_warnings accepts a qenv object with no warning and returns NULL", {
-  q <- eval_code(qenv(), bquote("x <- 1"))
+  q <- eval_code(qenv(), quote("x <- 1"))
   testthat::expect_null(get_warnings(q))
 })
 
 testthat::test_that("get_warnings accepts a qenv object with 2 warnings", {
   q <- qenv() %>%
-    eval_code(bquote(warning("This is a warning 1!"))) %>%
-    eval_code(bquote(warning("This is a warning 2!")))
+    eval_code(quote(warning("This is a warning 1!"))) %>%
+    eval_code(quote(warning("This is a warning 2!")))
   testthat::expect_identical(
     get_warnings(q),
     paste0(
@@ -38,7 +38,7 @@ testthat::test_that("get_warnings accepts a qenv object with 2 warnings", {
 })
 
 testthat::test_that("get_warnings accepts a qenv object with a single eval_code returning 2 warnings", {
-  q <- qenv() %>% eval_code(bquote({
+  q <- qenv() %>% eval_code(quote({
     warning("This is a warning 1!")
     warning("This is a warning 2!")
   }))
@@ -64,8 +64,8 @@ testthat::test_that("get_warnings accepts a qenv object with a single eval_code
 
 testthat::test_that("get_warnings accepts a qenv object with 1 warning eval_code and 1 no warning eval_code", {
   q <- qenv() %>%
-    eval_code(bquote("x <- 1")) %>%
-    eval_code(bquote(warning("This is a warning 2!")))
+    eval_code(quote("x <- 1")) %>%
+    eval_code(quote(warning("This is a warning 2!")))
   testthat::expect_identical(
     get_warnings(q),
     paste0(

From cd70b452a6471bb083c3e5452e6a5232f5f44f61 Mon Sep 17 00:00:00 2001
From: m7pr <marcin.kosinski.mk1@roche.com>
Date: Fri, 8 Nov 2024 09:18:16 +0100
Subject: [PATCH 84/98] remove pipes

---
 tests/testthat/test-qenv_get_warnings.R | 14 +++++++-------
 1 file changed, 7 insertions(+), 7 deletions(-)

diff --git a/tests/testthat/test-qenv_get_warnings.R b/tests/testthat/test-qenv_get_warnings.R
index 2547f6b2..f337502c 100644
--- a/tests/testthat/test-qenv_get_warnings.R
+++ b/tests/testthat/test-qenv_get_warnings.R
@@ -24,9 +24,9 @@ testthat::test_that("get_warnings accepts a qenv object with no warning and retu
 })
 
 testthat::test_that("get_warnings accepts a qenv object with 2 warnings", {
-  q <- qenv() %>%
-    eval_code(quote(warning("This is a warning 1!"))) %>%
-    eval_code(quote(warning("This is a warning 2!")))
+  q <- qenv()
+  q <- eval_code(q, quote(warning("This is a warning 1!")))
+  q <- eval_code(q, quote(warning("This is a warning 2!")))
   testthat::expect_identical(
     get_warnings(q),
     paste0(
@@ -38,7 +38,7 @@ testthat::test_that("get_warnings accepts a qenv object with 2 warnings", {
 })
 
 testthat::test_that("get_warnings accepts a qenv object with a single eval_code returning 2 warnings", {
-  q <- qenv() %>% eval_code(quote({
+  q <- eval_code(qenv(), quote({
     warning("This is a warning 1!")
     warning("This is a warning 2!")
   }))
@@ -63,9 +63,9 @@ testthat::test_that("get_warnings accepts a qenv object with a single eval_code
 })
 
 testthat::test_that("get_warnings accepts a qenv object with 1 warning eval_code and 1 no warning eval_code", {
-  q <- qenv() %>%
-    eval_code(quote("x <- 1")) %>%
-    eval_code(quote(warning("This is a warning 2!")))
+  q <- qenv()
+  q <- eval_code(q, quote("x <- 1"))
+  q <- eval_code(q, quote(warning("This is a warning 2!")))
   testthat::expect_identical(
     get_warnings(q),
     paste0(

From 4da6f657b65d0b7ba40cb95e69ba3f71a0bd0ce7 Mon Sep 17 00:00:00 2001
From: m7pr <marcin.kosinski.mk1@roche.com>
Date: Fri, 8 Nov 2024 09:24:26 +0100
Subject: [PATCH 85/98] fix lintr

---
 R/qenv-eval_code.R            | 1 -
 R/utils-get_code_dependency.R | 4 ++--
 vignettes/qenv.Rmd            | 2 +-
 3 files changed, 3 insertions(+), 4 deletions(-)

diff --git a/R/qenv-eval_code.R b/R/qenv-eval_code.R
index 8fbb1084..c745ee2f 100644
--- a/R/qenv-eval_code.R
+++ b/R/qenv-eval_code.R
@@ -119,6 +119,5 @@ setMethod("eval_code", signature = c("qenv.error", "ANY"), function(object, code
 }
 
 get_code_attr <- function(qenv, attr) {
-  # unlist(lapply(qenv@code, attr, attr)) # somehow doesn't work
   unlist(lapply(qenv@code, function(x) attr(x, attr)))
 }
diff --git a/R/utils-get_code_dependency.R b/R/utils-get_code_dependency.R
index 0d2c9043..744d0210 100644
--- a/R/utils-get_code_dependency.R
+++ b/R/utils-get_code_dependency.R
@@ -229,7 +229,7 @@ extract_occurrence <- function(pd) {
       if (length(params > 1)) {
         remove <- integer(0)
         for (i in 2:length(params)) {
-          if (params[i - 1] == "=" & params[i] == ",") {
+          if (params[i - 1] == "=" && params[i] == ",") {
             remove <- c(remove, i - 1, i)
           }
         }
@@ -328,7 +328,7 @@ extract_dependency <- function(parsed_code) {
     # extract_calls is needed to reorder the pd so that assignment operator comes before symbol names
     # extract_calls is needed also to substitute assignment operators into specific format with fix_arrows
     # extract_calls is needed to omit empty calls that contain only one token `"';'"`
-    # This cleaning is needed as extract_occurrence assumes arrows are fixed, and order is different than in original pd.
+    # This cleaning is needed as extract_occurrence assumes arrows are fixed, and order is different than in original pd
     c(extract_side_effects(reordered_pd[[1]]), extract_occurrence(reordered_pd[[1]]))
   }
 }
diff --git a/vignettes/qenv.Rmd b/vignettes/qenv.Rmd
index 903aad4c..215c81dd 100644
--- a/vignettes/qenv.Rmd
+++ b/vignettes/qenv.Rmd
@@ -126,7 +126,7 @@ In cases where warnings or messages arise while evaluating code within a `qenv`
 
 ```{r}
 q_message <- eval_code(qenv(), quote(message("this is a message")))
-# get_messages(q_message) # TODO - this function does not exist
+# TODO: this function does not exist yet get_messages(q_message)
 
 q_warning <- eval_code(qenv(), quote(warning("and this is a warning")))
 get_warnings(q_warning)

From ffa54c8cb7be3e0e285ce72286a4240663b55470 Mon Sep 17 00:00:00 2001
From: m7pr <marcin.kosinski.mk1@roche.com>
Date: Fri, 8 Nov 2024 09:57:18 +0100
Subject: [PATCH 86/98] allow to pass ... trhough [. to get_code_dependency -
 needed in teal.data

---
 R/qenv-extract.R | 5 +++--
 man/qenv.Rd      | 7 ++++---
 2 files changed, 7 insertions(+), 5 deletions(-)

diff --git a/R/qenv-extract.R b/R/qenv-extract.R
index fe35ac79..31437fd3 100644
--- a/R/qenv-extract.R
+++ b/R/qenv-extract.R
@@ -1,6 +1,7 @@
 #'
 #' @section Subsetting:
 #' `x[names]` subsets objects in `qenv` environment and limit the code to the necessary needed to build limited objects.
+#' `...` passes parameters to further methods.
 #'
 #' @param x (`qenv`)
 #'
@@ -15,7 +16,7 @@
 #' @rdname qenv
 #'
 #' @export
-`[.qenv` <- function(x, names) {
+`[.qenv` <- function(x, names, ...) {
   checkmate::assert_class(names, "character")
   possible_names <- ls(get_env(x), all.names = TRUE)
   names_warn <- setdiff(names, possible_names)
@@ -43,7 +44,7 @@
 
   x@env <- list2env(mget(x = names, envir = get_env(x)))
   names <- gsub("^`(.*)`$", "\\1", names)
-  x@code <- get_code_dependency(x@code, names = names)
+  x@code <- get_code_dependency(x@code, names = names, ...)
 
   x
 }
diff --git a/man/qenv.Rd b/man/qenv.Rd
index 63b95576..1f9300e3 100644
--- a/man/qenv.Rd
+++ b/man/qenv.Rd
@@ -19,7 +19,7 @@ qenv()
 
 eval_code(object, code)
 
-\method{[}{qenv}(x, names)
+\method{[}{qenv}(x, names, ...)
 
 get_code(object, deparse = TRUE, names = NULL, ...)
 
@@ -36,10 +36,10 @@ get_code(object, deparse = TRUE, names = NULL, ...)
 are skipped. For \code{get_code} \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} vector of object names to return the code for.
 For more details see the "Extracting dataset-specific code" section.}
 
-\item{deparse}{(\code{logical(1)}) flag specifying whether to return code as \code{character} or \code{expression}.}
-
 \item{...}{see \code{Details}}
 
+\item{deparse}{(\code{logical(1)}) flag specifying whether to return code as \code{character} or \code{expression}.}
+
 \item{data}{(\code{qenv})}
 
 \item{expr}{(\code{expression}) to evaluate. Must be inline code, see \verb{Using language objects...}}
@@ -76,6 +76,7 @@ as \code{name:value} pairs are passed to \code{...}, \code{name} in \code{expr}
 \section{Subsetting}{
 
 \code{x[names]} subsets objects in \code{qenv} environment and limit the code to the necessary needed to build limited objects.
+\code{...} passes parameters to further methods.
 }
 
 \section{Extracting dataset-specific code}{

From 7f801563699bc772b8bd52f1c13c145b62a1a430 Mon Sep 17 00:00:00 2001
From: go_gonzo <dawid.kaledkowski@gmail.com>
Date: Fri, 8 Nov 2024 10:23:35 +0100
Subject: [PATCH 87/98] fixes #217

---
 DESCRIPTION                             |   1 +
 NAMESPACE                               |   1 +
 R/qenv-get_code.R                       |  13 +-
 R/qenv-get_env.R                        |   6 +-
 R/qenv-get_messages.r                   |  60 ++++
 R/qenv-get_var.R                        |   3 +-
 R/qenv-get_warnings.R                   |  32 +-
 R/qenv-join.R                           |  13 +-
 R/utils-get_code_dependency.R           |   8 +-
 man/get_env.Rd                          |   6 +-
 man/get_messages.Rd                     |  30 ++
 man/join.Rd                             |  13 +-
 man/qenv.Rd                             |   6 +-
 tests/testthat/test-qenv_eval_code.R    |   6 +-
 tests/testthat/test-qenv_get_code.R     | 413 ++++++++++++------------
 tests/testthat/test-qenv_get_messages.R |  76 +++++
 vignettes/qenv.Rmd                      |   2 +-
 17 files changed, 415 insertions(+), 274 deletions(-)
 create mode 100644 R/qenv-get_messages.r
 create mode 100644 man/get_messages.Rd
 create mode 100644 tests/testthat/test-qenv_get_messages.R

diff --git a/DESCRIPTION b/DESCRIPTION
index 7a1ccff3..9914b342 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -61,6 +61,7 @@ Collate:
     'qenv-extract.R'
     'qenv-get_code.R'
     'qenv-get_env.R'
+    'qenv-get_messages.r'
     'qenv-get_var.R'
     'qenv-get_warnings.R'
     'qenv-join.R'
diff --git a/NAMESPACE b/NAMESPACE
index ae0230a9..4f481f33 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -9,6 +9,7 @@ export(dev_suppress)
 export(eval_code)
 export(get_code)
 export(get_env)
+export(get_messages)
 export(get_var)
 export(get_warnings)
 export(join)
diff --git a/R/qenv-get_code.R b/R/qenv-get_code.R
index 8daf1410..c52bf69a 100644
--- a/R/qenv-get_code.R
+++ b/R/qenv-get_code.R
@@ -9,8 +9,8 @@
 #'
 #'
 #' @section Extracting dataset-specific code:
-#' When `names` for `get_code` is specified, the code returned will be limited  to the lines needed to _create_
-#' the requested objects. The code stored in the `@code` slot is analyzed statically to determine
+#' When `names` for `get_code` is specified, the code returned will be limited to the lines needed to _create_
+#' the requested objects. The code stored in the `qenv` is analyzed statically to determine
 #' which lines the objects of interest depend upon. The analysis works well when objects are created
 #' with standard infix assignment operators (see `?assignOps`) but it can fail in some situations.
 #'
@@ -74,7 +74,7 @@
 #' - creating and evaluating language objects, _e.g._ `eval(<call>)`
 #'
 #' @return
-#' `get_code` returns the traced code (from `@code` slot) in the form specified by `deparse`.
+#' `get_code` returns the traced code in the form specified by `deparse`.
 #'
 #' @examples
 #' # retrieve code
@@ -97,12 +97,7 @@
 #'
 #' @export
 setGeneric("get_code", function(object, deparse = TRUE, names = NULL, ...) {
-  # this line forces evaluation of object before passing to the generic
-  # needed for error handling to work properly
-  grDevices::pdf(nullfile())
-  on.exit(grDevices::dev.off())
-  object
-
+  dev_suppress(object)
   standardGeneric("get_code")
 })
 
diff --git a/R/qenv-get_env.R b/R/qenv-get_env.R
index 0d8074b9..1f849578 100644
--- a/R/qenv-get_env.R
+++ b/R/qenv-get_env.R
@@ -1,10 +1,10 @@
 #' Access environment included in `qenv`
 #'
-#' The access of environment included in `qenv@env` allows to e.g. list object names included in `qenv@env` slot.
+#' The access of environment included in the `qenv` that contains all data objects.
 #'
-#' @param object (`qenv`)
+#' @param object (`qenv`).
 #'
-#' @return An `environment` stored in `qenv@env` slot.
+#' @return An `environment` stored in `qenv` with all data objects.
 #'
 #' @examples
 #' q <- qenv()
diff --git a/R/qenv-get_messages.r b/R/qenv-get_messages.r
new file mode 100644
index 00000000..2fd500a4
--- /dev/null
+++ b/R/qenv-get_messages.r
@@ -0,0 +1,60 @@
+#' Get messages from `qenv` object
+#'
+#' Retrieve all messages raised during code evaluation in a `qenv`.
+#'
+#' @param object (`qenv`)
+#'
+#' @return `character` containing warning information or `NULL` if no messages.
+#'
+#' @examples
+#' data_q <- qenv()
+#' data_q <- eval_code(data_q, "iris_data <- iris")
+#' warning_qenv <- eval_code(
+#'   data_q,
+#'   bquote(p <- hist(iris_data[, .("Sepal.Length")], ff = ""))
+#' )
+#' cat(get_messages(warning_qenv))
+#'
+#' @name get_messages
+#' @rdname get_messages
+#' @aliases get_messages,qenv-method
+#' @aliases get_messages,qenv.error-method
+#' @aliases get_messages,NULL-method
+#'
+#' @export
+setGeneric("get_messages", function(object) {
+  dev_suppress(object)
+  standardGeneric("get_messages")
+})
+
+setMethod("get_messages", signature = "qenv", function(object) {
+  messages <- lapply(object@code, "attr", "message")
+  idx_warn <- which(sapply(messages, function(x) !is.null(x) && !identical(x, "")))
+  if (!any(idx_warn)) {
+    return(NULL)
+  }
+  messages <- messages[idx_warn]
+  code <- object@code[idx_warn]
+
+  lines <- mapply(
+    function(warn, expr) {
+      sprintf("%swhen running code:\n%s", warn, expr)
+    },
+    warn = messages,
+    expr = code
+  )
+
+  sprintf(
+    "~~~ messages ~~~\n\n%s\n\n~~~ Trace ~~~\n\n%s",
+    paste(lines, collapse = "\n\n"),
+    paste(get_code(object), collapse = "\n")
+  )
+})
+
+setMethod("get_messages", signature = "qenv.error", function(object) {
+  NULL
+})
+
+setMethod("get_messages", "NULL", function(object) {
+  NULL
+})
diff --git a/R/qenv-get_var.R b/R/qenv-get_var.R
index 152b67a4..4ab8f9c3 100644
--- a/R/qenv-get_var.R
+++ b/R/qenv-get_var.R
@@ -21,8 +21,7 @@
 #'
 #' @export
 setGeneric("get_var", function(object, var) {
-  grDevices::pdf(nullfile())
-  on.exit(grDevices::dev.off())
+  dev_suppress(object)
   standardGeneric("get_var")
 })
 
diff --git a/R/qenv-get_warnings.R b/R/qenv-get_warnings.R
index db99afc4..b3d102fb 100644
--- a/R/qenv-get_warnings.R
+++ b/R/qenv-get_warnings.R
@@ -23,43 +23,35 @@
 #'
 #' @export
 setGeneric("get_warnings", function(object) {
-  # this line forces evaluation of object before passing to the generic
-  # needed for error handling to work properly
-  grDevices::pdf(nullfile())
-  on.exit(grDevices::dev.off())
-  object
-
+  dev_suppress(object)
   standardGeneric("get_warnings")
 })
 
-setMethod("get_warnings", signature = c("qenv"), function(object) {
+setMethod("get_warnings", signature = "qenv", function(object) {
   warnings <- lapply(object@code, "attr", "warning")
-  idx_warn <- which(sapply(warnings, Negate(is.null)))
-  warnings <- warnings[idx_warn]
-  code <- object@code[idx_warn]
-  if (length(warnings) == 0) {
+  idx_warn <- which(sapply(warnings, function(x) !is.null(x) && !identical(x, "")))
+  if (!any(idx_warn)) {
     return(NULL)
   }
+  warnings <- warnings[idx_warn]
+  code <- object@code[idx_warn]
 
   lines <- mapply(
     function(warn, expr) {
-      if (warn == "") {
-        return(NULL)
-      }
-      sprintf("%swhen running code:\n%s", warn, paste(lang2calls(expr), collapse = "\n"))
+      sprintf("%swhen running code:\n%s", warn, expr)
     },
     warn = warnings,
     expr = code
   )
-  lines <- Filter(Negate(is.null), lines)
 
-  paste0(
-    sprintf("~~~ Warnings ~~~\n\n%s\n\n", paste(lines, collapse = "\n\n")),
-    sprintf("~~~ Trace ~~~\n\n%s", paste(get_code(object), collapse = "\n"))
+  sprintf(
+    "~~~ Warnings ~~~\n\n%s\n\n~~~ Trace ~~~\n\n%s",
+    paste(lines, collapse = "\n\n"),
+    paste(get_code(object), collapse = "\n")
   )
 })
 
-setMethod("get_warnings", signature = c("qenv.error"), function(object) {
+setMethod("get_warnings", signature = "qenv.error", function(object) {
   NULL
 })
 
diff --git a/R/qenv-join.R b/R/qenv-join.R
index 6b98cb96..b72797de 100644
--- a/R/qenv-join.R
+++ b/R/qenv-join.R
@@ -21,8 +21,8 @@
 #'    In this example, `mtcars1` object exists in both `x` and `y` objects but the content are not identical.
 #'    `mtcars1` in the `x qenv` object has more columns than `mtcars1` in the `y qenv` object (only has one column).
 #'
-#' 2. `join()` will look for identical `@id` values in both `qenv` objects.
-#'    The index position of these `@id`s must be the same to determine the evaluation order.
+#' 2. `join()` will look for identical code elements in both `qenv` objects.
+#'    The index position of these code elements must be the same to determine the evaluation order.
 #'    Otherwise, `join()` will throw an error message.
 #'
 #'    Example:
@@ -45,11 +45,8 @@
 #'    # Error message will occur
 #'
 #'    # Check the order of evaluation based on the id slot
-#'    shared_ids <- intersect(q@id, z@id)
-#'    match(shared_ids, q@id) # Output: 1 3
-#'    match(shared_ids, z@id) # Output: 1 2
 #'    ```
-#'    The error occurs because the index position of identical `@id` between the two objects is not the same.
+#'    The error occurs because the index position of common code elements in the two objects is not the same.
 #'
 #' 3. The usage of temporary variable in the code expression could cause `join()` to fail.
 #'
@@ -72,10 +69,6 @@
 #'    )
 #'    q <- join(x,y)
 #'    # Error message will occur
-#'
-#'    # Check the value of temporary variable i in both objects
-#'    x@env$i # Output: 2
-#'    y@env$i # Output: 3
 #'    ```
 #'    `join()` fails to provide a proper result because of the temporary variable `i` exists
 #'    in both objects but has different value.
diff --git a/R/utils-get_code_dependency.R b/R/utils-get_code_dependency.R
index 744d0210..5fe6e267 100644
--- a/R/utils-get_code_dependency.R
+++ b/R/utils-get_code_dependency.R
@@ -29,10 +29,6 @@ get_code_dependency <- function(code, names, check_names = TRUE) {
   checkmate::assert_list(code, "character")
   checkmate::assert_character(names, any.missing = FALSE)
 
-  if (length(code) == 0) {
-    return(code)
-  }
-
   graph <- lapply(code, attr, "dependency")
 
   if (check_names) {
@@ -46,6 +42,10 @@ get_code_dependency <- function(code, names, check_names = TRUE) {
     }
   }
 
+  if (length(code) == 0) {
+    return(code)
+  }
+
   ind <- unlist(lapply(names, function(x) graph_parser(x, graph)))
 
   lib_ind <- detect_libraries(graph)
diff --git a/man/get_env.Rd b/man/get_env.Rd
index b6e86a34..044e96ce 100644
--- a/man/get_env.Rd
+++ b/man/get_env.Rd
@@ -9,13 +9,13 @@
 get_env(object)
 }
 \arguments{
-\item{object}{(\code{qenv})}
+\item{object}{(\code{qenv}).}
 }
 \value{
-An \code{environment} stored in \code{qenv@env} slot.
+An \code{environment} stored in \code{qenv} with all data objects.
 }
 \description{
-The access of environment included in \code{qenv@env} allows to e.g. list object names included in \code{qenv@env} slot.
+The access of environment included in the \code{qenv} that contains all data objects.
 }
 \examples{
 q <- qenv()
diff --git a/man/get_messages.Rd b/man/get_messages.Rd
new file mode 100644
index 00000000..e54be79d
--- /dev/null
+++ b/man/get_messages.Rd
@@ -0,0 +1,30 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/qenv-get_messages.r
+\name{get_messages}
+\alias{get_messages}
+\alias{get_messages,qenv-method}
+\alias{get_messages,qenv.error-method}
+\alias{get_messages,NULL-method}
+\title{Get messages from \code{qenv} object}
+\usage{
+get_messages(object)
+}
+\arguments{
+\item{object}{(\code{qenv})}
+}
+\value{
+\code{character} containing warning information or \code{NULL} if no messages.
+}
+\description{
+Retrieve all messages raised during code evaluation in a \code{qenv}.
+}
+\examples{
+data_q <- qenv()
+data_q <- eval_code(data_q, "iris_data <- iris")
+warning_qenv <- eval_code(
+  data_q,
+  bquote(p <- hist(iris_data[, .("Sepal.Length")], ff = ""))
+)
+cat(get_messages(warning_qenv))
+
+}
diff --git a/man/join.Rd b/man/join.Rd
index 40f60d0c..26f4bfc8 100644
--- a/man/join.Rd
+++ b/man/join.Rd
@@ -40,8 +40,8 @@ z <- join(x, y)
 
 In this example, \code{mtcars1} object exists in both \code{x} and \code{y} objects but the content are not identical.
 \code{mtcars1} in the \verb{x qenv} object has more columns than \code{mtcars1} in the \verb{y qenv} object (only has one column).
-\item \code{join()} will look for identical \verb{@id} values in both \code{qenv} objects.
-The index position of these \verb{@id}s must be the same to determine the evaluation order.
+\item \code{join()} will look for identical code elements in both \code{qenv} objects.
+The index position of these code elements must be the same to determine the evaluation order.
 Otherwise, \code{join()} will throw an error message.
 
 Example:
@@ -64,12 +64,9 @@ join_q <- join(q, z)
 # Error message will occur
 
 # Check the order of evaluation based on the id slot
-shared_ids <- intersect(q@id, z@id)
-match(shared_ids, q@id) # Output: 1 3
-match(shared_ids, z@id) # Output: 1 2
 }\if{html}{\out{</div>}}
 
-The error occurs because the index position of identical \verb{@id} between the two objects is not the same.
+The error occurs because the index position of common code elements in the two objects is not the same.
 \item The usage of temporary variable in the code expression could cause \code{join()} to fail.
 
 Example:
@@ -91,10 +88,6 @@ y <- eval_code(
 )
 q <- join(x,y)
 # Error message will occur
-
-# Check the value of temporary variable i in both objects
-x@env$i # Output: 2
-y@env$i # Output: 3
 }\if{html}{\out{</div>}}
 
 \code{join()} fails to provide a proper result because of the temporary variable \code{i} exists
diff --git a/man/qenv.Rd b/man/qenv.Rd
index 1f9300e3..c65d6913 100644
--- a/man/qenv.Rd
+++ b/man/qenv.Rd
@@ -49,7 +49,7 @@ Returns a \code{qenv} object.
 
 \code{eval_code} returns a \code{qenv} object with \code{expr} evaluated or \code{qenv.error} if evaluation fails.
 
-\code{get_code} returns the traced code (from \verb{@code} slot) in the form specified by \code{deparse}.
+\code{get_code} returns the traced code in the form specified by \code{deparse}.
 
 \code{within} returns a \code{qenv} object with \code{expr} evaluated or \code{qenv.error} if evaluation fails.
 }
@@ -81,8 +81,8 @@ as \code{name:value} pairs are passed to \code{...}, \code{name} in \code{expr}
 
 \section{Extracting dataset-specific code}{
 
-When \code{names} for \code{get_code} is specified, the code returned will be limited  to the lines needed to \emph{create}
-the requested objects. The code stored in the \verb{@code} slot is analyzed statically to determine
+When \code{names} for \code{get_code} is specified, the code returned will be limited to the lines needed to \emph{create}
+the requested objects. The code stored in the \code{qenv} is analyzed statically to determine
 which lines the objects of interest depend upon. The analysis works well when objects are created
 with standard infix assignment operators (see \code{?assignOps}) but it can fail in some situations.
 
diff --git a/tests/testthat/test-qenv_eval_code.R b/tests/testthat/test-qenv_eval_code.R
index b97332ab..651697e9 100644
--- a/tests/testthat/test-qenv_eval_code.R
+++ b/tests/testthat/test-qenv_eval_code.R
@@ -94,12 +94,12 @@ testthat::test_that("an error when calling eval_code returns a qenv.error object
 testthat::test_that(
   "a warning when calling eval_code returns a qenv object which has warnings as attributes of code",
   {
-    q <- eval_code(qenv(), quote("iris_data <- iris"))
-    q <- eval_code(q, quote("p <- hist(iris_data[, 'Sepal.Length'], ff = '')"))
+    q <- eval_code(qenv(), quote(iris_data <- iris))
+    q <- eval_code(q, quote(warning("this is a warning")))
     testthat::expect_s4_class(q, "qenv")
     testthat::expect_equal(
       lapply(q@code, attr, "warning"),
-      list(NULL, "> \"ff\" is not a graphical parameter\n")
+      list(NULL, "> this is a warning\n")
     )
   }
 )
diff --git a/tests/testthat/test-qenv_get_code.R b/tests/testthat/test-qenv_get_code.R
index 9d619a32..96241c44 100644
--- a/tests/testthat/test-qenv_get_code.R
+++ b/tests/testthat/test-qenv_get_code.R
@@ -1,4 +1,4 @@
-pasten <- function(...) paste(..., collapse = "\n")
+pasten <<- function(...) paste(..., collapse = "\n")
 
 testthat::test_that("get_code returns code (character by default) of qenv object", {
   q <- qenv()
@@ -62,237 +62,238 @@ testthat::test_that("get_code returns code with comments and empty spaces", {
 })
 
 # names parameter -------------------------------------------------------------------------------------------------
+testthat::describe("get_code for specific names", {
+  testthat::it("warns if empty @code slot", {
+    testthat::expect_warning(
+      testthat::expect_identical(
+        get_code(qenv(), names = "a"),
+        ""
+      ),
+      "not found in code"
+    )
+  })
 
-testthat::test_that("handles empty @code slot", {
-  testthat::expect_equal(
-    get_code(qenv(), names = "a"),
-    ""
-  )
-  testthat::expect_equal(
-    get_code(eval_code(qenv(), code = ""), names = "a"),
-    ""
-  )
-})
-
-testthat::test_that("handles the code without symbols on rhs", {
-  code <- c(
-    "1 + 1",
-    "a <- 5",
-    "501"
-  )
-
-  testthat::expect_identical(
-    get_code(eval_code(qenv(), code), names = "a"),
-    "a <- 5"
-  )
-})
+  testthat::it("handles the code without symbols on rhs", {
+    code <- c(
+      "1 + 1",
+      "a <- 5",
+      "501"
+    )
 
-testthat::test_that("handles the code included in curly brackets", {
-  code <- "{1 + 1;a <- 5}"
+    testthat::expect_identical(
+      get_code(eval_code(qenv(), code), names = "a"),
+      "a <- 5"
+    )
+  })
 
-  testthat::skip("SHOULD THIS BE FIXED? it gives the whole code {1 + 1;a <- 5}")
-  testthat::expect_identical(
-    get_code(eval_code(qenv(), code), names = "a"),
-    "a <- 5"
-  )
-})
+  testthat::it("handles the code included in curly brackets", {
+    code <- "{1 + 1;a <- 5}"
 
-testthat::test_that("handles the code of length > 1 when at least one is enclosed in curly brackets", {
-  code <- c("{a<-5}", "1+1")
-  q <- eval_code(eval_code(qenv(), code[1]), code[2])
+    testthat::skip("SHOULD THIS BE FIXED? it gives the whole code {1 + 1;a <- 5}")
+    testthat::expect_identical(
+      get_code(eval_code(qenv(), code), names = "a"),
+      "a <- 5"
+    )
+  })
 
-  testthat::expect_identical(
-    get_code(q, names = "a"),
-    "{a<-5}"
-  )
-})
+  testthat::it("handles the code of length > 1 when at least one is enclosed in curly brackets", {
+    code <- c("{a<-5}", "1+1")
+    q <- eval_code(eval_code(qenv(), code[1]), code[2])
 
-testthat::test_that("extracts the code of a binding from character vector containing simple code", {
-  code <- c(
-    "a <- 1",
-    "b <- 2"
-  )
-  q <- eval_code(qenv(), code)
-  testthat::expect_identical(
-    get_code(q, names = "a"),
-    "a <- 1"
-  )
-  testthat::expect_identical(
-    get_code(q, names = "b"),
-    "b <- 2"
-  )
-})
+    testthat::expect_identical(
+      get_code(q, names = "a"),
+      "{a<-5}"
+    )
+  })
 
-testthat::test_that("extracts the code without downstream usage", {
-  code <- c(
-    "a <- 1",
-    "head(a)"
-  )
-  q <- eval_code(qenv(), code)
-  testthat::expect_identical(
-    get_code(q, names = "a"),
-    "a <- 1"
-  )
-})
+  testthat::it("extracts the code of a binding from character vector containing simple code", {
+    code <- c(
+      "a <- 1",
+      "b <- 2"
+    )
+    q <- eval_code(qenv(), code)
+    testthat::expect_identical(
+      get_code(q, names = "a"),
+      "a <- 1"
+    )
+    testthat::expect_identical(
+      get_code(q, names = "b"),
+      "b <- 2"
+    )
+  })
 
-testthat::test_that("works for names of length > 1", {
-  code <- c(
-    "a <- 1",
-    "b <- 2"
-  )
-  q <- eval_code(qenv(), code)
-  testthat::expect_identical(
-    get_code(q, names = c("a", "b")),
-    pasten(code)
-  )
-})
+  testthat::it("extracts the code without downstream usage", {
+    code <- c(
+      "a <- 1",
+      "head(a)"
+    )
+    q <- eval_code(qenv(), code)
+    testthat::expect_identical(
+      get_code(q, names = "a"),
+      "a <- 1"
+    )
+  })
 
-testthat::test_that("warns if binding doesn't exist in code", {
-  code <- c("a <- 1")
-  q <- eval_code(qenv(), code)
-  testthat::expect_warning(
-    get_code(q, names = "c"),
-    "Object\\(s\\) not found in code: c"
-  )
-})
+  testthat::it("works for names of length > 1", {
+    code <- c(
+      "a <- 1",
+      "b <- 2"
+    )
+    q <- eval_code(qenv(), code)
+    testthat::expect_identical(
+      get_code(q, names = c("a", "b")),
+      pasten(code)
+    )
+  })
 
-testthat::test_that("does not fall into a loop", {
-  code <- c(
-    "a <- 1",
-    "b <- a",
-    "c <- b",
-    "a <- c"
-  )
-  q <- eval_code(qenv(), code)
-  testthat::expect_identical(
-    get_code(q, names = "a"),
-    pasten(code)
-  )
-  testthat::expect_identical(
-    get_code(q, names = "b"),
-    pasten(code[1:2])
-  )
-  testthat::expect_identical(
-    get_code(q, names = "c"),
-    pasten(code[1:3])
-  )
-})
+  testthat::it("warns if binding doesn't exist in code", {
+    code <- c("a <- 1")
+    q <- eval_code(qenv(), code)
+    testthat::expect_warning(
+      get_code(q, names = "c"),
+      "Object\\(s\\) not found in code: c"
+    )
+  })
 
-testthat::test_that("extracts code of a parent binding but only those evaluated before coocurence", {
-  code <- c(
-    "a <- 1",
-    "b <- a",
-    "a <- 2"
-  )
-  q <- eval_code(qenv(), code)
-  testthat::expect_identical(
-    get_code(q, names = "b"),
-    pasten(c("a <- 1", "b <- a"))
-  )
-})
+  testthat::it("does not fall into a loop", {
+    code <- c(
+      "a <- 1",
+      "b <- a",
+      "c <- b",
+      "a <- c"
+    )
+    q <- eval_code(qenv(), code)
+    testthat::expect_identical(
+      get_code(q, names = "a"),
+      pasten(code)
+    )
+    testthat::expect_identical(
+      get_code(q, names = "b"),
+      pasten(code[1:2])
+    )
+    testthat::expect_identical(
+      get_code(q, names = "c"),
+      pasten(code[1:3])
+    )
+  })
 
-testthat::test_that("extracts the code of a parent binding if used as an arg in a function call", {
-  code <- c(
-    "a <- 1",
-    "b <- identity(x = a)",
-    "a <- 2"
-  )
-  q <- eval_code(qenv(), code)
-  testthat::expect_identical(
-    get_code(q, names = "b"),
-    pasten(c("a <- 1", "b <- identity(x = a)"))
-  )
-})
+  testthat::it("extracts code of a parent binding but only those evaluated before coocurence", {
+    code <- c(
+      "a <- 1",
+      "b <- a",
+      "a <- 2"
+    )
+    q <- eval_code(qenv(), code)
+    testthat::expect_identical(
+      get_code(q, names = "b"),
+      pasten(c("a <- 1", "b <- a"))
+    )
+  })
 
-testthat::test_that("extracts the code when using <<-", {
-  code <- c(
-    "a <- 1",
-    "b <- a",
-    "b <<- b + 2"
-  )
-  q <- eval_code(qenv(), code)
-  testthat::expect_identical(
-    get_code(q, names = "b"),
-    pasten(c("a <- 1", "b <- a", "b <<- b + 2"))
-  )
-})
+  testthat::it("extracts the code of a parent binding if used as an arg in a function call", {
+    code <- c(
+      "a <- 1",
+      "b <- identity(x = a)",
+      "a <- 2"
+    )
+    q <- eval_code(qenv(), code)
+    testthat::expect_identical(
+      get_code(q, names = "b"),
+      pasten(c("a <- 1", "b <- identity(x = a)"))
+    )
+  })
 
-testthat::test_that("detects every assign calls even if not evaluated, if there is only one assignment in this line", {
-  code <- c(
-    "a <- 1",
-    "b <- 2",
-    "eval(expression({b <- b + 2}))"
-  )
-  q <- eval_code(qenv(), code)
-  testthat::expect_identical(
-    get_code(q, names = "b"),
-    pasten(code[2:3])
-  )
-})
+  testthat::it("extracts the code when using <<-", {
+    code <- c(
+      "a <- 1",
+      "b <- a",
+      "b <<- b + 2"
+    )
+    q <- eval_code(qenv(), code)
+    testthat::expect_identical(
+      get_code(q, names = "b"),
+      pasten(c("a <- 1", "b <- a", "b <<- b + 2"))
+    )
+  })
 
-testthat::test_that("returns result of length 1 for non-empty input and deparse = FALSE", {
-  q1 <- qenv()
-  q1 <- within(q1, {
-    a <- 1
-    b <- a^5
-    c <- list(x = 2)
+  testthat::it("detects every assign calls even if not evaluated, if there is only one assignment in this line", {
+    code <- c(
+      "a <- 1",
+      "b <- 2",
+      "eval(expression({b <- b + 2}))"
+    )
+    q <- eval_code(qenv(), code)
+    testthat::expect_identical(
+      get_code(q, names = "b"),
+      pasten(code[2:3])
+    )
   })
 
-  testthat::expect_length(get_code(q1, deparse = FALSE), 1)
-})
+  testthat::it("returns result of length 1 for non-empty input and deparse = FALSE", {
+    q1 <- qenv()
+    q1 <- within(q1, {
+      a <- 1
+      b <- a^5
+      c <- list(x = 2)
+    })
 
-testthat::test_that("does not break if code is separated by ;", {
-  code <- c(
-    "a <- 1;a <- a + 1"
-  )
-  q <- eval_code(qenv(), code)
-  testthat::expect_identical(
-    get_code(q, names = "a"),
-    code
-  )
-})
+    testthat::expect_length(get_code(q1, deparse = FALSE), 1)
+  })
 
-testthat::test_that("does not break if code uses quote()", {
-  code <- c(
-    "expr <- quote(x <- x + 1)",
-    "x <- 0",
-    "eval(expr)"
-  )
-  q <- eval_code(qenv(), code)
-  testthat::expect_identical(
-    get_code(q, names = "x"),
-    code[2]
-  )
-})
+  testthat::it("does not break if code is separated by ;", {
+    code <- c(
+      "a <- 1;a <- a + 1"
+    )
+    q <- eval_code(qenv(), code)
+    testthat::expect_identical(
+      get_code(q, names = "a"),
+      code
+    )
+  })
 
-testthat::test_that("does not break if object is used in a function on lhs", {
-  code <- c(
-    "data(iris)",
-    "iris2 <- iris",
-    "names(iris) <- letters[1:5]"
-  )
-  q <- eval_code(qenv(), code = code)
-  testthat::expect_identical(
-    get_code(q, names = "iris"),
-    pasten(code[c(1, 3)])
-  )
-})
+  testthat::it("does not break if code uses quote()", {
+    code <- c(
+      "expr <- quote(x <- x + 1)",
+      "x <- 0",
+      "eval(expr)"
+    )
+    q <- eval_code(qenv(), code)
+    testthat::expect_identical(
+      get_code(q, names = "x"),
+      code[2]
+    )
+  })
 
-testthat::test_that(
-  "does not break if object is used in a function on lhs and influencers are both on lhs and rhs",
-  {
+  testthat::it("does not break if object is used in a function on lhs", {
     code <- c(
-      "x <- 5",
-      "y <- length(x)",
-      "names(x)[y] <- y"
+      "data(iris)",
+      "iris2 <- iris",
+      "names(iris) <- letters[1:5]"
     )
     q <- eval_code(qenv(), code = code)
     testthat::expect_identical(
-      get_code(q, names = "x"),
-      pasten(code)
+      get_code(q, names = "iris"),
+      pasten(code[c(1, 3)])
     )
-  }
-)
+  })
+
+  testthat::it(
+    "does not break if object is used in a function on lhs and influencers are both on lhs and rhs",
+    {
+      code <- c(
+        "x <- 5",
+        "y <- length(x)",
+        "names(x)[y] <- y"
+      )
+      q <- eval_code(qenv(), code = code)
+      testthat::expect_identical(
+        get_code(q, names = "x"),
+        pasten(code)
+      )
+    }
+  )
+})
+
 
 # assign ----------------------------------------------------------------------------------------------------------
 
diff --git a/tests/testthat/test-qenv_get_messages.R b/tests/testthat/test-qenv_get_messages.R
new file mode 100644
index 00000000..ecca0b68
--- /dev/null
+++ b/tests/testthat/test-qenv_get_messages.R
@@ -0,0 +1,76 @@
+testthat::test_that("get_messages accepts a qenv object and returns character", {
+  q <- eval_code(qenv(), quote(message("This is a message!")))
+  testthat::expect_identical(
+    get_messages(q),
+    paste0(
+      "~~~ messages ~~~\n\n> This is a message!\nwhen running code:\nmessage(\"This is a message!\")\n\n",
+      "~~~ Trace ~~~\n\nmessage(\"This is a message!\")"
+    )
+  )
+})
+
+testthat::test_that("get_messages accepts a qenv.error object and returns NULL", {
+  q <- eval_code(qenv(), quote(error("This is a error!")))
+  testthat::expect_null(get_messages(q))
+})
+
+testthat::test_that("get_messages accepts a NULL object and returns NULL", {
+  testthat::expect_null(get_messages(NULL))
+})
+
+testthat::test_that("get_messages accepts a qenv object with no message and returns NULL", {
+  q <- eval_code(qenv(), quote("x <- 1"))
+  testthat::expect_null(get_messages(q))
+})
+
+testthat::test_that("get_messages accepts a qenv object with 2 messages", {
+  q <- qenv()
+  q <- eval_code(q, quote(message("This is a message 1!")))
+  q <- eval_code(q, quote(message("This is a message 2!")))
+  testthat::expect_identical(
+    get_messages(q),
+    paste0(
+      "~~~ messages ~~~\n\n> This is a message 1!\nwhen running code:\nmessage(\"This is a message 1!\")",
+      "\n\n> This is a message 2!\nwhen running code:\nmessage(\"This is a message 2!\")\n\n",
+      "~~~ Trace ~~~\n\nmessage(\"This is a message 1!\")\nmessage(\"This is a message 2!\")"
+    )
+  )
+})
+
+testthat::test_that("get_messages accepts a qenv object with a single eval_code returning 2 messages", {
+  q <- eval_code(qenv(), quote({
+    message("This is a message 1!")
+    message("This is a message 2!")
+  }))
+  testthat::expect_identical(
+    get_messages(q),
+    paste(
+      c(
+        "~~~ messages ~~~\n",
+        "> This is a message 1!",
+        "when running code:",
+        "message(\"This is a message 1!\")\n\n",
+        "> This is a message 2!",
+        "when running code:",
+        "message(\"This is a message 2!\")\n",
+        "~~~ Trace ~~~\n",
+        "message(\"This is a message 1!\")",
+        "message(\"This is a message 2!\")"
+      ),
+      collapse = "\n"
+    )
+  )
+})
+
+testthat::test_that("get_messages accepts a qenv object with 1 message eval_code and 1 no message eval_code", {
+  q <- qenv()
+  q <- eval_code(q, quote("x <- 1"))
+  q <- eval_code(q, quote(message("This is a message 2!")))
+  testthat::expect_identical(
+    get_messages(q),
+    paste0(
+      "~~~ messages ~~~\n\n> This is a message 2!\nwhen running code:\nmessage(\"This is a message 2!\")\n\n",
+      "~~~ Trace ~~~\n\nx <- 1\nmessage(\"This is a message 2!\")"
+    )
+  )
+})
diff --git a/vignettes/qenv.Rmd b/vignettes/qenv.Rmd
index 215c81dd..1f180bbb 100644
--- a/vignettes/qenv.Rmd
+++ b/vignettes/qenv.Rmd
@@ -126,7 +126,7 @@ In cases where warnings or messages arise while evaluating code within a `qenv`
 
 ```{r}
 q_message <- eval_code(qenv(), quote(message("this is a message")))
-# TODO: this function does not exist yet get_messages(q_message)
+get_messages(q_message)
 
 q_warning <- eval_code(qenv(), quote(warning("and this is a warning")))
 get_warnings(q_warning)

From 7cbc93d73cdc36f6b1ee8b9862ec47446e8c3a27 Mon Sep 17 00:00:00 2001
From: go_gonzo <dawid.kaledkowski@gmail.com>
Date: Fri, 8 Nov 2024 11:09:47 +0100
Subject: [PATCH 88/98] optimise get_messages/get_warnings fix pkgdown fix NEWS

---
 NEWS.md                                 |  7 +++---
 R/qenv-get_messages.r                   | 22 +-----------------
 R/qenv-get_warnings.R                   | 22 +-----------------
 R/utils.R                               | 30 +++++++++++++++++++++++++
 _pkgdown.yml                            |  1 +
 man/get_warn_message_util.Rd            | 16 +++++++++++++
 tests/testthat/test-qenv_eval_code.R    |  2 --
 tests/testthat/test-qenv_get_messages.R |  8 +++----
 8 files changed, 57 insertions(+), 51 deletions(-)
 create mode 100644 man/get_warn_message_util.Rd

diff --git a/NEWS.md b/NEWS.md
index aeccd339..978173f4 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -2,10 +2,11 @@
 
 ### Enhancements
 
+* Introduced `[.qenv` function to subset `qenv` object (code and environment) to specified object names. #211
 * `get_code()` was extended with `names` parameter and allows the code extraction to be limited to objects stored in
-`qenv` but limited to `names`.
-* `eval_code(qenv, code)` analyzes code by single calls and returns `@id`, `@code`, `@messages`, `@warnings` fields of
-the length of calls included in `code`.
+`qenv` but limited to `names`. #210
+* Introduced `get_messages()` to get messages produced during code evaluation. #217
+* `get_code()` returns original code formatting (white spaces and comments) passed to `eval_code()`. #212
 
 # teal.code 0.5.0
 
diff --git a/R/qenv-get_messages.r b/R/qenv-get_messages.r
index 2fd500a4..ece777db 100644
--- a/R/qenv-get_messages.r
+++ b/R/qenv-get_messages.r
@@ -28,27 +28,7 @@ setGeneric("get_messages", function(object) {
 })
 
 setMethod("get_messages", signature = "qenv", function(object) {
-  messages <- lapply(object@code, "attr", "message")
-  idx_warn <- which(sapply(messages, function(x) !is.null(x) && !identical(x, "")))
-  if (!any(idx_warn)) {
-    return(NULL)
-  }
-  messages <- messages[idx_warn]
-  code <- object@code[idx_warn]
-
-  lines <- mapply(
-    function(warn, expr) {
-      sprintf("%swhen running code:\n%s", warn, expr)
-    },
-    warn = messages,
-    expr = code
-  )
-
-  sprintf(
-    "~~~ messages ~~~\n\n%s\n\n~~~ Trace ~~~\n\n%s",
-    paste(lines, collapse = "\n\n"),
-    paste(get_code(object), collapse = "\n")
-  )
+  get_warn_message_util(object, "message")
 })
 
 setMethod("get_messages", signature = "qenv.error", function(object) {
diff --git a/R/qenv-get_warnings.R b/R/qenv-get_warnings.R
index b3d102fb..6113e074 100644
--- a/R/qenv-get_warnings.R
+++ b/R/qenv-get_warnings.R
@@ -28,27 +28,7 @@ setGeneric("get_warnings", function(object) {
 })
 
 setMethod("get_warnings", signature = "qenv", function(object) {
-  warnings <- lapply(object@code, "attr", "warning")
-  idx_warn <- which(sapply(warnings, function(x) !is.null(x) && !identical(x, "")))
-  if (!any(idx_warn)) {
-    return(NULL)
-  }
-  warnings <- warnings[idx_warn]
-  code <- object@code[idx_warn]
-
-  lines <- mapply(
-    function(warn, expr) {
-      sprintf("%swhen running code:\n%s", warn, expr)
-    },
-    warn = warnings,
-    expr = code
-  )
-
-  sprintf(
-    "~~~ Warnings ~~~\n\n%s\n\n~~~ Trace ~~~\n\n%s",
-    paste(lines, collapse = "\n\n"),
-    paste(get_code(object), collapse = "\n")
-  )
+  get_warn_message_util(object, "warning")
 })
 
 setMethod("get_warnings", signature = "qenv.error", function(object) {
diff --git a/R/utils.R b/R/utils.R
index 6866b775..f522bfd2 100644
--- a/R/utils.R
+++ b/R/utils.R
@@ -53,3 +53,33 @@ lang2calls <- function(x) {
     unlist(lapply(x, lang2calls), recursive = FALSE)
   }
 }
+
+#' Obtain warnings or messages from code slot
+#'
+#' @param object (`qenv`)
+#' @param what (``
+get_warn_message_util <- function(object, what) {
+  checkmate::matchArg(what, choices = c("warning", "message"))
+  messages <- lapply(object@code, "attr", what)
+  idx_warn <- which(sapply(messages, function(x) !is.null(x) && !identical(x, "")))
+  if (!any(idx_warn)) {
+    return(NULL)
+  }
+  messages <- messages[idx_warn]
+  code <- object@code[idx_warn]
+
+  lines <- mapply(
+    warn = messages,
+    expr = code,
+    function(warn, expr) {
+      sprintf("%swhen running code:\n%s", warn, expr)
+    }
+  )
+
+  sprintf(
+    "~~~ %ss ~~~\n\n%s\n\n~~~ Trace ~~~\n\n%s",
+    tools::toTitleCase(what),
+    paste(lines, collapse = "\n\n"),
+    paste(get_code(object), collapse = "\n")
+  )
+}
diff --git a/_pkgdown.yml b/_pkgdown.yml
index 8e38b126..7837af58 100644
--- a/_pkgdown.yml
+++ b/_pkgdown.yml
@@ -32,6 +32,7 @@ reference:
       - get_code
       - get_env
       - get_var
+      - get_messages
       - get_warnings
       - join
       - qenv
diff --git a/man/get_warn_message_util.Rd b/man/get_warn_message_util.Rd
new file mode 100644
index 00000000..0850b9f5
--- /dev/null
+++ b/man/get_warn_message_util.Rd
@@ -0,0 +1,16 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/utils.R
+\name{get_warn_message_util}
+\alias{get_warn_message_util}
+\title{Obtain warnings or messages from code slot}
+\usage{
+get_warn_message_util(object, what)
+}
+\arguments{
+\item{object}{(\code{qenv})}
+
+\item{what}{(``}
+}
+\description{
+Obtain warnings or messages from code slot
+}
diff --git a/tests/testthat/test-qenv_eval_code.R b/tests/testthat/test-qenv_eval_code.R
index 651697e9..129fa655 100644
--- a/tests/testthat/test-qenv_eval_code.R
+++ b/tests/testthat/test-qenv_eval_code.R
@@ -171,8 +171,6 @@ testthat::test_that(
   }
 )
 
-
-
 # comments --------------------------------------------------------------------------------------------------------
 
 testthat::test_that("comments fall into proper calls", {
diff --git a/tests/testthat/test-qenv_get_messages.R b/tests/testthat/test-qenv_get_messages.R
index ecca0b68..3f776827 100644
--- a/tests/testthat/test-qenv_get_messages.R
+++ b/tests/testthat/test-qenv_get_messages.R
@@ -3,7 +3,7 @@ testthat::test_that("get_messages accepts a qenv object and returns character",
   testthat::expect_identical(
     get_messages(q),
     paste0(
-      "~~~ messages ~~~\n\n> This is a message!\nwhen running code:\nmessage(\"This is a message!\")\n\n",
+      "~~~ Messages ~~~\n\n> This is a message!\nwhen running code:\nmessage(\"This is a message!\")\n\n",
       "~~~ Trace ~~~\n\nmessage(\"This is a message!\")"
     )
   )
@@ -30,7 +30,7 @@ testthat::test_that("get_messages accepts a qenv object with 2 messages", {
   testthat::expect_identical(
     get_messages(q),
     paste0(
-      "~~~ messages ~~~\n\n> This is a message 1!\nwhen running code:\nmessage(\"This is a message 1!\")",
+      "~~~ Messages ~~~\n\n> This is a message 1!\nwhen running code:\nmessage(\"This is a message 1!\")",
       "\n\n> This is a message 2!\nwhen running code:\nmessage(\"This is a message 2!\")\n\n",
       "~~~ Trace ~~~\n\nmessage(\"This is a message 1!\")\nmessage(\"This is a message 2!\")"
     )
@@ -46,7 +46,7 @@ testthat::test_that("get_messages accepts a qenv object with a single eval_code
     get_messages(q),
     paste(
       c(
-        "~~~ messages ~~~\n",
+        "~~~ Messages ~~~\n",
         "> This is a message 1!",
         "when running code:",
         "message(\"This is a message 1!\")\n\n",
@@ -69,7 +69,7 @@ testthat::test_that("get_messages accepts a qenv object with 1 message eval_code
   testthat::expect_identical(
     get_messages(q),
     paste0(
-      "~~~ messages ~~~\n\n> This is a message 2!\nwhen running code:\nmessage(\"This is a message 2!\")\n\n",
+      "~~~ Messages ~~~\n\n> This is a message 2!\nwhen running code:\nmessage(\"This is a message 2!\")\n\n",
       "~~~ Trace ~~~\n\nx <- 1\nmessage(\"This is a message 2!\")"
     )
   )

From defa490f9c6ceac0c7dd3432075b1881d102eff5 Mon Sep 17 00:00:00 2001
From: go_gonzo <dawid.kaledkowski@gmail.com>
Date: Fri, 8 Nov 2024 13:03:07 +0100
Subject: [PATCH 89/98] WIP - postmerge

---
 NAMESPACE                              |   2 +-
 R/qenv-c.R                             |  15 ++-
 R/qenv-class.R                         |  45 ++-----
 R/qenv-eval_code.R                     |  10 +-
 R/qenv-extract.R                       |   2 +-
 R/qenv-join.R                          |  68 ----------
 man/get_env.Rd                         |   2 +-
 man/qenv-class.Rd                      |   6 +-
 man/qenv.Rd                            |  10 +-
 tests/testthat/test-qenv_constructor.R |   5 +-
 tests/testthat/test-qenv_eval_code.R   | 165 ++++---------------------
 tests/testthat/test-qenv_get_code.R    |  32 ++++-
 tests/testthat/test-qenv_get_var.R     |   8 +-
 tests/testthat/test-qenv_join.R        |  97 +++++----------
 14 files changed, 126 insertions(+), 341 deletions(-)

diff --git a/NAMESPACE b/NAMESPACE
index d6c4304f..a57ca1d2 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -1,7 +1,7 @@
 # Generated by roxygen2: do not edit by hand
 
-S3method("[",qenv)
 S3method("$",qenv.error)
+S3method("[",qenv)
 S3method("[[",qenv.error)
 S3method(as.list,qenv.error)
 S3method(c,qenv)
diff --git a/R/qenv-c.R b/R/qenv-c.R
index 1b9d5690..c1d5e0e4 100644
--- a/R/qenv-c.R
+++ b/R/qenv-c.R
@@ -24,13 +24,16 @@
     )
   }
 
-  shared_ids <- intersect(x@id, y@id)
+  x_id <- get_code_attr(x, "id")
+  y_id <- get_code_attr(y, "id")
+
+  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)
+  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))) {
@@ -86,11 +89,7 @@ c.qenv <- function(...) {
         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])
+      x@code <- union(x@code, y@code)
 
       # insert (and overwrite) objects from y to x
       x@.xData <- rlang::env_clone(x@.xData, parent = parent.env(.GlobalEnv))
diff --git a/R/qenv-class.R b/R/qenv-class.R
index b5a075fd..4ba8492f 100644
--- a/R/qenv-class.R
+++ b/R/qenv-class.R
@@ -21,12 +21,7 @@
 #' @exportClass qenv
 setClass(
   "qenv",
-  slots = c(
-    code = "character",
-    id = "integer",
-    warnings = "character",
-    messages = "character"
-  ),
+  slots = c(code = "list"),
   contains = "environment"
 )
 
@@ -37,25 +32,7 @@ setMethod(
   "qenv",
   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)))
-
-    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 {
@@ -67,13 +44,10 @@ setMethod(
     # .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.
+    methods::callNextMethod(
       # Mandatory use of `xData` to build a correct .Object@.xData
-      .Object, new_xdata,
-      code = code, messages = messages, warnings = warnings, id = id, ...
+      .Object, new_xdata, ...
     )
-
-    .Object
   }
 )
 
@@ -81,14 +55,11 @@ setMethod(
 #' @name qenv-class
 #' @keywords internal
 setValidity("qenv", function(object) {
-  if (length(object@code) != length(object@id)) {
-    "@code and @id slots must have the same length."
-  } else if (length(object@code) != length(object@warnings)) {
-    "@code and @warnings slots must have the same length"
-  } else if (length(object@code) != length(object@messages)) {
-    "@code and @messages slots must have the same length"
-  } else if (any(duplicated(object@id))) {
-    "@id contains duplicated values."
+  ids <- lapply(object@code, "attr", "id")
+  if (any(sapply(ids, is.null))) {
+    "All @code slots must have an 'id' attribute"
+  } else if (any(duplicated(unlist(ids)))) {
+    "@code contains duplicated 'id' attributes."
   } else if (!environmentIsLocked(object@.xData)) {
     "@.xData must be locked."
   } else {
diff --git a/R/qenv-eval_code.R b/R/qenv-eval_code.R
index 6e6abe69..961fea08 100644
--- a/R/qenv-eval_code.R
+++ b/R/qenv-eval_code.R
@@ -29,7 +29,7 @@ setGeneric("eval_code", function(object, code) standardGeneric("eval_code"))
 
 setMethod("eval_code", signature = c("qenv", "character"), function(object, code) {
   parsed_code <- parse(text = code, keep.source = TRUE)
-  object@env <- rlang::env_clone(object@env, parent = parent.env(.GlobalEnv))
+  object@.xData <- rlang::env_clone(object@.xData, parent = parent.env(.GlobalEnv))
   if (length(parsed_code) == 0) {
     # empty code, or just comments
     attr(code, "id") <- sample.int(.Machine$integer.max, size = 1)
@@ -48,9 +48,9 @@ setMethod("eval_code", signature = c("qenv", "character"), function(object, code
     x <- withCallingHandlers(
       tryCatch(
         {
-          eval(current_call, envir = object@env)
-          if (!identical(parent.env(object@env), parent.env(.GlobalEnv))) {
-            # needed to make sure that @env is always a sibling of .GlobalEnv
+          eval(current_call, envir = object@.xData)
+          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)
           }
@@ -87,7 +87,7 @@ setMethod("eval_code", signature = c("qenv", "character"), function(object, code
     object@code <- c(object@code, list(current_code))
   }
 
-  lockEnvironment(object@env, bindings = TRUE)
+  lockEnvironment(object@.xData, bindings = TRUE)
   object
 })
 
diff --git a/R/qenv-extract.R b/R/qenv-extract.R
index 31437fd3..d09d2ac0 100644
--- a/R/qenv-extract.R
+++ b/R/qenv-extract.R
@@ -42,7 +42,7 @@
     )
   }
 
-  x@env <- list2env(mget(x = names, envir = get_env(x)))
+  x@.xData <- list2env(as.list(x)[names])
   names <- gsub("^`(.*)`$", "\\1", names)
   x@code <- get_code_dependency(x@code, names = names, ...)
 
diff --git a/R/qenv-join.R b/R/qenv-join.R
index fc0b8f36..62762464 100644
--- a/R/qenv-join.R
+++ b/R/qenv-join.R
@@ -139,20 +139,6 @@ setGeneric("join", function(x, y) standardGeneric("join"))
 setMethod("join", signature = c("qenv", "qenv"), function(x, y) {
   lifecycle::deprecate_soft("0.5.1", "join()", "c()")
   c(x, y)
-  join_validation <- .check_joinable(x, y)
-
-  # join expressions
-  if (!isTRUE(join_validation)) {
-    stop(join_validation)
-  }
-
-  id_unique <- !get_code_attr(y, "id") %in% get_code_attr(x, "id")
-  x@code <- c(x@code, y@code[id_unique])
-
-  # insert (and overwrite) objects from y to x
-  x@env <- rlang::env_clone(x@env, parent = parent.env(.GlobalEnv))
-  rlang::env_coalesce(env = x@env, from = y@env)
-  x
 })
 
 setMethod("join", signature = c("qenv", "qenv.error"), function(x, y) {
@@ -164,57 +150,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@env), rlang::env_names(y@env))
-  is_overwritten <- vapply(common_names, function(el) {
-    !identical(get(el, x@env), get(el, y@env))
-  }, 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 - ")
-      )
-    )
-  }
-  x_id <- get_code_attr(x, "id")
-  y_id <- get_code_attr(y, "id")
-
-  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 = ""
-    )
-  }
-}
diff --git a/man/get_env.Rd b/man/get_env.Rd
index d2333f8d..fa8ff3eb 100644
--- a/man/get_env.Rd
+++ b/man/get_env.Rd
@@ -12,7 +12,7 @@ get_env(object)
 \item{object}{(\code{qenv}).}
 }
 \value{
-An \code{environment} stored in \code{qenv} slot with all data objects.
+An \code{environment} stored in \code{qenv} with all data objects.
 }
 \description{
 The access of environment included in the \code{qenv} that contains all data objects.
diff --git a/man/qenv-class.Rd b/man/qenv-class.Rd
index abce3cdb..0546dd99 100644
--- a/man/qenv-class.Rd
+++ b/man/qenv-class.Rd
@@ -10,10 +10,10 @@ Reproducible class with environment and code.
 \section{Slots}{
 
 \describe{
-\item{\code{code}}{(\code{list} of \code{character}) representing code necessary to reproduce the environment.
-Read more in Code section.}
+\item{\code{.xData}}{(\code{environment}) environment with content was generated by the evaluation}
 
-\item{\code{.xData}}{(\code{environment}) environment with content was generated by the evaluation
+\item{\code{code}}{(\code{list} of \code{character}) representing code necessary to reproduce the environment.
+Read more in Code section.
 of the \code{code} slot.}
 }}
 
diff --git a/man/qenv.Rd b/man/qenv.Rd
index 8dfc4802..4e07b850 100644
--- a/man/qenv.Rd
+++ b/man/qenv.Rd
@@ -8,6 +8,7 @@
 \alias{eval_code,qenv,language-method}
 \alias{eval_code,qenv,expression-method}
 \alias{eval_code,qenv.error,ANY-method}
+\alias{[.qenv}
 \alias{qenv-inheritted}
 \alias{get_code}
 \alias{get_code,qenv-method}
@@ -57,7 +58,7 @@ For more details see the "Extracting dataset-specific code" section.}
 It will only show the objects that are not named with a dot prefix, unless
 the \code{all.names = TRUE}, which will show all objects.
 
-\code{get_code} returns the traced code (from \verb{@code} slot) in the form specified by \code{deparse}.
+\code{get_code} returns the traced code in the form specified by \code{deparse}.
 
 \code{within} returns a \code{qenv} object with \code{expr} evaluated or \code{qenv.error} if evaluation fails.
 }
@@ -178,6 +179,13 @@ q <- eval_code(q, "a <- 1")
 q <- eval_code(q, quote(library(checkmate)))
 q <- eval_code(q, expression(assert_number(a)))
 
+
+# Subsetting
+q <- qenv()
+q <- eval_code(q, "a <- 1;b<-2")
+q["a"]
+q[c("a", "b")]
+
 # Extract objects from qenv
 q[["a"]]
 q$a
diff --git a/tests/testthat/test-qenv_constructor.R b/tests/testthat/test-qenv_constructor.R
index b0d3db92..064ef980 100644
--- a/tests/testthat/test-qenv_constructor.R
+++ b/tests/testthat/test-qenv_constructor.R
@@ -51,10 +51,7 @@ testthat::test_that("constructor returns qenv", {
   q <- qenv()
   testthat::expect_s4_class(q, "qenv")
   testthat::expect_identical(names(q), character(0))
-  testthat::expect_identical(q@code, character(0))
-  testthat::expect_identical(q@id, integer(0))
-  testthat::expect_identical(q@warnings, character(0))
-  testthat::expect_identical(q@messages, character(0))
+  testthat::expect_identical(q@code, list())
 })
 
 testthat::describe("parent of qenv environment is the parent of .GlobalEnv", {
diff --git a/tests/testthat/test-qenv_eval_code.R b/tests/testthat/test-qenv_eval_code.R
index e06159af..75b28d98 100644
--- a/tests/testthat/test-qenv_eval_code.R
+++ b/tests/testthat/test-qenv_eval_code.R
@@ -5,6 +5,11 @@ testthat::test_that("eval_code evaluates the code in the qenvs environment", {
   testthat::expect_identical(q2$b, 150L)
 })
 
+testthat::test_that("eval_code locks the environment", {
+  q <- eval_code(qenv(), quote(iris1 <- iris))
+  testthat::expect_identical(isEnvironmentLocked(q2@.xData))
+})
+
 testthat::test_that("eval_code doesn't have access to environment where it's called", {
   q <- qenv()
   q1 <- eval_code(q, quote(a <- 1))
@@ -30,22 +35,21 @@ 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(q1@code, "a <- 1")
+  testthat::expect_identical(get_code(q1), "a <- 1")
   testthat::expect_equal(q1@.xData, list2env(list(a = 1)))
 })
 
 testthat::test_that("eval_code works with expression", {
   q1 <- eval_code(qenv(), as.expression(quote(a <- 1)))
 
-  testthat::expect_identical(q1@code, "a <- 1")
+  testthat::expect_identical(get_code(q1), "a <- 1")
   testthat::expect_equal(q1@.xData, list2env(list(a = 1)))
 })
 
 testthat::test_that("eval_code works with quoted", {
   q1 <- eval_code(qenv(), quote(a <- 1))
 
-  testthat::expect_identical(q1@code, "a <- 1")
+  testthat::expect_identical(get_code(q1), "a <- 1")
   testthat::expect_equal(q1@.xData, list2env(list(a = 1)))
 })
 
@@ -59,8 +63,8 @@ testthat::test_that("eval_code works with quoted code block", {
   )
 
   testthat::expect_equal(
-    unlist(q1@code),
-    c("a <- 1\n", "b <- 2")
+    get_code(q1),
+    c("a <- 1\nb <- 2")
   )
   testthat::expect_equal(q1@.xData, list2env(list(a = 1, b = 2)))
 })
@@ -85,88 +89,15 @@ testthat::test_that("an error when calling eval_code returns a qenv.error object
   testthat::expect_equal(q$message, "object 'w' not found \n when evaluating qenv code:\nz <- w * x")
 })
 
-testthat::test_that(
-  "a warning when calling eval_code returns a qenv object which has warnings as attributes of code",
-  {
-    q <- eval_code(qenv(), quote(iris_data <- iris))
-    q <- eval_code(q, quote(warning("this is a warning")))
-    testthat::expect_s4_class(q, "qenv")
-    testthat::expect_equal(
-      lapply(q@code, attr, "warning"),
-      list(NULL, "> this is a warning\n")
-    )
-  }
-)
-
-testthat::test_that(
-  "eval_code associates warnings with call by adding attribute to code element",
-  {
-    q <- eval_code(qenv(), c("x <- 1", "y <- 1", "warning('warn1')"))
-    testthat::expect_equal(
-      lapply(q@code, attr, "warning"),
-      list(NULL, NULL, "> warn1\n")
-    )
-  }
-)
-
-
-testthat::test_that(
-  "eval_code associates messages with call by adding attribute to code element",
-  {
-    q <- eval_code(qenv(), quote("iris_data <- head(iris)"))
-    q <- eval_code(q, quote("message('This is a message')"))
-    testthat::expect_s4_class(q, "qenv")
-    testthat::expect_equal(
-      lapply(q@code, attr, "message"),
-      list(
-        NULL,
-        "> This is a message\n"
-      )
-    )
-  }
-)
-
-testthat::test_that(
-  "eval_code returns a qenv object with empty messages and warnings as code attributes, when none are returned",
-  {
-    q <- eval_code(qenv(), quote("iris_data <- head(iris)"))
-    testthat::expect_s4_class(q, "qenv")
-    testthat::expect_null(attr(q@code, "message"))
-    testthat::expect_null(attr(q@code, "warning"))
-  }
-)
-
-testthat::test_that("eval_code returns a qenv object with dependency attribute", {
-  q <- eval_code(qenv(), "iris_data <- head(iris)")
-  testthat::expect_identical(get_code_attr(q, "dependency"), c("iris_data", "<-", "head", "iris"))
-})
-testthat::test_that("eval_code returns a qenv object with dependency attribute that contains linksto information", {
-  q2 <- eval_code(qenv(), c("x <- 5", "iris_data <- head(iris)", "nrow(iris_data) #@linksto x"))
-  testthat::expect_identical(
-    lapply(q2@code, attr, "dependency"),
-    list(
-      c("x", "<-"),
-      c("iris_data", "<-", "head", "iris"),
-      c("x", "<-", "nrow", "iris_data")
-    )
-  )
+testthat::test_that("eval_code accepts calls containing only comments and empty spaces", {
+  code <- "# comment
+    \n\n# comment
+    \n
+  "
+  testthat::expect_identical(get_code(eval_code(qenv(), code)), code)
 })
-testthat::test_that(
-  "eval_code returns a qenv object with dependency attribute that extracts functions after '<-' part",
-  {
-    q3 <- eval_code(qenv(), c("nrow(iris)", "head(iris)"))
-    testthat::expect_identical(
-      lapply(q3@code, attr, "dependency"),
-      list(
-        c("<-", "nrow", "iris"),
-        c("<-", "head", "iris")
-      )
-    )
-  }
-)
-
-# comments --------------------------------------------------------------------------------------------------------
 
+# comments ----------
 testthat::test_that("comments fall into proper calls", {
   # If comment is on top, it gets moved to the first call.
   # Any other comment gets moved to the call above.
@@ -181,31 +112,7 @@ testthat::test_that("comments fall into proper calls", {
   "
 
   q <- eval_code(qenv(), code)
-  testthat::expect_identical(
-    get_code(q),
-    code
-  )
-})
-
-testthat::test_that("comments get pasted when they fall into calls", {
-  # If comment is on top, it gets moved to the first call.
-  # Any other comment gets moved to the call above.
-  # Comments get pasted if there are two assigned to the same call.
-  code <- "
-    # initial comment
-    a <- 1 # A comment
-    b <- 2 # inline comment
-    c <- 3 # C comment
-    # inbetween comment
-    d <- 4
-    # finishing comment
-  "
-
-  q <- eval_code(qenv(), code)
-  testthat::expect_identical(
-    get_code(q),
-    code
-  )
+  testthat::expect_identical(get_code(q), code)
 })
 
 testthat::test_that("comments alone are pasted to the next/following call element", {
@@ -241,28 +148,21 @@ testthat::test_that("comments from the same line are associated with it's call",
     unlist(q@code)[2],
     paste0(code[2], "\n")
   )
-  testthat::expect_identical(
-    get_code(q),
-    paste(code, collapse = "\n")
-  )
 })
 
-testthat::test_that("comments passed alone to eval_code are separate calls", {
-  code <- c("x <- 5", "# comment")
+testthat::test_that("alone comments at the end of the source are considered as a separate call", {
+  # todo: should be associated to the last call or be separted?
+  code <- c("x <- 5", "y <- 10", "# comment")
   q <- eval_code(eval_code(qenv(), code[1]), code[2])
   testthat::expect_identical(
-    get_code(q),
-    paste(code, collapse = "\n")
+    unlist(q@code)[3],
+    "# comment"
   )
 })
 
 testthat::test_that("comments passed alone to eval_code that contain @linksto tag have detected dependency", {
   code <- c("x <- 5", "# comment @linksto x")
   q <- eval_code(eval_code(qenv(), code[1]), code[2])
-  testthat::expect_identical(
-    get_code(q),
-    paste(code, collapse = "\n")
-  )
   testthat::expect_identical(
     get_code(q, names = "x"),
     paste(code, collapse = "\n")
@@ -272,22 +172,3 @@ testthat::test_that("comments passed alone to eval_code that contain @linksto ta
     "x"
   )
 })
-
-testthat::test_that("original formatting and comments are preserved when expression has a srcref", {
-  code <- "# comment
-    a <- 1\n
-
-    # comment
-    \n
-  "
-  expr <- parse(text = code, keep.source = TRUE)
-  testthat::expect_identical(get_code(eval_code(qenv(), expr)), code)
-})
-
-testthat::test_that("eval_code accepts calls containing only comments and empty spaces", {
-  code <- "# comment
-    \n\n# comment
-    \n
-  "
-  testthat::expect_identical(get_code(eval_code(qenv(), code)), code)
-})
diff --git a/tests/testthat/test-qenv_get_code.R b/tests/testthat/test-qenv_get_code.R
index 96241c44..03e3ab3d 100644
--- a/tests/testthat/test-qenv_get_code.R
+++ b/tests/testthat/test-qenv_get_code.R
@@ -1,6 +1,6 @@
 pasten <<- function(...) paste(..., collapse = "\n")
 
-testthat::test_that("get_code returns code (character by default) of qenv object", {
+testthat::test_that("get_code returns code (character(1) by default) of qenv object", {
   q <- qenv()
   q <- eval_code(q, quote(x <- 1))
   q <- eval_code(q, quote(y <- x))
@@ -875,3 +875,33 @@ testthat::test_that("get_code raises warning for missing names", {
     " not found in code: c"
   )
 })
+
+# comments and white spaces --------------------------
+testthat::test_that("comments are preserved in the output code", {
+  # If comment is on top, it gets moved to the first call.
+  # Any other comment gets moved to the call above.
+  # Comments get pasted if there are two assigned to the same call.
+  code <- "
+    # initial comment
+    a <- 1 # A comment
+    b <- 2 # inline comment
+    c <- 3 # C comment
+    # inbetween comment
+    d <- 4
+    # finishing comment
+  "
+
+  q <- eval_code(qenv(), code)
+  testthat::expect_identical(get_code(q), code)
+})
+
+testthat::test_that("original formatting and comments are preserved when expression has a srcref", {
+  code <- "# comment
+    a <- 1\n
+
+    # comment
+    \n
+  "
+  expr <- parse(text = code, keep.source = TRUE)
+  testthat::expect_identical(get_code(eval_code(qenv(), expr)), code)
+})
diff --git a/tests/testthat/test-qenv_get_var.R b/tests/testthat/test-qenv_get_var.R
index c922e699..89b31c6e 100644
--- a/tests/testthat/test-qenv_get_var.R
+++ b/tests/testthat/test-qenv_get_var.R
@@ -11,7 +11,7 @@ testthat::test_that("get_var, `$` and `[[` return object from qenv environment",
   q <- eval_code(qenv(), quote(x <- 1))
   q <- eval_code(q, quote(y <- 5 * x))
 
-  testthat::expect_equal(get_var(q, "y"), 5)
+  lifecycle::expect_deprecated(testthat::expect_equal(get_var(q, "y"), 5))
   testthat::expect_equal(q[["x"]], 1)
   testthat::expect_equal(q$x, 1)
 })
@@ -21,9 +21,9 @@ testthat::test_that("get_var, `$` and `[[` return NULL if object not in qenv env
   q <- eval_code(qenv(), quote(x <- 1))
   q <- eval_code(q, quote(y <- 5 * x))
 
-  testthat::expect_null(get_var(q, "z"))
-  testthat::expect_message(get_var(q, "z"), "object 'z' not found")
-
+  testthat::expect_message(
+    testthat::expect_null(get_var(q, "z"))
+  )
   testthat::expect_null(q[["w"]])
   testthat::expect_null(q$w)
 })
diff --git a/tests/testthat/test-qenv_join.R b/tests/testthat/test-qenv_join.R
index 2d7e2341..9099e653 100644
--- a/tests/testthat/test-qenv_join.R
+++ b/tests/testthat/test-qenv_join.R
@@ -2,54 +2,42 @@ testthat::test_that("Joining two identical qenvs outputs the same object", {
   q1 <- eval_code(qenv(), quote(iris1 <- iris))
   q2 <- q1
 
-  testthat::expect_true(.check_joinable(q1, q2))
   q <- c(q1, q2)
 
   testthat::expect_equal(q@.xData, q1@.xData)
-  testthat::expect_identical(q@code, "iris1 <- iris")
-  testthat::expect_identical(q@id, q1@id)
+  testthat::expect_identical(get_code(q), "iris1 <- iris")
 })
 
 testthat::test_that("Joining two independent qenvs results in object having combined code and environments", {
   q1 <- eval_code(qenv(), quote(iris1 <- iris))
   q2 <- eval_code(qenv(), quote(mtcars1 <- mtcars))
 
-  testthat::expect_true(.check_joinable(q1, q2))
   q <- c(q1, q2)
 
   testthat::expect_equal(q@.xData, list2env(list(iris1 = iris, mtcars1 = mtcars)))
-  testthat::expect_identical(
-    unlist(q@code),
-    c("iris1 <- iris", "mtcars1 <- mtcars")
-  )
-  testthat::expect_identical(get_code_attr(q, "id"), c(get_code_attr(q1, "id"), get_code_attr(q2, "id")))
+  testthat::expect_identical(get_code(q), "iris1 <- iris\nmtcars1 <- mtcars")
 })
 
 testthat::test_that("Joined qenv does not duplicate common code", {
-  env <- list2env(list(
-    iris1 = iris,
-    mtcars1 = mtcars
-  ))
-
-  q1 <- eval_code(qenv(), code = as.expression(c(quote(iris1 <- iris), quote(mtcars1 <- mtcars))))
+  q1 <- eval_code(qenv(), code = expression(iris1 <- iris, mtcars1 <- mtcars))
   q2 <- q1
   q2 <- eval_code(q2, quote(mtcars2 <- mtcars))
 
-  testthat::expect_true(.check_joinable(q1, q2))
   q <- c(q1, q2)
-
-  testthat::expect_identical(
-    unlist(q@code),
-    c("iris1 <- iris\n", "mtcars1 <- mtcars", "mtcars2 <- mtcars")
+  testthat::expect_identical(get_code(q), "iris1 <- iris\nmtcars1 <- mtcars\nmtcars2 <- mtcars")
+  testthat::expect_equal(
+    get_env(q),
+    list2env(list(
+      iris1 = iris,
+      mtcars1 = mtcars,
+      mtcars2 = mtcars
+    ))
   )
-  testthat::expect_identical(get_code_attr(q, "id"), c(get_code_attr(q1, "id"), get_code_attr(q2, "id")[3]))
 })
 
 testthat::test_that("Not able to join two qenvs if any of the shared objects changed", {
   q1 <- eval_code(qenv(), expression(iris1 <- iris, iris2 <- iris))
   q2 <- eval_code(qenv(), quote(iris1 <- head(iris)))
-
-  testthat::expect_match(.check_joinable(q1, q2), "Not possible to join qenv objects")
   testthat::expect_error(c(q1, q2), "Not possible to join qenv objects")
 })
 
@@ -59,61 +47,44 @@ testthat::test_that("join does not duplicate code but adds only extra code", {
   q1 <- eval_code(q1, quote(iris2 <- iris))
   q2 <- eval_code(q2, quote(mtcars2 <- mtcars))
 
-  testthat::expect_true(.check_joinable(q1, q2))
   q <- c(q1, q2)
 
   testthat::expect_identical(
-    unlist(q@code),
-    c("iris1 <- iris\n", "mtcars1 <- mtcars", "iris2 <- iris", "mtcars2 <- mtcars")
+    get_code(q),
+    c("iris1 <- iris\nmtcars1 <- mtcars\niris2 <- iris\nmtcars2 <- mtcars")
   )
 
   testthat::expect_equal(
     q@.xData,
     list2env(list(iris1 = iris, iris2 = iris, mtcars1 = mtcars, mtcars2 = mtcars))
   )
-
-  testthat::expect_identical(get_code_attr(q, "id"), c(get_code_attr(q1, "id"), get_code_attr(q2, "id")[3]))
 })
 
 testthat::test_that("Not possible to join qenvs which share some code when one of the shared object was modified", {
-  env <- new.env()
-  env$iris1 <- iris
-  env$mtcars1 <- mtcars
-
   q1 <- eval_code(qenv(), code = expression(iris1 <- iris, mtcars1 <- mtcars))
   q2 <- q1
   q1 <- eval_code(q1, quote(iris2 <- iris))
   q2 <- eval_code(q2, quote(mtcars1 <- head(mtcars)))
 
-  testthat::expect_error(c(q1, q2))
+  testthat::expect_error(c(q1, q2), "Following object\\(s\\) have been modified:\n -  mtcars1")
 })
 
 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 <- 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"))
-  testthat::expect_identical(cq@id, c(q1@id, q2@id))
+  testthat::expect_identical(get_code(cq), "a1 <- 1\na1 <- 1")
 })
 
 testthat::test_that("qenv objects are mergeable if they share common initial qenv elements", {
-  q1 <- eval_code(qenv(), code = quote(a1 <- 1))
-  q2 <- eval_code(q1, quote(b1 <- 2))
-  q1 <- eval_code(q1, quote(a2 <- 3))
-  testthat::expect_true(.check_joinable(q1, q2))
+  q1 <- eval_code(qenv(), code = quote(a1 <- 1)) # id 1
+  q2 <- eval_code(q1, quote(b1 <- 2)) # id 1 and 2
+  q1 <- eval_code(q1, quote(a2 <- 3)) # id 1 and 3
 
-  cq <- join(q1, q2)
-  testthat::expect_s4_class(cq, "qenv")
+  cq <- c(q1, q2)
   testthat::expect_equal(cq@.xData, list2env(list(a1 = 1, b1 = 2, a2 = 3)))
-  testthat::expect_identical(
-    unlist(cq@code),
-    c("a1 <- 1", "a2 <- 3", "b1 <- 2")
-  )
-  testthat::expect_identical(get_code_attr(cq, "id"), c(get_code_attr(q1, "id"), get_code_attr(q2, "id")[2]))
+  testthat::expect_identical(get_code(cq), "a1 <- 1\na2 <- 3\nb1 <- 2")
 })
 
 testthat::test_that(
@@ -122,10 +93,9 @@ testthat::test_that(
     q1 <- eval_code(qenv(), code = quote(a1 <- 1))
     q2 <- eval_code(qenv(), code = quote(b1 <- 2))
     q_common <- eval_code(qenv(), quote(c1 <- 3))
-    q1 <- join(q1, q_common)
-    q2 <- join(q2, q_common)
-    testthat::expect_match(.check_joinable(q1, q2), "these objects cannot be joined")
-    testthat::expect_error(join(q1, q2), "these objects cannot be joined")
+    q1 <- c(q1, q_common)
+    q2 <- c(q2, q_common)
+    testthat::expect_error(c(q1, q2), "these objects cannot be joined")
   }
 )
 
@@ -134,11 +104,10 @@ testthat::test_that("qenv objects are not mergable if they have multiple common
   q_common2 <- eval_code(qenv(), code = quote(c2 <- 2))
 
   q1 <- eval_code(q_common1, quote(a1 <- 3))
-  q1 <- join(q1, q_common2) # c1, a1, c2
-  q2 <- join(q_common1, q_common2) # c1, c2
+  q1 <- c(q1, q_common2) # c1, a1, c2
+  q2 <- c(q_common1, q_common2) # c1, c2
 
-  testthat::expect_match(.check_joinable(q1, q2), "it's impossible to determine the evaluation's order")
-  testthat::expect_error(join(q1, q2), "it's impossible to determine the evaluation's order")
+  testthat::expect_error(c(q1, q2), "it's impossible to determine the evaluation's order")
 })
 
 
@@ -147,20 +116,19 @@ testthat::test_that("joining with a qenv.error object returns the qenv.error obj
   error_q <- eval_code(qenv(), quote(y <- w))
   error_q2 <- eval_code(qenv(), quote(z <- w))
 
-  testthat::expect_s3_class(join(q1, error_q), "qenv.error")
-  testthat::expect_s3_class(join(error_q, error_q2), "qenv.error")
-  testthat::expect_s3_class(join(error_q, q1), "qenv.error")
+  testthat::expect_s3_class(c(q1, error_q), "qenv.error")
+  testthat::expect_s3_class(c(error_q, error_q2), "qenv.error")
+  testthat::expect_s3_class(c(error_q, q1), "qenv.error")
 
   # if joining two qenv.error objects keep the first
-  testthat::expect_equal(join(error_q, error_q2), error_q)
+  testthat::expect_equal(c(error_q, error_q2), error_q)
 })
 
 testthat::test_that("Joining two independent qenvs with warnings results in object having combined warnings", {
   q1 <- eval_code(qenv(), "warning('This is warning 1')")
   q2 <- eval_code(qenv(), "warning('This is warning 2')")
 
-  testthat::expect_true(.check_joinable(q1, q2))
-  q <- join(q1, q2)
+  q <- c(q1, q2)
 
   testthat::expect_equal(
     get_code_attr(q, "warning"),
@@ -175,8 +143,7 @@ testthat::test_that("Joining two independent qenvs with messages results in obje
   q1 <- eval_code(qenv(), "message('This is message 1')")
   q2 <- eval_code(qenv(), "message('This is message 2')")
 
-  testthat::expect_true(.check_joinable(q1, q2))
-  q <- join(q1, q2)
+  q <- c(q1, q2)
 
   testthat::expect_equal(
     get_code_attr(q, "message"),

From 0f205440b490201ddcfb8b08481bb2a45fd31421 Mon Sep 17 00:00:00 2001
From: go_gonzo <dawid.kaledkowski@gmail.com>
Date: Fri, 8 Nov 2024 13:09:42 +0100
Subject: [PATCH 90/98] fix obvious

---
 tests/testthat/test-qenv-class.R     | 7 -------
 tests/testthat/test-qenv_eval_code.R | 2 +-
 2 files changed, 1 insertion(+), 8 deletions(-)

diff --git a/tests/testthat/test-qenv-class.R b/tests/testthat/test-qenv-class.R
index 083d37e0..9c8c9fa1 100644
--- a/tests/testthat/test-qenv-class.R
+++ b/tests/testthat/test-qenv-class.R
@@ -10,17 +10,10 @@ testthat::describe("methods::new(qenv)", {
     expect_true(environmentIsLocked(as.environment(methods::new("qenv", .xData = new_env))))
   })
 
-  testthat::it("throws error when id and code length doesn't match", {
-    expect_error(methods::new("qenv", id = 1L), "@code and @id slots must have the same length\\.")
-  })
-
   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\\.")
-  })
   testthat::it("initialized qenv(s) have different environments", {
     testthat::expect_false(identical(qenv()@.xData, qenv()@.xData))
   })
diff --git a/tests/testthat/test-qenv_eval_code.R b/tests/testthat/test-qenv_eval_code.R
index 75b28d98..a15257a0 100644
--- a/tests/testthat/test-qenv_eval_code.R
+++ b/tests/testthat/test-qenv_eval_code.R
@@ -7,7 +7,7 @@ testthat::test_that("eval_code evaluates the code in the qenvs environment", {
 
 testthat::test_that("eval_code locks the environment", {
   q <- eval_code(qenv(), quote(iris1 <- iris))
-  testthat::expect_identical(isEnvironmentLocked(q2@.xData))
+  testthat::expect_true(environmentIsLocked(q@.xData))
 })
 
 testthat::test_that("eval_code doesn't have access to environment where it's called", {

From db68da09aa00e62efc34694667ae3dd455a7e138 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?=
 <211358+averissimo@users.noreply.github.com>
Date: Fri, 8 Nov 2024 12:53:59 +0000
Subject: [PATCH 91/98] fix: constructor creates a locked environment

---
 R/qenv-class.R | 9 ++++-----
 1 file changed, 4 insertions(+), 5 deletions(-)

diff --git a/R/qenv-class.R b/R/qenv-class.R
index 4ba8492f..76d3b630 100644
--- a/R/qenv-class.R
+++ b/R/qenv-class.R
@@ -30,9 +30,7 @@ setClass(
 setMethod(
   "initialize",
   "qenv",
-  function(.Object, # nolint: object_name.
-           .xData, # nolint: object_name.
-           ...) {
+  function(.Object, .xData, code = list(), ...) { # nolint: object_name.
     new_xdata <- if (rlang::is_missing(.xData)) {
       new.env(parent = parent.env(.GlobalEnv))
     } else {
@@ -45,8 +43,9 @@ setMethod(
     # most 1 unnamed formal argument of class `environment`.
     # See methods::findMethods("initialize")$.environment
     methods::callNextMethod(
-      # Mandatory use of `xData` to build a correct .Object@.xData
-      .Object, new_xdata, ...
+      .Object,
+      new_xdata, # Mandatory use of unnamed environment arg
+      code = code, ...
     )
   }
 )

From bc95670310a84c6a54cfa2177bc6b2e59232e867 Mon Sep 17 00:00:00 2001
From: go_gonzo <dawid.kaledkowski@gmail.com>
Date: Fri, 8 Nov 2024 14:01:45 +0100
Subject: [PATCH 92/98] yabadabadoo

---
 R/utils.R                            | 4 +++-
 man/get_warn_message_util.Rd         | 6 +++++-
 tests/testthat/test-qenv_eval_code.R | 8 ++++----
 3 files changed, 12 insertions(+), 6 deletions(-)

diff --git a/R/utils.R b/R/utils.R
index f522bfd2..0028c708 100644
--- a/R/utils.R
+++ b/R/utils.R
@@ -57,7 +57,9 @@ lang2calls <- function(x) {
 #' Obtain warnings or messages from code slot
 #'
 #' @param object (`qenv`)
-#' @param what (``
+#' @param what (`"warning"` or `"message"`)
+#' @return `character(1)` containing combined message or `NULL` when no warnings/messages
+#' @keywords internal
 get_warn_message_util <- function(object, what) {
   checkmate::matchArg(what, choices = c("warning", "message"))
   messages <- lapply(object@code, "attr", what)
diff --git a/man/get_warn_message_util.Rd b/man/get_warn_message_util.Rd
index 0850b9f5..18a54dfc 100644
--- a/man/get_warn_message_util.Rd
+++ b/man/get_warn_message_util.Rd
@@ -9,8 +9,12 @@ get_warn_message_util(object, what)
 \arguments{
 \item{object}{(\code{qenv})}
 
-\item{what}{(``}
+\item{what}{(\code{"warning"} or \code{"message"})}
+}
+\value{
+\code{character(1)} containing combined message or \code{NULL} when no warnings/messages
 }
 \description{
 Obtain warnings or messages from code slot
 }
+\keyword{internal}
diff --git a/tests/testthat/test-qenv_eval_code.R b/tests/testthat/test-qenv_eval_code.R
index a15257a0..0583ebb7 100644
--- a/tests/testthat/test-qenv_eval_code.R
+++ b/tests/testthat/test-qenv_eval_code.R
@@ -150,13 +150,13 @@ testthat::test_that("comments from the same line are associated with it's call",
   )
 })
 
-testthat::test_that("alone comments at the end of the source are considered as a separate call", {
+testthat::test_that("alone comments at the end of the source are considered as continuation of the last call", {
   # todo: should be associated to the last call or be separted?
-  code <- c("x <- 5", "y <- 10", "# comment")
+  code <- c("x <- 5\ny <- 10\n# comment")
   q <- eval_code(eval_code(qenv(), code[1]), code[2])
   testthat::expect_identical(
-    unlist(q@code)[3],
-    "# comment"
+    unlist(q@code)[2],
+    "y <- 10\n# comment"
   )
 })
 

From 6c5d5ab39ee3b30bf80556019c1ce563b966feb3 Mon Sep 17 00:00:00 2001
From: m7pr <marcin.kosinski.mk1@roche.com>
Date: Fri, 8 Nov 2024 15:21:31 +0100
Subject: [PATCH 93/98] use all.names = TRUE in as.list.environment

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

diff --git a/R/qenv-extract.R b/R/qenv-extract.R
index d09d2ac0..7723df48 100644
--- a/R/qenv-extract.R
+++ b/R/qenv-extract.R
@@ -42,7 +42,7 @@
     )
   }
 
-  x@.xData <- list2env(as.list(x)[names])
+  x@.xData <- list2env(as.list(x, all.names = TRUE)[names])
   names <- gsub("^`(.*)`$", "\\1", names)
   x@code <- get_code_dependency(x@code, names = names, ...)
 

From 173b3dd2baee903e360bdb9496fb1f0efb0b95d7 Mon Sep 17 00:00:00 2001
From: go_gonzo <dawid.kaledkowski@gmail.com>
Date: Fri, 8 Nov 2024 16:21:31 +0100
Subject: [PATCH 94/98] fix warn for env and code in extract

---
 R/qenv-extract.R                   | 42 ++++++++++++++++--------------
 R/utils-get_code_dependency.R      |  2 +-
 tests/testthat/test-qenv_extract.R | 17 ++++++++++--
 3 files changed, 38 insertions(+), 23 deletions(-)

diff --git a/R/qenv-extract.R b/R/qenv-extract.R
index 7723df48..4e4ad2a6 100644
--- a/R/qenv-extract.R
+++ b/R/qenv-extract.R
@@ -19,32 +19,34 @@
 `[.qenv` <- function(x, names, ...) {
   checkmate::assert_class(names, "character")
   possible_names <- ls(get_env(x), all.names = TRUE)
-  names_warn <- setdiff(names, possible_names)
-  names <- intersect(names, possible_names)
-  if (!length(names)) {
-    warning(
-      sprintf(
-        "None of 'names' elements exist in '%s'. Returning empty '%s'.",
-        class(x)[1],
-        class(x)[1]
+  names_corrected <- intersect(names, possible_names)
+  env <- if (length(names_corrected)) {
+    names_missing <- setdiff(names, possible_names)
+    if (length(names_missing)) {
+      warning(
+        sprintf(
+          "Some elements of 'names' do not exist in the environment of the '%s'. Skipping those: %s.",
+          class(x)[1],
+          paste(names_missing, collapse = ", ")
+        )
       )
-    )
-    return(qenv())
-  }
-
-  if (length(names_warn)) {
+    }
+    list2env(as.list(x, all.names = TRUE)[names_corrected], parent = parent.env(.GlobalEnv))
+  } else {
     warning(
       sprintf(
-        "Some elements of 'names' do not exist in '%s'. Skipping those: %s.",
-        class(x)[1],
-        paste(names_warn, collapse = ", ")
-      )
+        "None of 'names' exist in the environment of the '%1$s'. Returning empty '%1$s'.",
+        class(x)[1]
+      ),
+      call. = FALSE
     )
+    new.env(parent = parent.env(.GlobalEnv))
   }
+  lockEnvironment(env)
+  x@.xData <- env
 
-  x@.xData <- list2env(as.list(x, all.names = TRUE)[names])
-  names <- gsub("^`(.*)`$", "\\1", names)
-  x@code <- get_code_dependency(x@code, names = names, ...)
+  normalized_names <- gsub("^`(.*)`$", "\\1", names)
+  x@code <- get_code_dependency(x@code, names = normalized_names, ...)
 
   x
 }
diff --git a/R/utils-get_code_dependency.R b/R/utils-get_code_dependency.R
index 5fe6e267..00c651ae 100644
--- a/R/utils-get_code_dependency.R
+++ b/R/utils-get_code_dependency.R
@@ -38,7 +38,7 @@ get_code_dependency <- function(code, names, check_names = TRUE) {
     }))
 
     if (!all(names %in% unique(symbols))) {
-      warning("Object(s) not found in code: ", toString(setdiff(names, symbols)))
+      warning("Object(s) not found in code: ", toString(setdiff(names, symbols)), call. = FALSE)
     }
   }
 
diff --git a/tests/testthat/test-qenv_extract.R b/tests/testthat/test-qenv_extract.R
index e7ae0a77..dcbf73f2 100644
--- a/tests/testthat/test-qenv_extract.R
+++ b/tests/testthat/test-qenv_extract.R
@@ -5,7 +5,7 @@ testthat::test_that("`[.` returns empty qenv for names not in qenv", {
   })
   testthat::expect_warning(
     testthat::expect_equal(data["y"], qenv()),
-    "None of 'names' elements exist in 'qenv'. Returning empty 'qenv'."
+    "None of 'names' exist in the environment of the 'qenv'. Returning empty 'qenv."
   )
 })
 
@@ -16,10 +16,23 @@ testthat::test_that("`[.` returns limited qenv for some names not in qenv", {
   })
   testthat::expect_warning(
     testthat::expect_equal(data[c("y", "a")], data["a"]),
-    "Some elements of 'names' do not exist in 'qenv'. Skipping those: y."
+    "Some elements of 'names' do not exist in the environment of the 'qenv'. Skipping those: y."
   )
 })
 
+testthat::test_that("`[.` limits code for some names not in code", {
+  data <- within(qenv(), {
+    x <- 1
+    a <- 2
+    rm(x)
+  })
+  testthat::expect_warning(
+    testthat::expect_equal(data[c("a", "x")], data["a"]),
+    "Some elements of 'names' do not exist in the environment of the 'qenv'. Skipping those: x."
+  )
+})
+
+
 testthat::test_that("`[.` subsets environment and code to specified object names", {
   q <- qenv()
   code <- c("x<-1", "a<-1;b<-2")

From cc15b957c584d8f675f7d5722c9cae4625e3416f Mon Sep 17 00:00:00 2001
From: go_gonzo <dawid.kaledkowski@gmail.com>
Date: Fri, 8 Nov 2024 16:28:23 +0100
Subject: [PATCH 95/98] forbid names to be NA

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

diff --git a/R/qenv-extract.R b/R/qenv-extract.R
index 4e4ad2a6..a1f9191a 100644
--- a/R/qenv-extract.R
+++ b/R/qenv-extract.R
@@ -17,7 +17,7 @@
 #'
 #' @export
 `[.qenv` <- function(x, names, ...) {
-  checkmate::assert_class(names, "character")
+  checkmate::assert_character(names, any.missing = FALSE)
   possible_names <- ls(get_env(x), all.names = TRUE)
   names_corrected <- intersect(names, possible_names)
   env <- if (length(names_corrected)) {

From 0cc2351f03557ebbb33015632c1ac3e9fba4705f Mon Sep 17 00:00:00 2001
From: go_gonzo <dawid.kaledkowski@gmail.com>
Date: Fri, 8 Nov 2024 17:41:50 +0100
Subject: [PATCH 96/98] fix tests

---
 R/utils-get_code_dependency.R      |  2 +-
 tests/testthat/test-qenv_extract.R | 53 ++++++++++++++----------------
 2 files changed, 25 insertions(+), 30 deletions(-)

diff --git a/R/utils-get_code_dependency.R b/R/utils-get_code_dependency.R
index 00c651ae..3388f63c 100644
--- a/R/utils-get_code_dependency.R
+++ b/R/utils-get_code_dependency.R
@@ -38,7 +38,7 @@ get_code_dependency <- function(code, names, check_names = TRUE) {
     }))
 
     if (!all(names %in% unique(symbols))) {
-      warning("Object(s) not found in code: ", toString(setdiff(names, symbols)), call. = FALSE)
+      warning("Object(s) not found in code: ", toString(setdiff(names, symbols)), ".", call. = FALSE)
     }
   }
 
diff --git a/tests/testthat/test-qenv_extract.R b/tests/testthat/test-qenv_extract.R
index dcbf73f2..66a3ef92 100644
--- a/tests/testthat/test-qenv_extract.R
+++ b/tests/testthat/test-qenv_extract.R
@@ -1,38 +1,46 @@
-testthat::test_that("`[.` returns empty qenv for names not in qenv", {
+testthat::test_that("`[.` warns and subsets to empty if all names not present in env nor code", {
   data <- within(qenv(), {
-    x <- 1
-    a <- 2
+    a <- 1
+    b <- 2
   })
   testthat::expect_warning(
-    testthat::expect_equal(data["y"], qenv()),
+    testthat::expect_equal(data[c("y", "z")], qenv()),
+    "Object\\(s\\) not found in code: y, z."
+  )
+  testthat::expect_warning(
+    testthat::expect_equal(data[c("y", "z")], qenv()),
     "None of 'names' exist in the environment of the 'qenv'. Returning empty 'qenv."
   )
 })
 
-testthat::test_that("`[.` returns limited qenv for some names not in qenv", {
+testthat::test_that("`[.` warns and subsets to empty if all names not present in env", {
   data <- within(qenv(), {
-    x <- 1
-    a <- 2
+    a <- 1
+    b <- 2
+    c <- 3
+    rm(b, c)
   })
   testthat::expect_warning(
-    testthat::expect_equal(data[c("y", "a")], data["a"]),
-    "Some elements of 'names' do not exist in the environment of the 'qenv'. Skipping those: y."
+    testthat::expect_equal(data[c("b", "c")], qenv()),
+    "None of 'names' exist in the environment of the 'qenv'. Returning empty 'qenv'."
   )
 })
 
-testthat::test_that("`[.` limits code for some names not in code", {
+testthat::test_that("`[.` warns and subsets to existing if some names not present in env and code", {
   data <- within(qenv(), {
-    x <- 1
-    a <- 2
-    rm(x)
+    a <- 1
+    b <- 2
   })
   testthat::expect_warning(
-    testthat::expect_equal(data[c("a", "x")], data["a"]),
-    "Some elements of 'names' do not exist in the environment of the 'qenv'. Skipping those: x."
+    testthat::expect_equal(data[c("b", "c", "d")], data["b"]),
+    "Some elements of 'names' do not exist in the environment of the 'qenv'. Skipping those: c, d."
+  )
+  testthat::expect_warning(
+    testthat::expect_equal(data[c("b", "c", "d")], data["b"]),
+    "Object\\(s\\) not found in code: c, d."
   )
 })
 
-
 testthat::test_that("`[.` subsets environment and code to specified object names", {
   q <- qenv()
   code <- c("x<-1", "a<-1;b<-2")
@@ -64,16 +72,3 @@ testthat::test_that("`[.` comments are preserved in the code and associated with
     c("x<-1 #comment\n", "a<-1;")
   )
 })
-
-testthat::test_that("`[.` extract proper elements of @id, @warnings and @messages fiels", {
-  q <- qenv()
-  code <-
-    c("x<-1 #comment", "message('tiny message')", "a<-1;b<-2;warning('small warning')")
-  q <- eval_code(q, code)
-  qs <- q[c("x", "a")]
-
-  testthat::expect_identical(get_code_attr(qs, "id"), get_code_attr(q, "id")[c(1, 3)])
-  testthat::expect_identical(unlist(qs@code), unlist(q@code[c(1, 3)]))
-  testthat::expect_null(get_code_attr(qs, "warning"))
-  testthat::expect_null(get_code_attr(qs, "message"))
-})

From 2a0f49b591b180eb4a0299871e02989fa8625ba0 Mon Sep 17 00:00:00 2001
From: go_gonzo <dawid.kaledkowski@gmail.com>
Date: Fri, 8 Nov 2024 17:58:26 +0100
Subject: [PATCH 97/98] names warning on subset

---
 R/qenv-extract.R                   | 2 +-
 tests/testthat/test-qenv_extract.R | 2 +-
 2 files changed, 2 insertions(+), 2 deletions(-)

diff --git a/R/qenv-extract.R b/R/qenv-extract.R
index a1f9191a..0af75232 100644
--- a/R/qenv-extract.R
+++ b/R/qenv-extract.R
@@ -25,7 +25,7 @@
     if (length(names_missing)) {
       warning(
         sprintf(
-          "Some elements of 'names' do not exist in the environment of the '%s'. Skipping those: %s.",
+          "Some 'names' do not exist in the environment of the '%s'. Skipping those: %s.",
           class(x)[1],
           paste(names_missing, collapse = ", ")
         )
diff --git a/tests/testthat/test-qenv_extract.R b/tests/testthat/test-qenv_extract.R
index 66a3ef92..1fccda75 100644
--- a/tests/testthat/test-qenv_extract.R
+++ b/tests/testthat/test-qenv_extract.R
@@ -33,7 +33,7 @@ testthat::test_that("`[.` warns and subsets to existing if some names not presen
   })
   testthat::expect_warning(
     testthat::expect_equal(data[c("b", "c", "d")], data["b"]),
-    "Some elements of 'names' do not exist in the environment of the 'qenv'. Skipping those: c, d."
+    "Some 'names' do not exist in the environment of the 'qenv'. Skipping those: c, d."
   )
   testthat::expect_warning(
     testthat::expect_equal(data[c("b", "c", "d")], data["b"]),

From ba1a55265fa147b9fd8c36b8f894bc873907d207 Mon Sep 17 00:00:00 2001
From: go_gonzo <dawid.kaledkowski@gmail.com>
Date: Fri, 8 Nov 2024 18:51:00 +0100
Subject: [PATCH 98/98] fix for verified/unverified teal_data

---
 R/utils-get_code_dependency.R      |  6 +++---
 man/get_code_dependency.Rd         |  4 ++--
 tests/testthat/test-qenv_extract.R | 22 ++++++++++++++++++++++
 3 files changed, 27 insertions(+), 5 deletions(-)

diff --git a/R/utils-get_code_dependency.R b/R/utils-get_code_dependency.R
index 3388f63c..a6b66d7f 100644
--- a/R/utils-get_code_dependency.R
+++ b/R/utils-get_code_dependency.R
@@ -19,19 +19,19 @@
 #'
 #' @param code `character` with the code.
 #' @param names `character` vector of object names.
-#' @param check_names `logical(1)` flag specifying if a warning for non-existing names should be displayed.
+#' @param check_code_names `logical(1)` flag specifying if a warning for non-existing names should be displayed.
 #'
 #' @return Character vector, a subset of `code`.
 #' Note that subsetting is actually done on the calls `code`, not necessarily on the elements of the vector.
 #'
 #' @keywords internal
-get_code_dependency <- function(code, names, check_names = TRUE) {
+get_code_dependency <- function(code, names, check_code_names = TRUE) {
   checkmate::assert_list(code, "character")
   checkmate::assert_character(names, any.missing = FALSE)
 
   graph <- lapply(code, attr, "dependency")
 
-  if (check_names) {
+  if (check_code_names) {
     symbols <- unlist(lapply(graph, function(call) {
       ind <- match("<-", call, nomatch = length(call) + 1L)
       call[seq_len(ind - 1L)]
diff --git a/man/get_code_dependency.Rd b/man/get_code_dependency.Rd
index 8db40903..678f0233 100644
--- a/man/get_code_dependency.Rd
+++ b/man/get_code_dependency.Rd
@@ -4,14 +4,14 @@
 \alias{get_code_dependency}
 \title{Get code dependency of an object}
 \usage{
-get_code_dependency(code, names, check_names = TRUE)
+get_code_dependency(code, names, check_code_names = TRUE)
 }
 \arguments{
 \item{code}{\code{character} with the code.}
 
 \item{names}{\code{character} vector of object names.}
 
-\item{check_names}{\code{logical(1)} flag specifying if a warning for non-existing names should be displayed.}
+\item{check_code_names}{\code{logical(1)} flag specifying if a warning for non-existing names should be displayed.}
 }
 \value{
 Character vector, a subset of \code{code}.
diff --git a/tests/testthat/test-qenv_extract.R b/tests/testthat/test-qenv_extract.R
index 1fccda75..1d745910 100644
--- a/tests/testthat/test-qenv_extract.R
+++ b/tests/testthat/test-qenv_extract.R
@@ -41,6 +41,28 @@ testthat::test_that("`[.` warns and subsets to existing if some names not presen
   )
 })
 
+testthat::test_that("`[.` warns if name is in code but not in env", {
+  data <- within(qenv(), {
+    a <- 1
+    b <- 2
+    c <- 3
+    d <- 4
+  })
+  data@code <- data@code[1]
+  testthat::expect_warning(data[c("a", "b", "c")])
+})
+
+testthat::test_that("`[.` doesn't warn if name is in code but not in env (secret feature for unverified teal_data)", {
+  data <- within(qenv(), {
+    a <- 1
+    b <- 2
+    c <- 3
+    d <- 4
+  })
+  data@code <- data@code[1]
+  testthat::expect_silent(data[c("a", "b", "c"), check_code_names = FALSE])
+})
+
 testthat::test_that("`[.` subsets environment and code to specified object names", {
   q <- qenv()
   code <- c("x<-1", "a<-1;b<-2")