Merge pull request #585 from lorenzwalthert/issue-584

- Fix caching (#585).

Author: lorenzwalthert

R/nest.R

@@ -39,7 +39,7 @@ add_cache_block <- function(pd_nested) {
   if (cache_is_activated()) {
     pd_nested$block <- cache_find_block(pd_nested)
   } else {
-    pd_nested$block <- rep(1, nrow(pd_nested))
+    pd_nested$block <- rep(1, length(pd_nested$block))
   }
   pd_nested
 }
@@ -101,16 +101,27 @@ drop_cached_children <- function(pd) {
   } else {
     pd
   }
-
 }
 
+#' Find the pos ids to keep
+#'
+#' To make a parse table shallow, we must know which ids to keep.
+#' `split(cumsum(pd_parent_first$parent < 1))` above puts comments with negative
+#' parents in the same block as proceeding expressions. `find_pos_id_to_keep()`
+#' must hence alyways keep comments. We did not use
+#' `split(cumsum(pd_parent_first$parent < 1))` because then every comment is an
+#' expression on its own and processing takes much longer for typical roxygen
+#' annotated code
+#' @param pd A temporary top level nest where the first expression is always a
+#'   top level expression, potentially cached.
+#' @keywords internal
 find_pos_id_to_keep <- function(pd) {
-    if (pd$is_cached[1]) {
-      pd$pos_id[1]
-    } else {
-      pd$pos_id
-    }
+  if (pd$is_cached[1]) {
+    pd$pos_id[c(TRUE, pd[-1L, "token"] == "COMMENT")]
+  } else {
+    pd$pos_id
   }
+}
 
 
 #' Turn off styling for parts of the code
@@ -235,9 +246,10 @@ add_terminal_token_before <- function(pd_flat) {
 add_attributes_caching <- function(pd_flat, transformers) {
   pd_flat$block <- pd_flat$is_cached <- rep(NA, nrow(pd_flat))
   if (cache_is_activated()) {
-    pd_flat$is_cached[pd_flat$parent == 0] <- map_lgl(
+    is_parent <- pd_flat$parent == 0
+    pd_flat$is_cached[is_parent] <- map_lgl(
       pd_flat$text[pd_flat$parent == 0],
-      is_cached, transformers, cache_dir_default()
+      is_cached, transformers
     )
     is_comment <- pd_flat$token == "COMMENT"
     pd_flat$is_cached[is_comment] <- rep(FALSE, sum(is_comment))

R/roxygen-examples.R

@@ -68,7 +68,6 @@ style_roxygen_example_snippet <- function(code_snippet,
     mask <- decomposed$mask
   }
   code_snippet <- post_parse_roxygen(code_snippet) %>%
-    paste0(collapse = "\n") %>%
     parse_transform_serialize_r(transformers, warn_empty = FALSE)
 
   if (is_dont) {

R/serialize.R

@@ -6,12 +6,11 @@
 serialize_parse_data_flattened <- function(flattened_pd) {
   flattened_pd <- apply_stylerignore(flattened_pd)
   flattened_pd$lag_newlines[1] <- 0 # resolve start_line elsewhere
-  res <- with(
+  with(
     flattened_pd,
     paste0(
       collapse = "",
       map(lag_newlines, add_newlines), map(lag_spaces, add_spaces), text
     )
   )
-  convert_newlines_to_linebreaks(res)
 }

R/transform-files.R

@@ -212,7 +212,7 @@ parse_transform_serialize_r <- function(text,
   if (can_verify_roundtrip(transformers)) {
     verify_roundtrip(text, text_out)
   }
-
+  text_out <- convert_newlines_to_linebreaks(text_out)
   if (cache_is_activated()) {
     cache_by_expression(text_out, transformers)
   }

R/zzz.R

@@ -3,12 +3,11 @@
   op <- options()
   op.styler <- list(
     styler.colored_print.vertical = TRUE,
-    styler.cache_name = NULL,
+    styler.cache_name = styler_version,
     styler.addins_style_transformer = "styler::tidyverse_style()",
     styler.ignore_start = "# styler: off",
     styler.ignore_stop = "# styler: on"
   )
-  rlang::warn("Caching feature temporarily disabled and not encouraged to use. See https://github.com/r-lib/styler/issues/584")
   toset <- !(names(op.styler) %in% names(op))
   if (any(toset)) options(op.styler[toset])
   invisible()

man/find_pos_id_to_keep.Rd

@@ -82,10 +82,67 @@ capture.output(
 
 capture.output(test_that("unactivated cache does not bring speedup", {
   skip_if_not_installed("R.cache")
-  on.exit(clear_testthat_cache)
+  on.exit(clear_testthat_cache())
   clear_testthat_cache()
   cache_deactivate()
   first <- system.time(styler::style_file(test_path("reference-objects/caching.R")))
   second <- system.time(styler::style_file(test_path("reference-objects/caching.R")))
   expect_false(first["elapsed"] / 2 > second["elapsed"])
 }))
+
+
+capture.output(test_that("avoid deleting comments #584 (see commit messages)", {
+
+  skip_if_not_installed("R.cache")
+  on.exit(clear_testthat_cache())
+  clear_testthat_cache()
+  activate_testthat_cache()
+  text <- c(
+    "1 + 1",
+    "# Comment",
+    "# another",
+    "NULL"
+    )
+  style_text(text)
+  text2 <- c(
+    "1 + 1",
+    "# x",
+    "# another",
+    "NULL"
+  )
+  expect_equal(
+    as.character(style_text(text2)),
+    text2
+  )
+}))
+
+
+capture.output(test_that("avoid removing roxygen mask (see commit messages in #584)", {
+
+  skip_if_not_installed("R.cache")
+  on.exit(clear_testthat_cache())
+  clear_testthat_cache()
+  activate_testthat_cache()
+  text <- c(
+    "c(",
+    " 1, 2,",
+    "  x - 2",
+    ")"
+  )
+  style_text(text)
+  text2 <- c(
+    "#' Stuff",
+    "#'",
+    "#' @examples",
+    "#' c(",
+    "#'   1, 2,",
+    "#'   x - 2",
+    "#' )",
+    "#' x",
+    "NULL"
+  )
+  expect_equal(
+    as.character(style_text(text2)),
+    text2
+  )
+}))

tests/testthat/test-cache-high-level-api.R

@@ -38,7 +38,7 @@ capture.output(test_that("Cache management works when R.cache is installed", {
   )
   expect_false(cache_info(format = "tabular")$activated)
   expect_equal(getOption("styler.cache_location"), NULL)
-  expect_error(cache_clear(ask = FALSE), NA)
+  expect_error(cache_clear("testthat", ask = FALSE), NA)
 }))
 
 test_that("top-level test: Caches top-level expressions efficiently on style_text()", {
@@ -56,7 +56,7 @@ test_that("top-level test: Caches top-level expressions efficiently on style_tex
   cache_deactivate()
   not_cached_benchmark <- system.time(style_text(text_styled))
   expect_lt(
-    partially_cached_benchmark['elapsed'] * 5,
+    partially_cached_benchmark['elapsed'] * 3,
     not_cached_benchmark['elapsed']
   )
 })

tests/testthat/test-cache-with-r-cache.R

@@ -1,8 +1,8 @@
 test_that("Cache management fails mostly when R.cache is not installed", {
   skip_if(rlang::is_installed("R.cache"))
   expect_error(cache_info(), "is needed when the caching feature is activated")
-  expect_error(cache_activate(), "is needed when the caching feature is activated")
-  expect_error(cache_clear(), "is needed when the caching feature is activated")
+  expect_error(activate_testthat_cache(), "is needed when the caching feature is activated")
+  expect_error(cache_clear("testthat"), "is needed when the caching feature is activated")
   expect_error(capture.output(cache_deactivate()), NA)
   expect_silent(assert_R.cache_installation())
   expect_error(