assign side_effects and occurrence as attributes of code

Author: m7pr

R/qenv-eval_code.R

@@ -79,6 +79,20 @@ setMethod("eval_code", signature = c("qenv", "character"), function(object, code
     }
 
     attr(current_code, "id") <- sample.int(.Machine$integer.max, size = 1)
+
+    # UNSURE if the removal of curly brackets is still needed.
+    tcode <- trimws(current_code)
+    if (any(grepl("^\\{.*\\}$", tcode))) {
+      tcode <- sub("^\\{(.*)\\}$", "\\1", tcode)
+    }
+
+    parsed_code <- parse(text = tcode, keep.source = TRUE)
+    pd <- utils::getParseData(parsed_code)
+    pd <- normalize_pd(pd)
+    calls_pd <- extract_calls(pd)
+
+    attr(current_code, "side_effects") <- extract_side_effects(calls_pd)[[1]]
+    attr(current_code, "occurrence") <- extract_occurrence(calls_pd)[[1]]
     object@code <- c(object@code, list(current_code))
   }
 

R/utils-get_code_dependency.R

@@ -44,7 +44,7 @@ get_code_dependency <- function(code, names, check_names = TRUE) {
 
   pd <- utils::getParseData(parsed_code)
   pd <- normalize_pd(pd)
-  calls_pd <- extract_calls(pd)
+  calls_pd <- extract_calls(pd) # STILL NEEDED for check_names
 
   if (check_names) {
     # Detect if names are actually in code.
@@ -60,10 +60,10 @@ get_code_dependency <- function(code, names, check_names = TRUE) {
     }
   }
 
-  graph <- code_graph(calls_pd)
+  graph <- extract_code_graph(code)
   ind <- unlist(lapply(names, function(x) graph_parser(x, graph)))
 
-  lib_ind <- detect_libraries(calls_pd)
+  lib_ind <- detect_libraries(calls_pd) # SHOULD BE REWRITTEN TO WORK ON code
 
   code_ids <- sort(unique(c(lib_ind, ind)))
   code[code_ids]
@@ -208,10 +208,10 @@ sub_arrows <- function(call) {
 #'
 #' @keywords internal
 #' @noRd
-code_graph <- function(calls_pd) {
-  cooccurrence <- extract_occurrence(calls_pd)
+extract_code_graph <- function(code) {
+  cooccurrence <- lapply(code, attr, "occurrence")
 
-  side_effects <- extract_side_effects(calls_pd)
+  side_effects <- lapply(code, attr, "side_effects")
 
   mapply(c, side_effects, cooccurrence, SIMPLIFY = FALSE)
 }

tests/testthat/test-qenv_get_code.R

@@ -688,7 +688,7 @@ testthat::test_that("detects cooccurrence properly even if all objects are on lh
 # @ ---------------------------------------------------------------------------------------------------------------
 
 testthat::test_that("understands @ usage and do not treat rhs of @ as objects (only lhs)", {
-  code <- list(
+  code <- c(
     "setClass('aclass', slots = c(a = 'numeric', x = 'numeric', y = 'numeric')) # @linksto a x",
     "x <- new('aclass', a = 1:3, x = 1:3, y = 1:3)",
     "a <- new('aclass', a = 1:3, x = 1:3, y = 1:3)",
@@ -697,14 +697,14 @@ testthat::test_that("understands @ usage and do not treat rhs of @ as objects (o
     "a@x <- x@a"
   )
   q <- qenv()
-  q@code <- code # we don't use eval_code so the code is not run
+  q <- eval_code(q, code)
   testthat::expect_identical(
     get_code_g(q, names = "x"),
-    unlist(code[1:2])
+    code[1:2]
   )
   testthat::expect_identical(
     get_code_g(q, names = "a"),
-    unlist(code)
+    code
   )
 })