Fix infinite loop

Author: gogonzo

NEWS.md

@@ -1,5 +1,9 @@
 # teal.code 0.6.0.9001
 
+### Bug fixes
+
+* Fix an infinite recursion happening when lhs contains two or more symbols occurring in the rhs of the same call. 
+
 # teal.code 0.6.0
 
 ### Enhancements

R/utils-get_code_dependency.R

@@ -364,6 +364,7 @@ extract_dependency <- function(parsed_code) {
 #' @keywords internal
 #' @noRd
 graph_parser <- function(x, graph) {
+  # x occurrences (lhs)
   occurrence <- vapply(
     graph, function(call) {
       ind <- match("<-", call, nomatch = length(call) + 1L)
@@ -372,20 +373,21 @@ graph_parser <- function(x, graph) {
     logical(1)
   )
 
+  # x-dependent objects (rhs)
   dependencies <- lapply(graph[occurrence], function(call) {
     ind <- match("<-", call, nomatch = 0L)
     call[(ind + 1L):length(call)]
   })
   dependencies <- setdiff(unlist(dependencies), x)
 
-  if (length(dependencies) && any(occurrence)) {
-    dependency_ids <- lapply(dependencies, function(dependency) {
-      graph_parser(dependency, graph[1:max(which(occurrence))])
-    })
-    sort(unique(c(which(occurrence), unlist(dependency_ids))))
-  } else {
-    which(occurrence)
-  }
+  dependency_occurrences <- lapply(dependencies, function(dependency) {
+    # track down dependencies and where they occur on the lhs in previous calls
+    last_x_occurrence <- max(which(occurrence))
+    reduced_graph <- head(graph[seq_len(last_x_occurrence)], -1)
+    c(graph_parser(dependency, reduced_graph), last_x_occurrence)
+  })
+
+  sort(unique(c(which(occurrence), unlist(dependency_occurrences))))
 }
 
 

tests/testthat/test-qenv_get_code.R

@@ -951,3 +951,10 @@ testthat::test_that("original formatting and comments are preserved when express
   expr <- parse(text = code, keep.source = TRUE)
   testthat::expect_identical(get_code(eval_code(qenv(), expr)), code)
 })
+
+testthat::test_that("extracting code doesn't fail when lhs contains two or more symbols occurring in lhs", {
+  code <- "l <- list(a = 1, b = 2)
+    class(l) <- c('new class', class(l))" # l depends on class and class depends on l
+  q <- eval_code(qenv(), code)
+  testthat::expect_silent(get_code(q, names = "l"))
+})