Fix ‘sym_cond > ass_cond’: longer object

R/utils-get_code_dependency.R

@@ -274,6 +274,7 @@ extract_occurrence <- function(pd) {
   # 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_fc_cond <- which(x$token == "SYMBOL_FUNCTION_CALL")
 
   if (length(sym_cond) == 0) {
     return(character(0L))
@@ -287,28 +288,27 @@ extract_occurrence <- function(pd) {
     sym_cond <- setdiff(sym_cond, which(x$id %in% after_dollar))
   }
 
-  ass_cond <- grep("ASSIGN", x$token)
-  if (!length(ass_cond)) {
+  assign_cond <- grep("ASSIGN", x$token)
+  if (!length(assign_cond)) {
     return(c("<-", unique(x[sym_cond, "text"])))
   }
 
-  sym_cond <- sym_cond[sym_cond > ass_cond] # NOTE 1
+  # For cases like 'eval(expression(c <- b + 2))' removes 'eval(expression('.
+  sym_cond <- sym_cond[!(sym_cond < min(assign_cond) & sym_cond %in% sym_fc_cond)]
+
   # If there was an assignment operation detect direction of it.
-  if (unique(x$text[ass_cond]) == "->") { # NOTE 2
+  if (unique(x$text[assign_cond]) == "->") { # What if there are 2 assignments: e.g. a <- b -> c.
     sym_cond <- rev(sym_cond)
   }
 
-  after <- match(min(x$id[ass_cond]), sort(x$id[c(min(ass_cond), sym_cond)])) - 1
+  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))
   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

tests/testthat/test-qenv_get_code.R

@@ -596,6 +596,54 @@ testthat::test_that("detects occurrence of a function definition with a @linksto
     pasten(code[1:2])
   )
 })
+
+
+# for loop --------------------------------------------------------------------------------------------------------
+
+testthat::test_that("objects in for loop are extracted if passed as one character", {
+  code <- "
+    some_other_dataset <- mtcars
+    original_dataset <- iris[, 1:4]
+    count <- 1
+    for (x in colnames(original_dataset)) {
+      original_dataset[, x] <- original_dataset[, x] * 2
+      count <- count + 1
+    }
+    output <- rlang::list2(x = original_dataset)
+  "
+  q <- eval_code(qenv(), code)
+  testthat::expect_identical(
+    get_code(q, names = "output"),
+    gsub("\n    some_other_dataset <- mtcars\n", "", code, fixed = TRUE)
+  )
+})
+
+testthat::test_that("objects in for loop are extracted if passed as separate calls", {
+  q <- within(qenv(), {
+    a <- 1
+    b <- 2
+  }) |> within({
+    for (x in c(1, 2)) {
+      b <- a
+      b <- b + a + 1
+      b + 3 -> b # nolint: assignment.
+    }
+  })
+
+  testthat::expect_setequal(
+    strsplit(get_code(q, names = "b"), "\n")[[1]],
+    c(
+      "a <- 1",
+      "b <- 2",
+      "for (x in c(1, 2)) {",
+      "    b <- a",
+      "    b <- b + a + 1",
+      "    b <- b + 3", # ORDER IS CHANGED IN HERE, but we can live with it
+      "}"
+    )
+  )
+})
+
 # $ ---------------------------------------------------------------------------------------------------------------
 
 testthat::test_that("understands $ usage and do not treat rhs of $ as objects (only lhs)", {