Cleanup run...

R/callbacks.R

@@ -162,7 +162,8 @@ add_call_callback <- function(callbacks, fn, cb) {
         call_name <- as.character(expr[[1]])
         if (call_name %in% names(params)) {
             return(next_cb(
-                expr, env = env, params = params, wflags = wflags, ...
+                expr,
+                env = env, params = params, wflags = wflags, ...
             ))
         }
         # The same goes for other bound variables, if we have annotated
@@ -178,18 +179,20 @@ add_call_callback <- function(callbacks, fn, cb) {
                 ))
             }
             return(next_cb(
-                expr, env = env, params = params, wflags = wflags, ...
+                expr,
+                env = env, params = params, wflags = wflags, ...
             ))
         }
 
         # now try to get the actual function by evaluating it
         err_fun <- function(e) {
-            if (wflags$warn_on_unknown_function)
-                warning(paste0(
-                    "The function ", call_name,
-                    " could not be evaluated to an actual function in ",
-                    "this scope."
-                ))
+            if (wflags$warn_on_unknown_function) {
+                  warning(paste0(
+                      "The function ", call_name,
+                      " could not be evaluated to an actual function in ",
+                      "this scope."
+                  ))
+              }
             NULL
         }
         fun <- tryCatch(eval(expr[[1]], env), error = err_fun)
@@ -202,7 +205,8 @@ add_call_callback <- function(callbacks, fn, cb) {
         } else {
             # default for closure: try the next in line
             next_cb(
-                expr, env = env, params = params, wflags = wflags, ...
+                expr,
+                env = env, params = params, wflags = wflags, ...
             )
         }
     }
@@ -245,7 +249,8 @@ add_topdown_callback <- function(callbacks, fn, cb) {
         call_name <- as.character(expr[[1]])
         if (call_name %in% names(params)) {
             return(next_cb(
-                expr, env = env, params = params, wflags = wflags, ...
+                expr,
+                env = env, params = params, wflags = wflags, ...
             ))
         }
         # The same goes for other bound variables, if we have annotated
@@ -261,30 +266,34 @@ add_topdown_callback <- function(callbacks, fn, cb) {
                 ))
             }
             return(next_cb(
-                expr, env = env, params = params,  wflags = wflags, ...
+                expr,
+                env = env, params = params, wflags = wflags, ...
             ))
         }
 
         # now try to get the actual function by evaluating it
         err_fun <- function(e) {
-            if (wflags$warn_on_unknown_function)
-                warning(paste0(
-                    "The function ", call_name,
-                    " could not be evaluated to an actual function in ",
-                    "this scope."
-                ))
+            if (wflags$warn_on_unknown_function) {
+                  warning(paste0(
+                      "The function ", call_name,
+                      " could not be evaluated to an actual function in ",
+                      "this scope."
+                  ))
+              }
             NULL
         }
         fun <- tryCatch(eval(expr[[1]], env), error = err_fun)
         if (!is.null(fun) && identical(fun, fn)) {
             return(cb(
-                expr, env = env, params = params,
+                expr,
+                env = env, params = params,
                 next_cb = next_cb, wflags = wflags, ...
             ))
         } else {
             # default for closure: try the next in line
             next_cb(
-                expr, env = env, params = params,
+                expr,
+                env = env, params = params,
                 wflags = wflags, ...
             )
         }

R/depth-first-traversals.R

@@ -20,22 +20,26 @@ depth_first_rewrite_expr <- function(expr, callbacks, topdown, wflags,
                                      ...) {
     if (rlang::is_atomic(expr)) {
         return(callbacks$atomic(
-            expr, topdown = topdown, wflags = wflags, ...
+            expr,
+            topdown = topdown, wflags = wflags, ...
         ))
     }
     if (rlang::is_pairlist(expr)) {
         return(callbacks$pairlist(
-            expr, topdown = topdown, wflags = wflags, ...
+            expr,
+            topdown = topdown, wflags = wflags, ...
         ))
     }
     if (rlang::is_symbol(expr)) {
         return(callbacks$symbol(
-            expr, topdown = topdown, wflags = wflags, ...
+            expr,
+            topdown = topdown, wflags = wflags, ...
         ))
     }
     if (rlang::is_primitive(expr)) {
         return(callbacks$primitive(
-            expr, topdown = topdown, wflags = wflags, ...
+            expr,
+            topdown = topdown, wflags = wflags, ...
         ))
     }
 
@@ -45,7 +49,8 @@ depth_first_rewrite_expr <- function(expr, callbacks, topdown, wflags,
         skip <- function() escape(expr) # skip means leaving the body unchanged
         # collect topdown info.
         topdown <- callbacks$topdown(
-            expr, topdown = topdown, wflags = wflags, skip = skip, ...
+            expr,
+            topdown = topdown, wflags = wflags, skip = skip, ...
         )
 
         # handle depth first
@@ -60,7 +65,8 @@ depth_first_rewrite_expr <- function(expr, callbacks, topdown, wflags,
 
         # then handle the actual call
         callbacks$call(
-            expr, topdown = topdown, wflags = wflags, ...
+            expr,
+            topdown = topdown, wflags = wflags, ...
         )
     })
 }

R/helpers.R

@@ -57,4 +57,3 @@ collect_from_args <- function(expr, attribute,
     }
     collected
 }
-

R/static-analysis.R

@@ -150,8 +150,8 @@ propagate_assigned_symbols_callback <- function(expr, ...) {
 collect_bound_variables_callback <- function(expr, topdown, ...) {
     bound <- c(topdown, attr(expr, "assigned_symbols"))
     if (expr[[1]] == "function") {
-          bound <- c(names(expr[[2]]), bound)
-      }
+        bound <- c(names(expr[[2]]), bound)
+    }
     bound # passed as `topdown` to the rewrite callback
 }
 

tests/testthat/test-condition-handling.R

@@ -1,22 +1,21 @@
 context("Error and warning handling")
 
 test_that("we can set and unset warning flags", {
-  wflags <- warning_flags()
-  expect_true(wflags$warn_on_unknown_function)
-  expect_true(wflags$warn_on_local_function)
+    wflags <- warning_flags()
+    expect_true(wflags$warn_on_unknown_function)
+    expect_true(wflags$warn_on_local_function)
 
-  wflags <- warning_flags() %>% unset_warn_on_unknown_function()
-  expect_false(wflags$warn_on_unknown_function)
-  expect_true(wflags$warn_on_local_function)
-  wflags <- wflags %>% set_warn_on_unknown_function()
-  expect_true(wflags$warn_on_unknown_function)
-  expect_true(wflags$warn_on_local_function)
-
-  wflags <- warning_flags() %>% unset_warn_on_local_function()
-  expect_true(wflags$warn_on_unknown_function)
-  expect_false(wflags$warn_on_local_function)
-  wflags <- wflags %>% set_warn_on_local_function()
-  expect_true(wflags$warn_on_unknown_function)
-  expect_true(wflags$warn_on_local_function)
+    wflags <- warning_flags() %>% unset_warn_on_unknown_function()
+    expect_false(wflags$warn_on_unknown_function)
+    expect_true(wflags$warn_on_local_function)
+    wflags <- wflags %>% set_warn_on_unknown_function()
+    expect_true(wflags$warn_on_unknown_function)
+    expect_true(wflags$warn_on_local_function)
 
+    wflags <- warning_flags() %>% unset_warn_on_local_function()
+    expect_true(wflags$warn_on_unknown_function)
+    expect_false(wflags$warn_on_local_function)
+    wflags <- wflags %>% set_warn_on_local_function()
+    expect_true(wflags$warn_on_unknown_function)
+    expect_true(wflags$warn_on_local_function)
 })

tests/testthat/test-static-analysis.R

@@ -157,15 +157,15 @@ test_that("we can annotate with the symbols in a simple function", {
 
 test_that("we hande `=` assignments as well", {
     f <- function() {
-        x = 42
+        x <- 42
     }
     res <- annotate_bound_symbols_in_function(f)
     expect_equal(attr(body(res), "assigned_symbols"), "x")
     expect_equal(attr(body(res), "bound"), "x")
 
     f <- function() {
-        x = 42
-        y = 24
+        x <- 42
+        y <- 24
         x + y
     }
     res <- annotate_bound_symbols_in_function(f)
@@ -175,7 +175,7 @@ test_that("we hande `=` assignments as well", {
     # when there is a formal parameter, that is also a bound variable
     # although it is not an assigned symbol.
     f <- function(x = 42) {
-        y = 24
+        y <- 24
         x + y
     }
     res <- annotate_bound_symbols_in_function(f)
@@ -187,8 +187,8 @@ test_that("we hande `=` assignments as well", {
     # of this function, we do assign to `x`, so we include it in
     # the annotation. It defintely belongs in the bound variables.
     f <- function(x = 42) {
-        x = 42
-        y = 24
+        x <- 42
+        y <- 24
         x + y
     }
     res <- annotate_bound_symbols_in_function(f)
@@ -197,9 +197,9 @@ test_that("we hande `=` assignments as well", {
 
     # we shouldn't include duplications
     f <- function(x = 42) {
-        y = x
-        x = 42
-        y = x + 2
+        y <- x
+        x <- 42
+        y <- x + 2
         x + y
     }
     res <- annotate_bound_symbols_in_function(f)
@@ -335,7 +335,9 @@ test_that("we can handle local functions", {
     g <- function() stop("outer")
     cb <- rewrite_callbacks() %>%
         add_call_callback(g, function(expr, ...) stop("don't call this"))
-    expect_warning(res <- depth_first_rewrite_function(f_an, cb),
-                   "The function g is not processed .*")
+    expect_warning(
+        res <- depth_first_rewrite_function(f_an, cb),
+        "The function g is not processed .*"
+    )
     expect_equal(body(f_an), body(res))
 })