Merge branch 'main' into f-759-named-funs

Author: krlmlr

R/nest.R

@@ -330,33 +330,35 @@ set_spaces <- function(spaces_after_prefix, force_one) {
 #' @return A nested parse table.
 #' @keywords internal
 nest_parse_data <- function(pd_flat) {
-  if (all(pd_flat$parent <= 0L)) {
-    return(pd_flat)
+  repeat {
+    if (all(pd_flat$parent <= 0L)) {
+      return(pd_flat)
+    }
+    pd_flat$internal <- with(pd_flat, (id %in% parent) | (parent <= 0L))
+    split_data <- split(pd_flat, pd_flat$internal)
+
+    child <- split_data$`FALSE`
+    internal <- split_data$`TRUE`
+
+    internal$internal_child <- internal$child
+    internal$child <- NULL
+
+    child$parent_ <- child$parent
+
+    rhs <- nest_(child, "child", setdiff(names(child), "parent_"))
+
+    nested <- left_join(internal, rhs, by = c("id" = "parent_"))
+
+    children <- nested$child
+    for (i in seq_along(children)) {
+      new <- combine_children(children[[i]], nested$internal_child[[i]])
+      # Work around is.null(new)
+      children[i] <- list(new)
+    }
+    nested$child <- children
+    nested$internal_child <- NULL
+    pd_flat <- nested
   }
-  pd_flat$internal <- with(pd_flat, (id %in% parent) | (parent <= 0L))
-  split_data <- split(pd_flat, pd_flat$internal)
-
-  child <- split_data$`FALSE`
-  internal <- split_data$`TRUE`
-
-  internal$internal_child <- internal$child
-  internal$child <- NULL
-
-  child$parent_ <- child$parent
-
-  rhs <- nest_(child, "child", setdiff(names(child), "parent_"))
-
-  nested <- left_join(internal, rhs, by = c("id" = "parent_"))
-
-  children <- nested$child
-  for (i in seq_along(children)) {
-    new <- combine_children(children[[i]], nested$internal_child[[i]])
-    # Work around is.null(new)
-    children[i] <- list(new)
-  }
-  nested$child <- children
-  nested$internal_child <- NULL
-  nest_parse_data(nested)
 }
 
 #' Combine child and internal child

R/roxygen-examples-parse.R

@@ -143,10 +143,12 @@ emulate_rd <- function(roxygen) {
     )
     roxygen <- gsub("(^#)[^']", "#' #", roxygen)
 
-    text <- roxygen2::roc_proc_text(
+    processed <- roxygen2::roc_proc_text(
       roxygen2::rd_roclet(),
       paste(roxygen, collapse = "\n")
-    )[[1L]]$get_section("examples")
+    )
+
+    text <- processed[[1L]]$get_section("examples")
     text <- as.character(text)[-1L]
     text <- c(
       if (grepl("^#'(\\s|\t)*@examples(\\s|\t)*$", roxygen[2L])) "",

tests/testthat/roxygen-examples-complete/1-one-function-example-last-proper-run-in.R renamed to tests/testthat/roxygen-examples-complete/01-one-function-example-last-proper-run-in.R

@@ -0,0 +1,96 @@
+test_that("styler can style package", {
+  capture_output(expect_false({
+    styled <- style_pkg(testthat_file("public-api", "xyzpackage"))
+    any(styled$changed)
+  }))
+})
+
+test_that("styler can style package and exclude some directories", {
+  capture_output(
+    styled <- style_pkg(testthat_file("public-api", "xyzpackage"),
+      exclude_dirs = "tests"
+    )
+  )
+  expect_true(nrow(styled) == 1)
+  expect_false(any(grepl("tests/testthat/test-package-xyz.R", styled$file)))
+})
+
+test_that("styler can style package and exclude some sub-directories", {
+  capture_output(
+    styled <- style_pkg(testthat_file("public-api", "xyzpackage"),
+      exclude_dirs = "tests/testthat"
+    )
+  )
+  expect_true(nrow(styled) == 2)
+  expect_true(any(grepl("tests/testthat.R", styled$file)))
+  expect_false(any(grepl("tests/testthat/test-package-xyz.R", styled$file)))
+})
+
+
+
+test_that("styler can style package and exclude some directories and files", {
+  capture_output(expect_true({
+    styled <- style_pkg(testthat_file("public-api", "xyzpackage"),
+      exclude_dirs = "tests",
+      exclude_files = ".Rprofile"
+    )
+    nrow(styled) == 1
+  }))
+
+  capture_output(expect_true({
+    styled <- style_pkg(testthat_file("public-api", "xyzpackage"),
+      exclude_dirs = "tests",
+      exclude_files = "./.Rprofile"
+    )
+    nrow(styled) == 1
+  }))
+})
+
+
+test_that("styler can style directory", {
+  capture_output(expect_false({
+    styled <- style_dir(testthat_file("public-api", "xyzdir"))
+    any(styled$changed)
+  }))
+})
+
+test_that("styler can style directories and exclude", {
+  capture_output(expect_true({
+    styled <- style_dir(
+      testthat_file("public-api", "renvpkg"),
+      exclude_dirs = "renv"
+    )
+    nrow(styled) == 2
+  }))
+  capture_output(expect_true({
+    styled <- style_dir(
+      testthat_file("public-api", "renvpkg"),
+      exclude_dirs = c("renv", "tests/testthat")
+    )
+    nrow(styled) == 1
+  }))
+
+  capture_output(expect_true({
+    styled <- style_dir(
+      testthat_file("public-api", "renvpkg"),
+      exclude_dirs = "./renv"
+    )
+    nrow(styled) == 2
+  }))
+
+  capture_output(expect_true({
+    styled <- style_dir(
+      testthat_file("public-api", "renvpkg"),
+      exclude_dirs = "./renv", recursive = FALSE
+    )
+    nrow(styled) == 0
+  }))
+
+  capture_output(expect_true({
+    styled <- style_dir(
+      testthat_file("public-api", "renvpkg"),
+      recursive = FALSE
+    )
+    nrow(styled) == 0
+  }))
+})

tests/testthat/roxygen-examples-complete/1-one-function-example-last-proper-run-in_tree renamed to tests/testthat/roxygen-examples-complete/01-one-function-example-last-proper-run-in_tree

@@ -0,0 +1,144 @@
+test_that("styler can style files", {
+  # just one
+  capture_output(expect_equal(
+    {
+      out <- style_file(c(
+        testthat_file("public-api", "xyzfile", "random-script.R")
+      ), strict = FALSE)
+      out$changed
+    },
+    rep(FALSE, 1),
+    ignore_attr = TRUE
+  ))
+  # multiple not in the same working directory
+  capture_output(expect_equal(
+    {
+      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),
+    ignore_attr = TRUE
+  ))
+})
+
+
+test_that("styler does not return error when there is no file to style", {
+  capture_output(expect_error(style_dir(
+    testthat_file("public-api", "xyzemptydir"),
+    strict = FALSE
+  ), NA))
+})
+
+
+
+test_that("styler can style Rmd file", {
+  expect_false({
+    out <- style_file(
+      testthat_file("public-api", "xyzfile_rmd", "random.Rmd"),
+      strict = FALSE
+    )
+    out$changed
+  })
+
+  styled <- style_file(
+    testthat_file("public-api", "xyzfile_rmd", "random2.Rmd"),
+    strict = FALSE
+  )
+  expect_false(styled$changed)
+})
+
+test_that("styler can style Rmarkdown file", {
+  expect_false({
+    out <- style_file(
+      testthat_file("public-api", "xyzfile_rmd", "random.Rmarkdown"),
+      strict = FALSE
+    )
+    out$changed
+  })
+
+
+  styled <- style_file(
+    testthat_file("public-api", "xyzfile_rmd", "random2.Rmarkdown"),
+    strict = FALSE
+  )
+  expect_false(styled$changed)
+})
+
+
+test_that("styler can style qmd file", {
+  expect_false({
+    out <- style_file(
+      testthat_file("public-api", "xyzfile_qmd", "new.qmd"),
+      strict = FALSE
+    )
+    out$changed
+  })
+
+  styled <- style_file(
+    testthat_file("public-api", "xyzfile_rmd", "random2.Rmarkdown"),
+    strict = FALSE
+  )
+  expect_false(styled$changed)
+})
+
+test_that("styler handles malformed Rmd file and invalid R code in chunk", {
+  capture_output(expect_warning(
+    style_file(testthat_file("public-api", "xyzfile_rmd", "invalid4.Rmd"), strict = FALSE),
+    "3: "
+  ))
+
+  capture_output(expect_warning(
+    style_file(testthat_file("public-api", "xyzfile_rmd", "invalid7.Rmd"), strict = FALSE),
+    "Malformed file"
+  ))
+})
+
+
+
+
+test_that("messages (via cat()) of style_file are correct", {
+  for (encoding in ls_testable_encodings()) {
+    withr::with_options(
+      list(cli.unicode = encoding == "utf8"),
+      {
+        # Message if scope > line_breaks and code changes
+        expect_snapshot({
+          cat(catch_style_file_output(file.path(
+            "public-api",
+            "xyzdir-dirty",
+            "dirty-sample-with-scope-tokens.R"
+          )), sep = "\n")
+        })
+
+        # No message if scope > line_breaks and code does not change
+        expect_snapshot({
+          cat(catch_style_file_output(file.path(
+            "public-api", "xyzdir-dirty", "clean-sample-with-scope-tokens.R"
+          )), sep = "\n")
+        })
+
+        # No message if scope <= line_breaks even if code is changed.
+        expect_snapshot({
+          cat(catch_style_file_output(file.path(
+            "public-api", "xyzdir-dirty", "dirty-sample-with-scope-spaces.R"
+          )), sep = "\n")
+        })
+      }
+    )
+  }
+})
+
+test_that("Messages can be suppressed", {
+  withr::with_options(
+    list(styler.quiet = TRUE),
+    {
+      output <- catch_style_file_output(file.path(
+        "public-api", "xyzdir-dirty", "dirty-sample-with-scope-spaces.R"
+      ))
+      expect_equal(output, character(0))
+    }
+  )
+})