Merge branch 'main' into 288_ellipsis_get_code@main

DESCRIPTION

@@ -1,8 +1,8 @@
 Type: Package
 Package: teal.data
 Title: Data Model for 'teal' Applications
-Version: 0.4.0.9002
-Date: 2024-02-05
+Version: 0.4.0.9003
+Date: 2024-02-06
 Authors@R: c(
     person("Dawid", "Kaledkowski", , "[email protected]", role = c("aut", "cre"),
            comment = c(ORCID = "0000-0001-9533-457X")),

NEWS.md

@@ -1,4 +1,4 @@
-# teal.data 0.4.0.9002
+# teal.data 0.4.0.9003
 
 # teal.data 0.4.0
 

R/utils-get_code_dependency.R

@@ -203,7 +203,7 @@ code_graph <- function(calls_pd) {
 
   side_effects <- extract_side_effects(calls_pd)
 
-  mapply(function(x, y) unique(c(x, y)), side_effects, cooccurrence, SIMPLIFY = FALSE)
+  mapply(c, side_effects, cooccurrence, SIMPLIFY = FALSE)
 }
 
 #' Extract object occurrence
@@ -236,6 +236,13 @@ extract_occurrence <- function(calls_pd) {
       rep(FALSE, nrow(x))
     }
   }
+  in_parenthesis <- function(x) {
+    if (any(x$token %in% c("LBB", "'['"))) {
+      id_start <- min(x$id[x$token %in% c("LBB", "'['")])
+      id_end <- min(x$id[x$token == "']'"])
+      x$text[x$token == "SYMBOL" & x$id > id_start & x$id < id_end]
+    }
+  }
   lapply(
     calls_pd,
     function(call_pd) {
@@ -308,7 +315,14 @@ extract_occurrence <- function(calls_pd) {
         sym_cond <- rev(sym_cond)
       }
 
-      append(unique(x[sym_cond, "text"]), "<-", after = 1)
+      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)
+      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('.

tests/testthat/test-get_code.R

@@ -184,6 +184,35 @@ testthat::test_that("does not break if code uses quote()", {
   )
 })
 
+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]"
+  )
+  tdata <- eval_code(teal_data(), code = code)
+  testthat::expect_identical(
+    get_code(tdata, datanames = "iris"),
+    paste(code[c(1, 3)], collapse = "\n")
+  )
+})
+
+testthat::test_that(
+  "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"
+    )
+    tdata <- eval_code(teal_data(), code = code)
+    testthat::expect_identical(
+      get_code(tdata, datanames = "x"),
+      paste(code, collapse = "\n")
+    )
+  }
+)
+
 # assign ----------------------------------------------------------------------------------------------------------
 
 testthat::test_that("extracts the code for assign() where \"x\" is a literal string", {
@@ -505,7 +534,7 @@ testthat::test_that("detects cooccurrence properly even if all objects are on lh
   tdata <- eval_code(teal_data(), code)
   testthat::expect_identical(
     get_code(tdata, datanames = "b"),
-    paste("a <- 1", "b <- list(c = 2)", "b[[a]] <- 3", sep = "\n")
+    paste(code, collapse = "\n")
   )
 })