Skip to content
Merged
Show file tree
Hide file tree
Changes from 10 commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
24 changes: 24 additions & 0 deletions R/utils-get_code_dependency.R
Original file line number Diff line number Diff line change
Expand Up @@ -303,6 +303,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)) {
c(setdiff(ans, roll), roll)
Expand All @@ -311,6 +312,29 @@ extract_occurrence <- function(pd) {
}
}

#' Moves function names to the right side of dependency graph
#'
#' Changes status of the function call from dependent to dependency if occurs in the lhs.
#' Technically, it means it to move function names after the dependency operator.
#' For example, for `attributes(a) <- b` the dependency graph should look like `c("a", "<-", "b", "attributes")`.
#'
#' @param ans `character` vector of object names in dependency graph.
#' @param functions `character` vector of function names.
#'
#' @return
#' A character vector.
#' @keywords internal
#' @noRd
move_functions_after_arrow <- function(ans, functions) {
arrow_pos <- which(ans == "<-")
if (length(arrow_pos) == 0) {
return(ans)
}
before_arrow <- setdiff(ans[1:arrow_pos], functions)
after_arrow <- ans[(arrow_pos + 1):length(ans)]
c(before_arrow, unique(c(intersect(ans[1:arrow_pos], functions), after_arrow)))
}

#' Extract side effects
#'
#' Extracts all object names from the code that are marked with `@linksto` tag.
Expand Down
11 changes: 11 additions & 0 deletions tests/testthat/test-qenv_get_code.R
Original file line number Diff line number Diff line change
Expand Up @@ -290,6 +290,17 @@
)
}
)
testthat::it("doesn't consider function called on the lhs as a dependent in this call (dependency in further calls)", {

Check warning on line 293 in tests/testthat/test-qenv_get_code.R

View workflow job for this annotation

GitHub Actions / SuperLinter 🦸‍♀️ / Lint R code 🧶

file=tests/testthat/test-qenv_get_code.R,line=293,col=121,[line_length_linter] Lines should not be more than 120 characters. This line is 121 characters.
code <- c(
"object_list <- list(x = iris, y = iris)",
"object_list_2 <- list(x = mtcars, y = mtcars)",
"object_list_2[c('x')] <- c('string')",
"object_list[c('x')] <- c('string')"
)
q <- eval_code(qenv(), code = code)
result <- get_code(q, names = "object_list")
testthat::expect_identical(result, paste(code[c(1, 4)], collapse = "\n"))
})
})


Expand Down
Loading