diff --git a/R/utils-get_code_dependency.R b/R/utils-get_code_dependency.R index 4a696d4f..c94fdb2b 100644 --- a/R/utils-get_code_dependency.R +++ b/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,18 +288,20 @@ 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)) { @@ -306,9 +309,6 @@ extract_occurrence <- function(pd) { } 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 diff --git a/tests/testthat/test-qenv_get_code.R b/tests/testthat/test-qenv_get_code.R index 9b619d4d..cf06f0ca 100644 --- a/tests/testthat/test-qenv_get_code.R +++ b/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)", {