diff --git a/R/utils-get_code_dependency.R b/R/utils-get_code_dependency.R index bfed13afd..4a696d4ff 100644 --- a/R/utils-get_code_dependency.R +++ b/R/utils-get_code_dependency.R @@ -106,6 +106,7 @@ extract_calls <- function(pd) { calls <- Filter(function(call) !(nrow(call) == 1 && call$token == "';'"), calls) calls <- Filter(Negate(is.null), calls) calls <- fix_shifted_comments(calls) + calls <- remove_custom_assign(calls, c(":=")) fix_arrows(calls) } @@ -144,6 +145,23 @@ fix_shifted_comments <- function(calls) { Filter(nrow, calls) } +#' Fixes edge case of custom assignments operator being treated as assignment. +#' +#' @param exclude (`character`) custom assignment operators to be excluded +#' @keywords internal +#' @noRd +remove_custom_assign <- function(calls, exclude = NULL) { + checkmate::assert_list(calls) + checkmate::assert_character(exclude, null.ok = TRUE) + lapply(calls, function(call) { + if (!is.null(exclude)) { + call[!(call$token == "LEFT_ASSIGN" & call$text %in% exclude), ] + } else { + call + } + }) +} + #' Fixes edge case of `<-` assignment operator being called as function, #' which is \code{`<-`(y,x)} instead of traditional `y <- x`. #' @keywords internal diff --git a/tests/testthat/test-qenv_eval_code.R b/tests/testthat/test-qenv_eval_code.R index 01bdccec4..689ee170b 100644 --- a/tests/testthat/test-qenv_eval_code.R +++ b/tests/testthat/test-qenv_eval_code.R @@ -105,6 +105,15 @@ testthat::test_that("eval_code accepts calls containing only comments and empty testthat::expect_identical(get_code(eval_code(qenv(), code)), code) }) +testthat::test_that("eval_code does not treat := as an assignment operator", { + code <- " + x <- 'name' + rlang::list2(!!x := 1) + " + q <- eval_code(qenv(), code) + testthat::expect_identical(get_code(q), code) +}) + # comments ---------- testthat::test_that("comments fall into proper calls", { # If comment is on top, it gets moved to the first call.