fix code parser for := operator

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_dt_assign(calls)
   fix_arrows(calls)
 }
 
@@ -148,6 +149,22 @@ fix_shifted_comments <- function(calls) {
 #' which is \code{`<-`(y,x)} instead of traditional `y <- x`.
 #' @keywords internal
 #' @noRd
+remove_dt_assign <- function(calls) {
+  checkmate::assert_list(calls)
+  lapply(calls, function(call) {
+    dt_assign <-
+      which(call$token == "LEFT_ASSIGN" & call$text == ":=")
+    if (length(dt_assign) > 0) {
+      call[-dt_assign, ]
+    } else {
+      call
+    }
+  })
+}
+
+#' Fixes edge case of `:=` assignment operator being treated as assignemnt.
+#' @keywords internal
+#' @noRd
 fix_arrows <- function(calls) {
   checkmate::assert_list(calls)
   lapply(calls, function(call) {

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.