262 Fix improper code dependency

R/utils-get_code_dependency.R

@@ -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)
@@ -311,6 +312,31 @@ extract_occurrence <- function(pd) {
   }
 }
 
+#' Moves function names to the right side of dependency graph
+#'
+#' Move function names after the dependencya oprator (arrow) to the right side of the dependency graph.
+#' Convenience utility needed to correctly detect dependencies between objects.
+#' For cases when a function call is on the left side of the assignment operator,
+#' it is moved to the right side of the arrow.
+#' For example, for `attributes(a) <- b` the dependey 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.

tests/testthat/test-qenv_get_code.R

@@ -290,6 +290,17 @@
       )
     }
   )
+  testthat::it("prevents cyclic dependencies when function (c) is on left side of assignment and right side of the oprations", {
+    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"))
+  })
 })