Fix style_file() so it works for a vector of files from different directories

DESCRIPTION

@@ -71,6 +71,7 @@ Collate:
     'set-assert-args.R'
     'style-guides.R'
     'styler.R'
+    'testing-public-api.R'
     'testing.R'
     'token-create.R'
     'transform-code.R'

NAMESPACE

@@ -38,5 +38,6 @@ importFrom(rlang,is_installed)
 importFrom(rlang,seq2)
 importFrom(rlang,warn)
 importFrom(rlang,with_handlers)
+importFrom(utils,capture.output)
 importFrom(utils,tail)
 importFrom(utils,write.table)

R/testing-public-api.R

@@ -0,0 +1,38 @@
+#' Capture and post-process the output of `style_file` without causing side
+#' effects
+#'
+#' @param file_in A vector passed to [testthat_file()] to construct the path
+#'   to the reference file.
+#' @return
+#' A character vector with the captured output of [style_file()] called on
+#' `file_in` ran in a temp dir to avoid side effects on the input file (because
+#' the next time the test would ran, the file would not need styling). The
+#' styling is carried out with a temporary working directory change to keep
+#' filenames relative and avoid portability issues in the exact output
+#' comparison which is needed when the system that runs the unit testing (CI)
+#' is a different system than the one that created the reference value.
+#' This also implies that the ruler width, which depend on the path
+#' length, will again have the same width on all systems and is independent of
+#' how many characters the path of the temporary directory has.
+#' @importFrom utils capture.output
+#' @keywords internal
+catch_style_file_output <- function(file_in = c(
+                                      "public-api",
+                                      "xyzdir-dirty",
+                                      "dirty-sample-with-scope-tokens.R"
+                                    ),
+                                    encoding) {
+  file_in <- do.call(testthat_file, as.list(file_in))
+  temp_path <- copy_to_tempdir(file_in)
+  raw_output <- withr::with_dir(
+    dirname(temp_path),
+    capture.output(
+    style_file(basename(temp_path), scope = "tokens")
+  ))
+  unlink(dirname(temp_path))
+  raw_output
+}
+
+ls_testable_encodings <- function() {
+  c("non-utf8", if (cli::is_utf8_output()) "utf8")
+}

R/testing.R

@@ -196,6 +196,18 @@ testthat_file <- function(...) {
   file.path(rprojroot::find_testthat_root_file(), ...)
 }
 
+#' Convert a serialized R object to a certaion verion.
+#'
+#' Needed to make [testthat::expect_known_value()] work on R < 3.6.
+#' @param path A path to an rds file.
+#' @param version The target version.
+#' @keywords internal
+rds_to_version <- function(path, version = 2) {
+  readRDS(path) %>%
+    saveRDS(path, version = version)
+}
+
+
 
 #' Copy a file to a temporary directory
 #'

R/transform-files.R

@@ -11,7 +11,7 @@
 #' @keywords internal
 transform_files <- function(files, transformers, include_roxygen_examples) {
   transformer <- make_transformer(transformers, include_roxygen_examples)
-  max_char <- min(max(nchar(files), 0), 80)
+  max_char <- min(max(nchar(files), 0), getOption("width"))
   if (length(files) > 0L) {
     cat("Styling ", length(files), " files:\n")
   }

R/ui.R

@@ -227,9 +227,6 @@ style_file <- function(path,
                        style = tidyverse_style,
                        transformers = style(...),
                        include_roxygen_examples = TRUE) {
-  changed <- withr::with_dir(
-    dirname(path),
-    transform_files(basename(path), transformers, include_roxygen_examples)
-  )
+  changed <- transform_files(path, transformers, include_roxygen_examples)
   invisible(changed)
 }

tests/testthat/public-api/xyzfile/subfolder/random-script.R

@@ -0,0 +1,7 @@
+# random
+this(is_a_call(x))
+if (x) {
+  r()
+  a    <- 3
+  bcds <- 5
+}

tests/testthat/test-helpers.R

@@ -2,7 +2,9 @@ context("various helpers")
 
 test_that("can construct and print vertical", {
   expect_error(construct_vertical(c("1 + 1", "nw")), NA)
-  expect_error(construct_vertical(c("1 + 1", "nw")) %>% print(), NA)
+  capture.output(
+    expect_error(construct_vertical(c("1 + 1", "nw")) %>% print(), NA)
+  )
 })
 
 

tests/testthat/test-public_api.R

@@ -17,18 +17,27 @@ test_that("styler can style directory", {
 })
 
 test_that("styler can style files", {
-  capture_output(expect_false({
-    out <- style_file(testthat_file("public-api", "xyzfile", "random-script.R"), strict = FALSE)
-    out$changed
-  }))
-
-  capture_output(expect_false(any({
-    out <- style_file(
-      rep(testthat_file("public-api", "xyzfile", "random-script.R"), 2),
-      strict = FALSE
-    )
-    out$changed
-  })))
+  # just one
+  capture_output(expect_equivalent(
+    {
+      out <- style_file(c(
+        testthat_file("public-api", "xyzfile", "random-script.R")
+      ), strict = FALSE)
+      out$changed
+    },
+    rep(FALSE, 1)
+  ))
+  # multiple not in the same working directory
+  capture_output(expect_equivalent(
+    {
+      out <- style_file(c(
+        testthat_file("public-api", "xyzfile", "random-script.R"),
+        testthat_file("public-api", "xyzfile", "subfolder", "random-script.R")
+      ), strict = FALSE)
+      out$changed
+    },
+    rep(FALSE, 2)
+  ))
 })
 
 
@@ -69,56 +78,47 @@ test_that("styler handles malformed Rmd file and invalid R code in chunk", {
 context("messages are correct")
 
 test_that("messages (via cat()) of style_file are correct", {
-  if (cli::is_utf8_output()) {
-    # if utf8 is available test under this and test  if it is not available
-    encodings <- list(TRUE)
-  } else {
-    # if utf8 is not available, only test under that
-    encodings <- list()
-  }
-  for (encoding in c(encodings, FALSE)) {
+
+  for (encoding in ls_testable_encodings()) {
     withr::with_options(
-      list(cli.unicode = encoding), {
+      list(cli.unicode = encoding == "utf8"), {
         # Message if scope > line_breaks and code changes
-        temp_path <- copy_to_tempdir(testthat_file(
-          "public-api", "xyzdir-dirty", "dirty-sample-with-scope-tokens.R"
-        ))
-        expect_equal_to_reference(
-          capture.output(
-            style_file(temp_path, scope = "tokens")
-          ),
+        output <- catch_style_file_output(c(
+          "public-api",
+            "xyzdir-dirty",
+            "dirty-sample-with-scope-tokens.R"
+          ), encoding = encoding)
+        expect_known_value(
+          output,
           testthat_file(paste0(
             "public-api/xyzdir-dirty/dirty-reference-with-scope-tokens-",
-            ifelse(cli::is_utf8_output(), "utf8", "non-utf8")
+            encoding
           ))
         )
-        unlink(dirname(temp_path))
 
         # No message if scope > line_breaks and code does not change
-        temp_path <- copy_to_tempdir(testthat_file(
+        output <- catch_style_file_output(c(
           "public-api", "xyzdir-dirty", "clean-sample-with-scope-tokens.R"
-        ))
-        expect_equal_to_reference(
-          capture.output(style_file(temp_path, scope = "tokens")),
+        ), encoding = encoding)
+        expect_known_value(
+          output,
           testthat_file(paste0(
             "public-api/xyzdir-dirty/clean-reference-with-scope-tokens-",
-            ifelse(cli::is_utf8_output(), "utf8", "non-utf8")
+            encoding
           ))
         )
-        unlink(dirname(temp_path))
 
         # No message if scope <= line_breaks even if code is changed.
-        temp_path <- copy_to_tempdir(testthat_file(
+        output <- catch_style_file_output(c(
           "public-api", "xyzdir-dirty", "dirty-sample-with-scope-spaces.R"
-        ))
-        expect_equal_to_reference(
-          capture.output(style_file(temp_path, scope = "spaces")),
+        ), encoding = encoding)
+        expect_known_value(
+          output,
           testthat_file(paste0(
             "public-api/xyzdir-dirty/dirty-reference-with-scope-spaces-",
-            ifelse(cli::is_utf8_output(), "utf8", "non-utf8")
+            encoding
           ))
         )
-        unlink(dirname(temp_path))
       }
     )
   }