Fix bug, add tests and update NEWS

DESCRIPTION

@@ -50,7 +50,7 @@ Config/Needs/verdepcheck: mllg/checkmate, r-lib/cli, r-lib/lifecycle,
     r-lib/rlang, r-lib/cli, yihui/knitr, rstudio/rmarkdown, rstudio/shiny,
     r-lib/testthat, r-lib/withr
 Config/Needs/website: insightsengineering/nesttemplate
-Config/roxygen2/version: 8.0.0
+Config/roxygen2/version: 8.1.0
 Encoding: UTF-8
 Language: en-US
 Roxygen: list(markdown = TRUE)

NEWS.md

@@ -1,5 +1,9 @@
 # teal.code 0.7.2.9000
 
+### Bug fixes
+
+* Fixed a problem parsing expression referring to the same object (#293)
+
 # teal.code 0.7.2
 
 ### Bug fixes

R/utils-get_code_dependency.R

@@ -304,22 +304,7 @@ extract_occurrence <- function(pd) {
   after <- match(min(x$id[assign_cond]), sort(x$id[c(min(assign_cond), sym_cond)])) - 1
   ans <- append(x[sym_cond, "text"], "<-", after = max(1, after))
   ans <- move_functions_after_arrow(ans, unique(x[sym_fc_cond, "text"]))
-  roll <- in_parenthesis(pd)
-  if (length(roll)) {
-    # detect elements appeared in parenthesis and move them on RHS
-    # but only their first appearance
-    # as the same object can appear as regular object and the one used in parenthesis
-    result <- ans
-    for (elem in roll) {
-      idx <- which(result == elem)[1]
-      if (!is.na(idx)) {
-        result <- result[-idx]
-      }
-    }
-    c(result, roll)
-  } else {
-    ans
-  }
+  c(ans, unique(in_parenthesis(pd)))
 }
 
 #' Moves function names to the right side of dependency graph

tests/testthat.R

@@ -1,3 +1,5 @@
 pkg_name <- "teal.code"
 library(pkg_name, character.only = TRUE)
-testthat::test_check(pkg_name)
+if (requireNamespace("testthat", quietly = TRUE)) {
+  testthat::test_check(pkg_name)
+}

tests/testthat/setup-options.R

@@ -15,6 +15,6 @@ opts_partial_match_new <- list(
 if (isFALSE(getFromNamespace("on_cran", "testthat")()) && requireNamespace("withr", quietly = TRUE)) {
   withr::local_options(
     opts_partial_match_new,
-    .local_envir = testthat::teardown_env()
+    .local_envir = teardown_env()
   )
 }

tests/testthat/test-get_outputs.R

@@ -1,11 +1,11 @@
-testthat::describe("get_output", {
-  testthat::it("returns an empty list if nothing is printed", {
+describe("get_output", {
+  it("returns an empty list if nothing is printed", {
     q <- qenv()
     q1 <- eval_code(q, expression(a <- 1L, b <- 2L))
-    testthat::expect_identical(get_outputs(q1), list())
+    expect_identical(get_outputs(q1), list())
   })
 
-  testthat::it("implicitly printed objects are returned asis in a list and are identical to ones in the environment", {
+  it("implicitly printed objects are returned asis in a list and are identical to ones in the environment", {
     q <- qenv()
     q1 <- eval_code(
       q,
@@ -14,9 +14,9 @@ testthat::describe("get_output", {
         b <- structure(list(aa = list(aaa = "aaa")), class = "class_to_break"), b
       )
     )
-    testthat::expect_identical(get_outputs(q1), unname(as.list(q1)))
-    testthat::expect_true(rlang::is_reference(get_outputs(q1)[[1]], q1$a))
-    testthat::expect_true(rlang::is_reference(get_outputs(q1)[[2]], q1$b))
+    expect_identical(get_outputs(q1), unname(as.list(q1)))
+    expect_true(rlang::is_reference(get_outputs(q1)[[1]], q1$a))
+    expect_true(rlang::is_reference(get_outputs(q1)[[2]], q1$b))
   })
 
   # it cannot have a package prefix here until upstream bug in testthat is solved
@@ -31,12 +31,12 @@ testthat::describe("get_output", {
         new_obj
       )
     )
-    testthat::expect_identical(get_outputs(q1), unname(as.list(q1)))
-    testthat::expect_true(rlang::is_reference(get_outputs(q1)[[1]], q1$new_obj))
-    testthat::expect_s4_class(get_outputs(q1)[[1]], "NewS4Class")
+    expect_identical(get_outputs(q1), unname(as.list(q1)))
+    expect_true(rlang::is_reference(get_outputs(q1)[[1]], q1$new_obj))
+    expect_s4_class(get_outputs(q1)[[1]], "NewS4Class")
   })
 
-  testthat::it("implicitly printed list is returned asis even if its print is overridden", {
+  it("implicitly printed list is returned asis even if its print is overridden", {
     q <- qenv()
     q1 <- eval_code(
       q,
@@ -49,16 +49,16 @@ testthat::describe("get_output", {
         b
       )
     )
-    testthat::expect_identical(get_outputs(q1), list(q1$b))
+    expect_identical(get_outputs(q1), list(q1$b))
   })
 
-  testthat::it("explicitly printed objects are returned as console-output-string in a list", {
+  it("explicitly printed objects are returned as console-output-string in a list", {
     q <- qenv()
     q1 <- eval_code(q, expression(a <- 1L, print(a), b <- 2L, print(b)))
-    testthat::expect_identical(get_outputs(q1), list("[1] 1\n", "[1] 2\n"))
+    expect_identical(get_outputs(q1), list("[1] 1\n", "[1] 2\n"))
   })
 
-  testthat::it("explicitly printed object uses newly registered print method and returned as console-output-string", {
+  it("explicitly printed object uses newly registered print method and returned as console-output-string", {
     q <- qenv()
     q1 <- eval_code(
       q,
@@ -71,44 +71,44 @@ testthat::describe("get_output", {
         print(b)
       )
     )
-    testthat::expect_identical(get_outputs(q1), list("[1] \"test_print\"\n"))
+    expect_identical(get_outputs(q1), list("[1] \"test_print\"\n"))
   })
 
-  testthat::it("printed plots are returned as recordedplot in a list (1)", {
+  it("printed plots are returned as recordedplot in a list (1)", {
     q <- qenv()
     q1 <- eval_code(q, expression(a <- 1L, plot(a)))
-    testthat::expect_true(inherits(get_outputs(q1)[[1]], "recordedplot"))
+    expect_true(inherits(get_outputs(q1)[[1]], "recordedplot"))
   })
 
-  testthat::it("printed plots are returned as recordedplot in a list (2)", {
+  it("printed plots are returned as recordedplot in a list (2)", {
     q <- qenv()
     q1 <- eval_code(q, expression(a <- seq_len(10L), hist(a)))
-    testthat::expect_true(inherits(get_outputs(q1)[[1]], "recordedplot"))
+    expect_true(inherits(get_outputs(q1)[[1]], "recordedplot"))
   })
 
-  testthat::it("warnings are returned asis in a list", {
+  it("warnings are returned asis in a list", {
     q <- qenv()
     q1 <- eval_code(q, expression(warning("test")))
     expected <- simpleWarning("test")
     expected["call"] <- NULL
-    testthat::expect_identical(get_outputs(q1), list(expected))
+    expect_identical(get_outputs(q1), list(expected))
   })
 
-  testthat::it("messages are returned asis in a list", {
+  it("messages are returned asis in a list", {
     q <- qenv()
     q1 <- eval_code(q, expression(message("test")))
     expected <- simpleMessage("test\n", call = quote(message("test")))
-    testthat::expect_identical(get_outputs(q1), list(expected))
+    expect_identical(get_outputs(q1), list(expected))
   })
 
-  testthat::it("prints inside for are bundled together", {
+  it("prints inside for are bundled together", {
     q <- within(qenv(), for (i in 1:3) print(i))
-    testthat::expect_identical(get_outputs(q)[[1]], "[1] 1\n[1] 2\n[1] 3\n")
+    expect_identical(get_outputs(q)[[1]], "[1] 1\n[1] 2\n[1] 3\n")
   })
 
-  testthat::it("intermediate plots are not kept", {
+  it("intermediate plots are not kept", {
     q <- qenv()
     q1 <- eval_code(q, expression(plot(1:10), title("A title")))
-    testthat::expect_length(get_outputs(q1), 1)
+    expect_length(get_outputs(q1), 1)
   })
 })

tests/testthat/test-qenv-class.R

@@ -1,20 +1,20 @@
-testthat::describe("methods::new(qenv)", {
-  testthat::it("creates a locked environment", {
+describe("methods::new(qenv)", {
+  it("creates a locked environment", {
     expect_true(environmentIsLocked(as.environment(methods::new("qenv"))))
   })
 
-  testthat::it("creates a locked environment when .xData is manually defined", {
+  it("creates a locked environment when .xData is manually defined", {
     new_env <- new.env()
     expect_false(environmentIsLocked(new_env))
 
     expect_true(environmentIsLocked(as.environment(methods::new("qenv", .xData = new_env))))
   })
 
-  testthat::it("throws error when .xData is not an environment", {
+  it("throws error when .xData is not an environment", {
     expect_error(methods::new("qenv", .xData = 2), "Must be an environment, not 'double'\\.")
   })
 
-  testthat::it("initialized qenv(s) have different environments", {
-    testthat::expect_false(identical(qenv()@.xData, qenv()@.xData))
+  it("initialized qenv(s) have different environments", {
+    expect_false(identical(qenv()@.xData, qenv()@.xData))
   })
 })

tests/testthat/test-qenv_concat.R

@@ -1,15 +1,15 @@
-testthat::test_that("Concatenate two identical qenvs outputs", {
+test_that("Concatenate two identical qenvs outputs", {
   q <- qenv()
   q1 <- eval_code(q, quote(iris1 <- iris))
   q2 <- q1
 
   q12 <- concat(q1, q2)
 
-  testthat::expect_equal(q12@.xData, q1@.xData)
-  testthat::expect_identical(get_code(q12), "iris1 <- iris\niris1 <- iris")
+  expect_equal(q12@.xData, q1@.xData)
+  expect_identical(get_code(q12), "iris1 <- iris\niris1 <- iris")
 })
 
-testthat::test_that("Concatenate two independent qenvs results in object having combined code and environments", {
+test_that("Concatenate two independent qenvs results in object having combined code and environments", {
   q1 <- qenv()
   q2 <- qenv()
 
@@ -18,39 +18,39 @@ testthat::test_that("Concatenate two independent qenvs results in object having
 
   q12 <- concat(q1, q2)
 
-  testthat::expect_equal(q12@.xData, list2env(list(iris1 = iris, mtcars1 = mtcars)))
-  testthat::expect_identical(get_code(q12), "iris1 <- iris\nmtcars1 <- mtcars")
-  testthat::expect_identical(names(q12@code), c(names(q1@code), names(q2@code)))
+  expect_equal(q12@.xData, list2env(list(iris1 = iris, mtcars1 = mtcars)))
+  expect_identical(get_code(q12), "iris1 <- iris\nmtcars1 <- mtcars")
+  expect_identical(names(q12@code), c(names(q1@code), names(q2@code)))
 })
 
-testthat::test_that("Concatenate qenvs results with the same variable, the RHS has priority", {
+test_that("Concatenate qenvs results with the same variable, the RHS has priority", {
   q1 <- eval_code(qenv(), quote(a <- data.frame(1)))
   q2 <- eval_code(qenv(), quote(a <- data.frame(2)))
 
   q12 <- concat(q1, q2)
-  testthat::expect_identical(q12[["a"]], data.frame(2))
+  expect_identical(q12[["a"]], data.frame(2))
 })
 
-testthat::test_that("Concatenate with a qenv.error object returns the qenv.error object", {
+test_that("Concatenate with a qenv.error object returns the qenv.error object", {
   q1 <- eval_code(qenv(), quote(x <- 1))
   error_q <- eval_code(qenv(), quote(y <- w))
   error_q2 <- eval_code(qenv(), quote(z <- w))
 
-  testthat::expect_s3_class(concat(q1, error_q), "qenv.error")
-  testthat::expect_s3_class(concat(error_q, error_q2), "qenv.error")
-  testthat::expect_s3_class(concat(error_q, q1), "qenv.error")
+  expect_s3_class(concat(q1, error_q), "qenv.error")
+  expect_s3_class(concat(error_q, error_q2), "qenv.error")
+  expect_s3_class(concat(error_q, q1), "qenv.error")
 
   # if joining two qenv.error objects keep the first
-  testthat::expect_equal(concat(error_q, error_q2), error_q)
+  expect_equal(concat(error_q, error_q2), error_q)
 })
 
-testthat::test_that("Concatenate two independent qenvs with warnings results in object having combined warnings", {
+test_that("Concatenate 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')")
 
   q12 <- concat(q1, q2)
 
-  testthat::expect_identical(
+  expect_identical(
     get_warnings(q12),
     paste(
       "~~~ Warnings ~~~",
@@ -68,13 +68,13 @@ testthat::test_that("Concatenate two independent qenvs with warnings results in
   )
 })
 
-testthat::test_that("Concatenate two independent qenvs with messages results in object having combined messages", {
+test_that("Concatenate two independent qenvs with messages results in object having combined messages", {
   q1 <- eval_code(qenv(), "message('This is message 1')")
   q2 <- eval_code(qenv(), "message('This is message 2')")
 
   q12 <- concat(q1, q2)
 
-  testthat::expect_identical(
+  expect_identical(
     get_messages(q12),
     paste(
       "~~~ Messages ~~~",

tests/testthat/test-qenv_constructor.R

@@ -1,67 +1,67 @@
-testthat::describe("qenv inherits from environment: ", {
-  testthat::it("is an environment", {
-    testthat::expect_true(is.environment(qenv()))
+describe("qenv inherits from environment: ", {
+  it("is an environment", {
+    expect_true(is.environment(qenv()))
   })
 
-  testthat::it("names() shows nothing on empty environment", {
-    testthat::expect_identical(names(qenv()), character(0))
+  it("names() shows nothing on empty environment", {
+    expect_identical(names(qenv()), character(0))
   })
 
-  testthat::it("names() shows available objets", {
+  it("names() shows available objets", {
     q <- within(qenv(), iris <- iris)
-    testthat::expect_setequal(names(q), "iris")
+    expect_setequal(names(q), "iris")
   })
 
-  testthat::it("names() shows hidden objects", {
+  it("names() shows hidden objects", {
     q <- within(qenv(), {
       iris <- iris
       .hidden <- 2
     })
-    testthat::expect_setequal(names(q), c("iris", ".hidden"))
+    expect_setequal(names(q), c("iris", ".hidden"))
   })
 
-  testthat::it("ls() does not show hidden objects", {
+  it("ls() does not show hidden objects", {
     q <- within(qenv(), {
       iris <- iris
       .hidden <- 2
     })
-    testthat::expect_setequal(ls(q), c("iris"))
+    expect_setequal(ls(q), c("iris"))
   })
 
-  testthat::it("ls(all.names = TRUE) show all objects", {
+  it("ls(all.names = TRUE) show all objects", {
     q <- eval_code(qenv(), "
       iris <- iris
       .hidden <- 2
     ")
-    testthat::expect_setequal(ls(q, all.names = TRUE), c("iris", ".hidden"))
+    expect_setequal(ls(q, all.names = TRUE), c("iris", ".hidden"))
   })
 
-  testthat::it("does not allow binding to be added", {
+  it("does not allow binding to be added", {
     q <- qenv()
-    testthat::expect_error(q$x <- 1, "cannot add bindings to a locked environment")
+    expect_error(q$x <- 1, "cannot add bindings to a locked environment")
   })
 
-  testthat::it("does not allow binding to be modified", {
+  it("does not allow binding to be modified", {
     q <- within(qenv(), obj <- 1)
-    testthat::expect_error(q$obj <- 2, "cannot change value of locked binding for 'obj'")
+    expect_error(q$obj <- 2, "cannot change value of locked binding for 'obj'")
   })
 })
 
-testthat::test_that("constructor returns qenv", {
+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, list())
+  expect_s4_class(q, "qenv")
+  expect_identical(names(q), character(0))
+  expect_identical(q@code, list())
 })
 
-testthat::describe("parent of qenv environment is the parent of .GlobalEnv", {
-  testthat::it("via slot", {
+describe("parent of qenv environment is the parent of .GlobalEnv", {
+  it("via slot", {
     q <- qenv()
-    testthat::expect_identical(parent.env(q@.xData), parent.env(.GlobalEnv))
+    expect_identical(parent.env(q@.xData), parent.env(.GlobalEnv))
   })
 
-  testthat::it("via qenv directly", {
+  it("via qenv directly", {
     q <- qenv()
-    testthat::expect_identical(parent.env(q), parent.env(.GlobalEnv))
+    expect_identical(parent.env(q), parent.env(.GlobalEnv))
   })
 })