tests - make theme tests run locally (#239)

* tests - make theme tests run locally

* Add missing Suggests

* don't try to keep stack trace in snapshot, just hide it

Author: cderv

DESCRIPTION

@@ -29,7 +29,9 @@ Imports:
     utils,
     yaml
 Suggests: 
+    callr,
     curl,
+    dplyr,
     flextable,
     ggiraph,
     ggplot2,
@@ -38,6 +40,7 @@ Suggests:
     knitr,
     palmerpenguins,
     patchwork,
+    pkgload,
     plotly,
     rsconnect (>= 0.8.26),
     testthat (>= 3.1.7),

tests/testthat/_snaps/quarto.md

@@ -20,16 +20,7 @@
         ERROR: Book chapter 'intro.qmd' not found
         
         Stack trace:
-        at throwInputNotFound (<quarto.js full path with location>)
-        at findInputs (<quarto.js full path with location>)
-        at eventLoopTick (ext:core/01_core.js:175:7)
-        at async findChapters (<quarto.js full path with location>)
-        at async bookRenderItems (<quarto.js full path with location>)
-        at async Object.bookProjectConfig [as config] (<quarto.js full path with location>)
-        at async projectContext (<quarto.js full path with location>)
-        at async inspectConfig (<quarto.js full path with location>)
-        at async Command.actionHandler (<quarto.js full path with location>)
-        at async Command.execute (<quarto.js full path with location>)
+        <stack trace>
         
       Caused by error:
       ! System command 'quarto' failed

tests/testthat/helper.R

@@ -91,7 +91,13 @@ local_quarto_project <- function(
   return(file.path(path_tmp, name))
 }
 
-.render <- function(input, output_file = NULL, ..., .env = parent.frame()) {
+.render <- function(
+  input,
+  output_file = NULL,
+  ...,
+  .quiet = TRUE,
+  .env = parent.frame()
+) {
   skip_if_no_quarto()
   skip_if_not_installed("withr")
   # work inside input directory
@@ -102,7 +108,12 @@ local_quarto_project <- function(
       .local_envir = .env
     ))
   }
-  quarto_render(basename(input), output_file = output_file, quiet = TRUE, ...)
+  expect_no_error(quarto_render(
+    basename(input),
+    output_file = output_file,
+    quiet = .quiet,
+    ...
+  ))
   expect_true(file.exists(output_file))
   normalizePath(output_file)
 }
@@ -134,7 +145,8 @@ expect_snapshot_qmd_output <- function(name, input, output_file = NULL, ...) {
 transform_quarto_cli_in_output <- function(
   full_path = FALSE,
   version = FALSE,
-  dir_only = FALSE
+  dir_only = FALSE,
+  hide_stack = FALSE
 ) {
   hide_path <- function(lines, real_path) {
     gsub(
@@ -147,6 +159,38 @@ transform_quarto_cli_in_output <- function(
 
   return(
     function(lines) {
+      if (hide_stack) {
+        # Hide possible stack first
+        stack_trace_index <- which(grepl("\\s*Stack trace\\:", lines))
+        if (
+          length(stack_trace_index) > 0 && stack_trace_index < length(lines)
+        ) {
+          at_lines_indices <- which(grepl("^\\s*at ", lines))
+          at_lines_after_stack <- at_lines_indices[
+            at_lines_indices > stack_trace_index
+          ]
+          if (length(at_lines_after_stack) > 0) {
+            # Find the continuous sequence (no gaps)
+            gaps <- diff(at_lines_after_stack) > 1
+            end_pos <- if (any(gaps)) which(gaps)[1] else
+              length(at_lines_after_stack)
+            consecutive_indices <- at_lines_after_stack[1:end_pos]
+
+            stack_line <- lines[stack_trace_index]
+            indentation <- regmatches(stack_line, regexpr("^\\s*", stack_line))
+            lines[consecutive_indices[1]] <- paste0(
+              indentation,
+              "<stack trace>"
+            )
+            if (length(consecutive_indices) > 1) {
+              lines <- lines[
+                -consecutive_indices[2:length(consecutive_indices)]
+              ]
+            }
+          }
+        }
+      }
+
       if (full_path) {
         quarto_found <- find_quarto()
         if (dir_only) {
@@ -207,3 +251,34 @@ local_quarto_run_echo_cmd <- function(.env = parent.frame()) {
     withr::local_options(quarto.echo_cmd = TRUE, .local_envir = .env)
   }
 }
+
+quick_install <- function(package, lib, quiet = TRUE) {
+  skip_if_not_installed("callr")
+  opts <- c(
+    "--data-compress=none",
+    "--no-byte-compile",
+    "--no-data",
+    "--no-demo",
+    "--no-docs",
+    "--no-help",
+    "--no-html",
+    "--no-libs",
+    "--use-vanilla",
+    sprintf("--library=%s", lib),
+    package
+  )
+  invisible(callr::rcmd("INSTALL", opts, show = !quiet, fail_on_status = TRUE))
+}
+
+install_dev_package <- function(.local_envir = parent.frame()) {
+  # if not inside of R CMD check, install dev version into temp directory
+  if (Sys.getenv("_R_CHECK_TIMINGS_") == "") {
+    skip_if_not_installed("pkgload")
+    withr::local_temp_libpaths(.local_envir = .local_envir)
+    quick_install(pkgload::pkg_path("."), lib = .libPaths()[1])
+    withr::local_envvar(
+      R_LIBS = paste0(.libPaths(), collapse = .Platform$path.sep),
+      .local_envir = .local_envir
+    )
+  }
+}

tests/testthat/test-quarto.R

@@ -29,7 +29,8 @@ test_that("quarto_run report full quarto cli error message", {
     quarto_inspect(),
     transform = transform_quarto_cli_in_output(
       full_path = TRUE,
-      dir_only = TRUE
+      dir_only = TRUE,
+      hide_stack = TRUE
     )
   )
 })

tests/testthat/test-theme.R

@@ -1,48 +1,31 @@
+# don't run on CRAN - this require installed Quarto version with the right version of the quarto package.
+skip_on_cran()
+skip_if_no_quarto()
+skip_if_not_installed("withr")
+
+# We need to install the package in a temporary library when we are in dev mode
+install_dev_package()
 
 test_that("render flextable", {
-  skip_if_no_quarto()
-  quarto_render("theme/flextable.qmd", quiet = TRUE)
-  expect_true(file.exists("theme/flextable.html"))
-  unlink("theme/flextable.html")
+  .render(test_path("theme/flextable.qmd"))
 })
 
-
 test_that("render ggiraph", {
-  skip_if_no_quarto()
-  quarto_render("theme/ggiraph.qmd", quiet = TRUE)
-  expect_true(file.exists("theme/ggiraph.html"))
-  unlink("theme/ggiraph.html")
+  .render(test_path("theme/ggiraph.qmd"))
 })
 
-
 test_that("render ggplot", {
-  skip_if_no_quarto()
-  quarto_render("theme/ggplot.qmd", quiet = TRUE)
-  expect_true(file.exists("theme/ggplot.html"))
-  unlink("theme/ggplot.html")
+  .render(test_path("theme/ggplot.qmd"))
 })
 
-
 test_that("render gt", {
-  skip_if_no_quarto()
-  quarto_render("theme/gt.qmd", quiet = TRUE)
-  expect_true(file.exists("theme/gt.html"))
-  unlink("theme/gt.html")
+  .render(test_path("theme/gt.qmd"))
 })
 
-
 test_that("render plotly-r", {
-  skip_if_no_quarto()
-  quarto_render("theme/plotly-r.qmd", quiet = TRUE)
-  expect_true(file.exists("theme/plotly-r.html"))
-  unlink("theme/plotly-r.html")
+  .render(test_path("theme/plotly-r.qmd"))
 })
 
-
 test_that("render thematic", {
-  skip_if_no_quarto()
-  quarto_render("theme/thematic.qmd", quiet = TRUE)
-  expect_true(file.exists("theme/thematic.html"))
-  unlink("theme/thematic.html")
+  .render(test_path("theme/thematic.qmd"))
 })
-