Merge branch 'master' into vs-code

Author: lorenzwalthert

NEWS.md

@@ -1,16 +1,25 @@
 
 # styler 1.5.1.9000 (Development version)
 
-* Files with `.Rmarkdown` extension are now recognized as an R markdown files in `style_file()` and friends (#824).
+* Files with `.Rmarkdown` extension are now recognized as an R markdown files in
+  `style_file()` and friends (#824).
 
 * Don't break line before comments in pipes (#822).
 
-* Ordinary comments (starting with `#`) within a roxygen code example block 
+* Ordinary comments (starting with `#`) that break a roxygen code example block 
   (starting with `#'`) are now recognized and preserved (#830).
 
+* `@examplesIf` conditions longer than one line after styling throw an error for
+  compatibility with {roxygen2} (#833).
+  
+* R Markdown chunk headers are no longer required to be parsable R code (#832).
+
 * Break the line between `%>%` and `{` inside and outside function calls (#825).
 
-* Add language server to the integrations (#835).
+* Add language server to third-party integrations vignette (#835).
+
+* improved test setup with fixtures and similar (#798).
+
 
 # styler 1.5.1
 

R/roxygen-examples.R

@@ -25,11 +25,24 @@ style_roxygen_code_example <- function(example, transformers, base_indention) {
 style_roxygen_code_example_one <- function(example_one, transformers, base_indention) {
   bare <- parse_roxygen(example_one)
   one_dont <- split(bare$text, factor(cumsum(bare$text %in% dont_keywords())))
-  map(one_dont, style_roxygen_code_example_segment,
+  unmasked <- map(one_dont, style_roxygen_code_example_segment,
     transformers = transformers,
     base_indention = base_indention
   ) %>%
-    flatten_chr() %>%
+    flatten_chr()
+  if (bare$example_type == "examplesIf") {
+    with_handlers(
+      parse_text(unmasked[1]),
+      error = function(e) {
+        abort(paste0(
+          "Could not style condition in `@examplesIf` because it would result ",
+          "in multi-line condition, which is currently not supported in ",
+          "{roxygen2} (see https://github.com/r-lib/roxygen2/issues/1242)."
+        ))
+      }
+    )
+  }
+  unmasked %>%
     add_roxygen_mask(example_one, bare$example_type)
 }
 

R/testing.R

@@ -257,24 +257,19 @@ n_times_faster_with_cache <- function(x1, x2 = x1, ...,
   out <- purrr::map(1:n, n_times_faster_bench,
     x1 = x1, x2 = x2, fun = fun,
     ..., n = n, clear = clear
-  ) %>%
+  )
+  out <- out %>%
     purrr::map_dbl(
       ~ unname(.x$first["elapsed"] / .x$second["elapsed"])
     ) %>%
     mean()
 
-  if (clear %in% c("always", "final")) {
-    clear_testthat_cache()
-  }
   out
 }
 
 
 n_times_faster_bench <- function(i, x1, x2, fun, ..., n, clear) {
-  fresh_testthat_cache()
-  if ((clear == "always") || (clear == "all but last" & n != i)) {
-    on.exit(clear_testthat_cache())
-  }
+  local_test_setup(cache = TRUE)
   first <- system.time(fun(x1, ...))
 
   if (is.null(x2)) {
@@ -284,7 +279,8 @@ n_times_faster_bench <- function(i, x1, x2, fun, ..., n, clear) {
   }
   list(
     first = first,
-    second = second
+    second = second,
+    cache = cache_info(format = "tabular")
   )
 }
 
@@ -333,9 +329,34 @@ generate_test_samples <- function() {
 #' @include ui-caching.R
 clear_testthat_cache <- purrr::partial(cache_clear, "testthat", ask = FALSE)
 activate_testthat_cache <- purrr::partial(cache_activate, "testthat")
-fresh_testthat_cache <- function() {
-  clear_testthat_cache()
-  activate_testthat_cache()
+
+#' Establish testing setup for current environment
+#'
+#' @param cache Whether or not to create and activate a cache in a temporary
+#'   directory.
+#' @param .local_envir The environment to use for scoping.
+#' @details
+#' * make styler quiet.
+local_test_setup <- function(cache = FALSE,
+                             .local_envir = parent.frame()) {
+  current_cache <- cache_info(format = "tabular")
+  withr::local_options(
+    list("styler.quiet" = TRUE, "R.cache.rootPath" = tempfile()),
+    .local_envir = .local_envir
+  )
+  if (cache) {
+    withr::defer(
+      {
+        clear_testthat_cache()
+        cache_activate(basename(current_cache$location))
+        if (!current_cache$activated) {
+          cache_deactivate()
+        }
+      },
+      envir = .local_envir
+    )
+    activate_testthat_cache()
+  }
 }
 
 cache_more_specs_default <- function() {

R/transform-code.R

@@ -117,12 +117,14 @@ identify_raw_chunks <- function(lines, filetype, engine_pattern = get_engine_pat
 #' @keywords internal
 finalize_raw_chunks <- function(start, end, filetype, lines) {
   header <- gsub(get_knitr_pattern(filetype)$chunk.begin, "\\2", lines[start])
-  parsed <- get_parse_data(paste0("c(", header, ")"))$text
-  do_not_tidy <- any(parsed == "tidy") &&
-    parsed[which(parsed == "tidy") + 1] == "=" &&
-    parsed[which(parsed == "tidy") + 2] == "FALSE"
-  if (do_not_tidy) {
-    return(NULL)
+  # matches last , tidy = TRUE, ignoring quotes!
+  extracted_false <- gsub(
+    ".*,\\s*\\t*tidy\\s*\\t*=\\s*\\t*(F|FALSE)(\\s+.*|\\t+.*|,+.*|)$",
+    "\\1",
+    header
+  )
+  if (extracted_false %in% c("F", "FALSE")) {
+    NULL
   } else {
     list(starts = start, ends = end)
   }

R/ui-caching.R

@@ -112,7 +112,8 @@ cache_info <- function(cache_name = NULL, format = "both") {
 #'   function is doing.
 #' @family cache managers
 #' @export
-cache_activate <- function(cache_name = NULL, verbose = !getOption("styler.quiet", FALSE)) {
+cache_activate <- function(cache_name = NULL,
+                           verbose = !getOption("styler.quiet", FALSE)) {
   if (!is.null(cache_name)) {
     options("styler.cache_name" = cache_name)
   } else {

man/local_test_setup.Rd

@@ -16,3 +16,49 @@ test + f(1)
 ```{r}
 test + f(1)
 ```
+
+```{r, A = ', tidy = FALSE,'}
+knitr::opts_chunk$set(echo = TRUE ) 
+```
+
+```{r, A = ', tidy = FALSE}'}
+knitr::opts_chunk$set(echo = TRUE ) 
+```
+
+```{r, A = ', tidy = FALSE'}
+knitr::opts_chunk$set(echo = TRUE ) 
+```
+
+```{r, A = 'tidy = FALSE, and more'}
+knitr::opts_chunk$set(echo = TRUE ) 
+```
+
+
+```{r, tidy = TRUE}
+knitr::opts_chunk$set(echo = TRUE )
+```
+
+```{r, a = ',tidy = FALSE'}
+knitr::opts_chunk$set(echo = TRUE )
+```
+
+```{r, a = ',tidy = TRUE'}
+knitr::opts_chunk$set(echo = TRUE )
+```
+
+
+```{r, tidy = FALSE, aniopts= 3}
+knitr::opts_chunk$set(echo = TRUE )
+```
+
+```{r, tidy= FALSE, aniopts= 3}
+knitr::opts_chunk$set(echo = TRUE )
+```
+
+```{r, tidy =FALSE, aniopts= 3}
+knitr::opts_chunk$set(echo = TRUE )
+```
+
+```{r, aniopts= 3, tidy = FALSE}
+knitr::opts_chunk$set(echo = TRUE )
+```

tests/testthat/rmd/no-tidy-in.Rmd

@@ -16,3 +16,49 @@ test + f(1)
 ```{r}
 test + f(1)
 ```
+
+```{r, A = ', tidy = FALSE,'}
+knitr::opts_chunk$set(echo = TRUE ) 
+```
+
+```{r, A = ', tidy = FALSE}'}
+knitr::opts_chunk$set(echo = TRUE)
+```
+
+```{r, A = ', tidy = FALSE'}
+knitr::opts_chunk$set(echo = TRUE)
+```
+
+```{r, A = 'tidy = FALSE, and more'}
+knitr::opts_chunk$set(echo = TRUE)
+```
+
+
+```{r, tidy = TRUE}
+knitr::opts_chunk$set(echo = TRUE)
+```
+
+```{r, a = ',tidy = FALSE'}
+knitr::opts_chunk$set(echo = TRUE)
+```
+
+```{r, a = ',tidy = TRUE'}
+knitr::opts_chunk$set(echo = TRUE)
+```
+
+
+```{r, tidy = FALSE, aniopts= 3}
+knitr::opts_chunk$set(echo = TRUE )
+```
+
+```{r, tidy= FALSE, aniopts= 3}
+knitr::opts_chunk$set(echo = TRUE )
+```
+
+```{r, tidy =FALSE, aniopts= 3}
+knitr::opts_chunk$set(echo = TRUE )
+```
+
+```{r, aniopts= 3, tidy = FALSE}
+knitr::opts_chunk$set(echo = TRUE )
+```