add new files

R/utils_progress.R

@@ -0,0 +1,26 @@
+# Must be tested interactively: tests/interactive/test-utils_progress.R
+# nocov start
+progress_init <- function(verbose, total) {
+  if (!verbose || !interactive() || total < 2L) {
+    return(NULL)
+  }
+  parent <- parent.frame()
+  progress <- new.env(parent = parent)
+  cli::cli_progress_bar(total = total, .envir = progress)
+  progress
+}
+
+progress_update <- function(progress) {
+  if (is.null(progress)) {
+    return(NULL)
+  }
+  cli::cli_progress_update(.envir = progress)
+}
+
+progress_terminate <- function(progress) {
+  if (is.null(progress)) {
+    return(NULL)
+  }
+  cli::cli_progress_done(.envir = progress)
+}
+# nocov end

tests/interactive/test-utils_progress.R

@@ -0,0 +1,21 @@
+test_that("Should see a progress bar.", {
+  progress <- progress_init(verbose = TRUE, total = 10)
+  for (index in seq_len(10)) {
+    Sys.sleep(0.5)
+    progress_update(progress)
+  }
+  Sys.sleep(0.5)
+  progress_terminate(progress)
+  expect_true(TRUE)
+})
+
+test_that("Should not see a progress bar.", {
+  progress <- progress_init(verbose = FALSE, total = 10)
+  for (index in seq_len(10)) {
+    Sys.sleep(0.5)
+    progress_update(progress)
+  }
+  Sys.sleep(0.5)
+  progress_terminate(progress)
+  expect_true(TRUE)
+})

tests/monitor/test-jobs.R

@@ -153,12 +153,12 @@ test_that("job terminate", {
   }
   while (nrow(x$active()) < n) {
     message(nrow(x$active()))
-    Sys.sleep(0.5)
+    Sys.sleep(1)
   }
   x$terminate(ids = x$active()$id, verbose = TRUE)
   while (nrow(x$active()) > 0L) {
     message(paste(x$active()$status, collapse = " "))
-    Sys.sleep(0.5)
+    Sys.sleep(5)
   }
   expect_equal(nrow(x$active()), 0L)
 })