From 6587cb4f4f67b3e5de585c5525d97943dccc5649 Mon Sep 17 00:00:00 2001 From: m7pr Date: Wed, 27 Nov 2024 21:15:12 +0100 Subject: [PATCH 1/4] bye bye ass_cond --- R/utils-get_code_dependency.R | 19 ++++++----- tests/testthat/test-qenv_get_code.R | 50 +++++++++++++++++++++++++++++ 2 files changed, 61 insertions(+), 8 deletions(-) diff --git a/R/utils-get_code_dependency.R b/R/utils-get_code_dependency.R index 4a696d4ff..63fe6a849 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,23 @@ 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 <- setdiff( + 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 +312,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 9b619d4d1..5a689b655 100644 --- a/tests/testthat/test-qenv_get_code.R +++ b/tests/testthat/test-qenv_get_code.R @@ -596,6 +596,56 @@ 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 + } + }) + + 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)", { From bdf0e122446e1ae023fdfbd5471a2069701e774c Mon Sep 17 00:00:00 2001 From: github-actions <41898282+github-actions[bot]@users.noreply.github.com> Date: Wed, 27 Nov 2024 20:18:55 +0000 Subject: [PATCH 2/4] [skip style] [skip vbump] Restyle files --- tests/testthat/test-qenv_get_code.R | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/tests/testthat/test-qenv_get_code.R b/tests/testthat/test-qenv_get_code.R index 5a689b655..507cfa8cf 100644 --- a/tests/testthat/test-qenv_get_code.R +++ b/tests/testthat/test-qenv_get_code.R @@ -601,7 +601,6 @@ testthat::test_that("detects occurrence of a function definition with a @linksto # 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] @@ -617,7 +616,6 @@ testthat::test_that("objects in for loop are extracted if passed as one characte 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", { @@ -640,7 +638,7 @@ testthat::test_that("objects in for loop are extracted if passed as separate cal "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 + " b <- b + 3", # ORDER IS CHANGED IN HERE, but we can live with it "}" ) ) From b5d412d55ef6f8acc61ceb306b9576a5fd8c4a8c Mon Sep 17 00:00:00 2001 From: Marcin <133694481+m7pr@users.noreply.github.com> Date: Fri, 29 Nov 2024 09:57:25 +0100 Subject: [PATCH 3/4] Update R/utils-get_code_dependency.R MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Co-authored-by: André Veríssimo <211358+averissimo@users.noreply.github.com> Signed-off-by: Marcin <133694481+m7pr@users.noreply.github.com> --- R/utils-get_code_dependency.R | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/R/utils-get_code_dependency.R b/R/utils-get_code_dependency.R index 63fe6a849..c94fdb2bf 100644 --- a/R/utils-get_code_dependency.R +++ b/R/utils-get_code_dependency.R @@ -294,10 +294,7 @@ extract_occurrence <- function(pd) { } # For cases like 'eval(expression(c <- b + 2))' removes 'eval(expression('. - sym_cond <- setdiff( - sym_cond, - sym_cond[sym_cond < min(assign_cond) & sym_cond %in% sym_fc_cond] - ) + 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[assign_cond]) == "->") { # What if there are 2 assignments: e.g. a <- b -> c. From 8e50958720a167aa3ddcf722eaff2849e7bc2989 Mon Sep 17 00:00:00 2001 From: Marcin <133694481+m7pr@users.noreply.github.com> Date: Fri, 29 Nov 2024 09:57:35 +0100 Subject: [PATCH 4/4] Update tests/testthat/test-qenv_get_code.R MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Co-authored-by: André Veríssimo <211358+averissimo@users.noreply.github.com> Signed-off-by: Marcin <133694481+m7pr@users.noreply.github.com> --- 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 507cfa8cf..cf06f0ca9 100644 --- a/tests/testthat/test-qenv_get_code.R +++ b/tests/testthat/test-qenv_get_code.R @@ -626,7 +626,7 @@ testthat::test_that("objects in for loop are extracted if passed as separate cal for (x in c(1, 2)) { b <- a b <- b + a + 1 - b + 3 -> b + b + 3 -> b # nolint: assignment. } })