From 8b5e76e82666770b9cebf34f54e9bfefc9e58c24 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?=
 <211358+averissimo@users.noreply.github.com>
Date: Wed, 16 Oct 2024 17:37:10 +0100
Subject: [PATCH] feature: supports special symbols with backticks

---
 R/utils-get_code_dependency.R  |  6 ++--
 tests/testthat/test-get_code.R | 55 ++++++++++++++++++++++++++++++++++
 2 files changed, 59 insertions(+), 2 deletions(-)

diff --git a/R/utils-get_code_dependency.R b/R/utils-get_code_dependency.R
index b8dda9dd3..643e603ec 100644
--- a/R/utils-get_code_dependency.R
+++ b/R/utils-get_code_dependency.R
@@ -297,7 +297,7 @@ extract_occurrence <- function(calls_pd) {
 
       # What occurs in a function body is not tracked.
       x <- call_pd[!is_in_function(call_pd), ]
-      sym_cond <- which(x$token %in% c("SYMBOL", "SYMBOL_FUNCTION_CALL"))
+      sym_cond <- which(x$token %in% c("SPECIAL", "SYMBOL", "SYMBOL_FUNCTION_CALL"))
 
       if (length(sym_cond) == 0) {
         return(character(0L))
@@ -380,10 +380,12 @@ extract_side_effects <- function(calls_pd) {
 #' @keywords internal
 #' @noRd
 graph_parser <- function(x, graph) {
+  # normalize x to remove surrounding backticks
+  x <- gsub("^`|`$", "", x)
   occurrence <- vapply(
     graph, function(call) {
       ind <- match("<-", call, nomatch = length(call) + 1L)
-      x %in% call[seq_len(ind - 1L)]
+      x %in% gsub("^`|`$", "", call[seq_len(ind - 1L)])
     },
     logical(1)
   )
diff --git a/tests/testthat/test-get_code.R b/tests/testthat/test-get_code.R
index 40095f1bc..102a0d08d 100644
--- a/tests/testthat/test-get_code.R
+++ b/tests/testthat/test-get_code.R
@@ -695,3 +695,58 @@ testthat::test_that("data() call is returned when data name is provided as a cha
     )
   )
 })
+
+testthat::describe("Backticked special symbols", {
+  testthat::it("starting with underscore code dependency is being detected", {
+    td <- teal_data() |>
+      within({
+        `_add_column_` <- function(lhs, rhs) dplyr::bind_cols(lhs, rhs)
+        IRIS <- `_add_column_`(iris, dplyr::tibble(new_col = "new column"))
+      })
+
+    testthat::expect_identical(
+      get_code(td, datanames = "IRIS"),
+      paste(
+        sep = "\n",
+        "`_add_column_` <- function(lhs, rhs) dplyr::bind_cols(lhs, rhs)",
+        "IRIS <- `_add_column_`(iris, dplyr::tibble(new_col = \"new column\"))"
+      )
+    )
+  })
+
+  testthat::it("with spaces code dependency is being detected", {
+    td <- teal_data() |>
+      within({
+        `add column` <- function(lhs, rhs) dplyr::bind_cols(lhs, rhs)
+        IRIS <- `add column`(iris, dplyr::tibble(new_col = "new column"))
+      })
+
+    testthat::expect_identical(
+      get_code(td, datanames = "IRIS"),
+      paste(
+        sep = "\n",
+        "`add column` <- function(lhs, rhs) dplyr::bind_cols(lhs, rhs)",
+        "IRIS <- `add column`(iris, dplyr::tibble(new_col = \"new column\"))"
+      )
+    )
+  })
+
+  testthat::it("with non-native pipe code dependency is being detected", {
+    td <- teal_data() |>
+      within({
+        `%add_column%` <- function(lhs, rhs) dplyr::bind_cols(lhs, rhs)
+        IRIS <- `%add_column%`(iris, dplyr::tibble(new_col = "new column"))
+      })
+
+    # Note that the original code is changed to use the non-native pipe operator
+    # correctly.
+    testthat::expect_identical(
+      get_code(td, datanames = "IRIS"),
+      paste(
+        sep = "\n",
+        "`%add_column%` <- function(lhs, rhs) dplyr::bind_cols(lhs, rhs)",
+        "IRIS <- iris %add_column% dplyr::tibble(new_col = \"new column\")"
+      )
+    )
+  })
+})