use_air() (#2121)

Author: hadley

.Rbuildignore

@@ -20,3 +20,5 @@
 ^\.github/workflows/R\.yaml$
 ^\.github/workflows/pr-commands\.yaml$
 ^CRAN-SUBMISSION$
+^[\.]?air\.toml$
+^\.vscode$

.vscode/extensions.json

@@ -0,0 +1,5 @@
+{
+    "recommendations": [
+        "Posit.air-vscode"
+    ]
+}

.vscode/settings.json

@@ -0,0 +1,6 @@
+{
+    "[r]": {
+        "editor.formatOnSave": true,
+        "editor.defaultFormatter": "Posit.air-vscode"
+    }
+}

R/auto-test.R

@@ -28,9 +28,13 @@
 #' @param hash Passed on to [watch()]. When FALSE, uses less accurate
 #'   modification time stamps, but those are faster for large files.
 #' @keywords debugging
-auto_test <- function(code_path, test_path, reporter = default_reporter(),
-                      env = test_env(),
-                      hash = TRUE) {
+auto_test <- function(
+  code_path,
+  test_path,
+  reporter = default_reporter(),
+  env = test_env(),
+  hash = TRUE
+) {
   reporter <- find_reporter(reporter)
   code_path <- normalizePath(code_path)
   test_path <- normalizePath(test_path)
@@ -72,7 +76,11 @@ auto_test <- function(code_path, test_path, reporter = default_reporter(),
 #'   modification time stamps, but those are faster for large files.
 #' @keywords debugging
 #' @seealso [auto_test()] for details on how method works
-auto_test_package <- function(pkg = ".", reporter = default_reporter(), hash = TRUE) {
+auto_test_package <- function(
+  pkg = ".",
+  reporter = default_reporter(),
+  hash = TRUE
+) {
   reporter <- find_reporter(reporter)
 
   path <- pkgload::pkg_path(pkg)
@@ -86,7 +94,12 @@ auto_test_package <- function(pkg = ".", reporter = default_reporter(), hash = T
   # Start by loading all code and running all tests
   withr::local_envvar("NOT_CRAN" = "true")
   pkgload::load_all(path)
-  test_dir(test_path, package = package, reporter = reporter$clone(deep = TRUE), stop_on_failure = FALSE)
+  test_dir(
+    test_path,
+    package = package,
+    reporter = reporter$clone(deep = TRUE),
+    stop_on_failure = FALSE
+  )
 
   # Next set up watcher to monitor changes
   watcher <- function(added, deleted, modified) {
@@ -106,7 +119,11 @@ auto_test_package <- function(pkg = ".", reporter = default_reporter(), hash = T
       cat("Changed code: ", paste0(basename(code), collapse = ", "), "\n")
       cat("Rerunning all tests\n")
       pkgload::load_all(path, quiet = TRUE)
-      test_dir(test_path, package = package, reporter = reporter$clone(deep = TRUE))
+      test_dir(
+        test_path,
+        package = package,
+        reporter = reporter$clone(deep = TRUE)
+      )
     } else if (length(tests) > 0) {
       # If test changes, rerun just that test
       cat("Rerunning tests: ", paste0(basename(tests), collapse = ", "), "\n")
@@ -115,7 +132,7 @@ auto_test_package <- function(pkg = ".", reporter = default_reporter(), hash = T
         test_dir = test_path,
         test_package = package,
         test_paths = tests,
-        env = env, 
+        env = env,
         reporter = reporter$clone(deep = TRUE)
       )
     }

R/colour-text.R

@@ -1,4 +1,7 @@
-colourise <- function(text, as = c("success", "skip", "warning", "failure", "error")) {
+colourise <- function(
+  text,
+  as = c("success", "skip", "warning", "failure", "error")
+) {
   if (has_colour()) {
     unclass(cli::make_ansi_style(testthat_style(as))(text))
   } else {
@@ -11,7 +14,9 @@ has_colour <- function() {
     cli::num_ansi_colors() > 1
 }
 
-testthat_style <- function(type = c("success", "skip", "warning", "failure", "error")) {
+testthat_style <- function(
+  type = c("success", "skip", "warning", "failure", "error")
+) {
   type <- match.arg(type)
 
   c(

R/compare.R

@@ -64,10 +64,14 @@ print_out <- function(x, ...) {
 # Common helpers ---------------------------------------------------------------
 
 same_length <- function(x, y) length(x) == length(y)
-diff_length <- function(x, y) difference(fmt = "Lengths differ: %i is not %i", length(x), length(y))
+diff_length <- function(x, y) {
+  difference(fmt = "Lengths differ: %i is not %i", length(x), length(y))
+}
 
 same_type <- function(x, y) identical(typeof(x), typeof(y))
-diff_type <- function(x, y) difference(fmt = "Types not compatible: %s is not %s", typeof(x), typeof(y))
+diff_type <- function(x, y) {
+  difference(fmt = "Types not compatible: %s is not %s", typeof(x), typeof(y))
+}
 
 same_class <- function(x, y) {
   if (!is.object(x) && !is.object(y)) {
@@ -76,7 +80,11 @@ same_class <- function(x, y) {
   identical(class(x), class(y))
 }
 diff_class <- function(x, y) {
-  difference(fmt = "Classes differ: %s is not %s", format_class(class(x)), format_class(class(y)))
+  difference(
+    fmt = "Classes differ: %s is not %s",
+    format_class(class(x)),
+    format_class(class(y))
+  )
 }
 
 same_attr <- function(x, y) {
@@ -91,10 +99,9 @@ vector_equal <- function(x, y) {
   (is.na(x) & is.na(y)) | (!is.na(x) & !is.na(y) & x == y)
 }
 
-vector_equal_tol <- function(x, y, tolerance = .Machine$double.eps ^ 0.5) {
+vector_equal_tol <- function(x, y, tolerance = .Machine$double.eps^0.5) {
   (is.na(x) & is.na(y)) |
     (!is.na(x) & !is.na(y)) & (x == y | abs(x - y) < tolerance)
-
 }
 
 
@@ -125,9 +132,15 @@ vector_equal_tol <- function(x, y, tolerance = .Machine$double.eps ^ 0.5) {
 #' compare(x, y)
 #' compare(c(x, x), c(y, y))
 #'
-compare.character <- function(x, y, check.attributes = TRUE, ...,
-                              max_diffs = 5, max_lines = 5,
-                              width = cli::console_width()) {
+compare.character <- function(
+  x,
+  y,
+  check.attributes = TRUE,
+  ...,
+  max_diffs = 5,
+  max_lines = 5,
+  width = cli::console_width()
+) {
   if (identical(x, y)) {
     return(no_difference())
   }
@@ -174,10 +187,13 @@ mismatch_character <- function(x, y, diff = !vector_equal(x, y)) {
 }
 
 #' @export
-format.mismatch_character <- function(x, ...,
-                                      max_diffs = 5,
-                                      max_lines = 5,
-                                      width = cli::console_width()) {
+format.mismatch_character <- function(
+  x,
+  ...,
+  max_diffs = 5,
+  max_lines = 5,
+  width = cli::console_width()
+) {
   width <- width - 6 # allocate space for labels
   n_show <- seq_len(min(x$n_diff, max_diffs))
 
@@ -186,11 +202,16 @@ format.mismatch_character <- function(x, ...,
   show_y <- str_trunc(encode(x$y[n_show]), width * max_lines)
   show_i <- x$i[n_show]
 
-  sidebyside <- Map(function(x, y, pos) {
-    x <- paste0("x[", pos, "]: ", str_chunk(x, width))
-    y <- paste0("y[", pos, "]: ", str_chunk(y, width))
-    paste(c(x, y), collapse = "\n")
-  }, show_x, show_y, show_i)
+  sidebyside <- Map(
+    function(x, y, pos) {
+      x <- paste0("x[", pos, "]: ", str_chunk(x, width))
+      y <- paste0("y[", pos, "]: ", str_chunk(y, width))
+      paste(c(x, y), collapse = "\n")
+    },
+    show_x,
+    show_y,
+    show_i
+  )
 
   summary <- paste0(x$n_diff, "/", x$n, " mismatches")
   paste0(summary, "\n", paste0(sidebyside, collapse = "\n\n"))
@@ -238,13 +259,20 @@ str_chunk <- function(x, length) {
 #' # Compare ignores minor numeric differences in the same way
 #' # as all.equal.
 #' compare(x, x + 1e-9)
-compare.numeric <- function(x, y,
-                            tolerance = testthat_tolerance(),
-                            check.attributes = TRUE,
-                            ..., max_diffs = 9) {
+compare.numeric <- function(
+  x,
+  y,
+  tolerance = testthat_tolerance(),
+  check.attributes = TRUE,
+  ...,
+  max_diffs = 9
+) {
   all_equal <- all.equal(
-    x, y, tolerance = tolerance,
-    check.attributes = check.attributes, ...
+    x,
+    y,
+    tolerance = tolerance,
+    check.attributes = check.attributes,
+    ...
   )
   if (isTRUE(all_equal)) {
     return(no_difference())
@@ -284,7 +312,7 @@ testthat_tolerance <- function() {
     skip("Long doubles not available and `tolerance` not supplied")
   }
 
-  .Machine$double.eps ^ 0.5
+  .Machine$double.eps^0.5
 }
 
 mismatch_numeric <- function(x, y, diff = !vector_equal(x, y)) {
@@ -312,7 +340,8 @@ format.mismatch_numeric <- function(x, ..., max_diffs = 9, digits = 3) {
   n_show <- seq_len(min(x$n_diff, max_diffs))
 
   diffs <- paste0(
-    format(paste0("[", x$i[n_show], "]")), " ",
+    format(paste0("[", x$i[n_show], "]")),
+    " ",
     format(x$x[n_show], digits = digits),
     " - ",
     format(x$y[n_show], digits = digits),
@@ -362,10 +391,11 @@ compare.POSIXt <- function(x, y, tolerance = 0.001, ..., max_diffs = 9) {
 }
 
 standardise_tzone <- function(x) {
-  if (is.null(attr(x, "tzone")) || identical(attr(x, "tzone"), Sys.timezone())) {
+  if (
+    is.null(attr(x, "tzone")) || identical(attr(x, "tzone"), Sys.timezone())
+  ) {
     attr(x, "tzone") <- ""
   }
 
   x
 }
-

R/deprec-condition.R

@@ -1,13 +1,15 @@
-
 new_capture <- function(class) {
   exiting_handlers <- rep_named(class, list(identity))
 
-  calling_handlers <- rep_named(class, alist(function(cnd) {
-    if (can_entrace(cnd)) {
-      cnd <- cnd_entrace(cnd)
-    }
-    return_from(env, cnd)
-  }))
+  calling_handlers <- rep_named(
+    class,
+    alist(function(cnd) {
+      if (can_entrace(cnd)) {
+        cnd <- cnd_entrace(cnd)
+      }
+      return_from(env, cnd)
+    })
+  )
 
   formals <- pairlist2(code = , entrace = FALSE)
 
@@ -16,11 +18,23 @@ new_capture <- function(class) {
 
   body <- expr({
     if (!entrace) {
-      return(tryCatch({ code; NULL }, !!!exiting_handlers))
+      return(tryCatch(
+        {
+          code
+          NULL
+        },
+        !!!exiting_handlers
+      ))
     }
 
     env <- environment()
-    withCallingHandlers({ code; NULL }, !!!calling_handlers)
+    withCallingHandlers(
+      {
+        code
+        NULL
+      },
+      !!!calling_handlers
+    )
   })
 
   new_function(formals, body, ns_env("testthat"))

R/edition.R

@@ -34,7 +34,9 @@ edition_deprecate <- function(in_edition, what, instead = NULL) {
 }
 
 edition_require <- function(in_edition, what) {
-  if (edition_get() >= in_edition || isTRUE(getOption("testthat.edition_ignore"))) {
+  if (
+    edition_get() >= in_edition || isTRUE(getOption("testthat.edition_ignore"))
+  ) {
     return()
   }
 

R/example.R

@@ -17,7 +17,8 @@ testthat_examples <- function() {
 #' @rdname testthat_examples
 testthat_example <- function(filename) {
   system.file(
-    "examples", paste0("test-", filename, ".R"),
+    "examples",
+    paste0("test-", filename, ".R"),
     package = "testthat",
     mustWork = TRUE
   )

R/expect-comparison.R

@@ -24,9 +24,9 @@ expect_compare <- function(operator = c("<", "<=", ">", ">="), act, exp) {
   op <- match.fun(operator)
 
   msg <- c(
-    "<" =  "not strictly less than",
+    "<" = "not strictly less than",
     "<=" = "not less than",
-    ">"  = "not strictly more than",
+    ">" = "not strictly more than",
     ">=" = "not more than"
   )[[operator]]
 
@@ -36,7 +36,13 @@ expect_compare <- function(operator = c("<", "<=", ">", ">="), act, exp) {
   }
   expect(
     if (!is.na(cmp)) cmp else FALSE,
-    sprintf("%s is %s %s. Difference: %.3g", act$lab, msg, exp$lab, act$val - exp$val),
+    sprintf(
+      "%s is %s %s. Difference: %.3g",
+      act$lab,
+      msg,
+      exp$lab,
+      act$val - exp$val
+    ),
     trace_env = caller_env()
   )
   invisible(act$val)