handlers() did not return a list if the 'default' handler was returned

Author: HenrikBengtsson

NEWS

@@ -6,6 +6,8 @@ Version: 0.2.0-9000 [2020-01-04]
 BUG FIXES:
 
  * winprogressbar_handler() would produce error "invalid 'Label' argument".
+
+ * handlers() did not return a list if the 'default' handler was returned.
 
 
 Version: 0.2.0 [2020-01-04]

OVERVIEW.md

@@ -310,4 +310,3 @@ To debug progress updates, use:
 [doFuture]: https://cran.r-project.org/package=doFuture
 [foreach]: https://cran.r-project.org/package=foreach
 [furrr]: https://cran.r-project.org/package=furrr
-

R/handlers.R

@@ -28,7 +28,10 @@ handlers <- function(..., on_missing = c("error", "warning", "ignore"), default
   args <- list(...)
 
   ## Get the current set of progression handlers?
-  if (length(args) == 0L) return(getOption("progressr.handlers", default))
+  if (length(args) == 0L) {
+    if (!is.list(default)) default <- list(default)
+    return(getOption("progressr.handlers", default))
+  }
 
   on_missing <- match.arg(on_missing)
 

tests/handlers.R

@@ -0,0 +1,14 @@
+source("incl/start.R")
+
+message("handlers() ...")
+
+hs <- handlers()
+print(hs)
+
+hs <- handlers("txtprogressbar")
+print(hs)
+print(hs[[1]])
+
+message("handlers() ... DONE")
+
+source("incl/end.R")

tests/incl/start,load-only.R

@@ -7,11 +7,15 @@ oopts0 <- options()
 oopts <- options()
 
 ## Private
+`%||%` <- progressr:::`%||%`
+hpaste <- progressr:::hpaste
 mdebug <- progressr:::mdebug
 mprint <- progressr:::mprint
 mprintf <- progressr:::mprintf
 mstr <- progressr:::mstr
+in_r_cmd_check <- progressr:::in_r_cmd_check
 stop_if_not <- progressr:::stop_if_not
+printf <- function(...) cat(sprintf(...))
 known_progression_handlers <- progressr:::known_progression_handlers
 
 non_supported_progression_handlers <- function() {

tests/utils.R

@@ -3,6 +3,54 @@ source("incl/start.R")
 message("*** utils ...")
 
 
+message("*** hpaste() ...")
+
+# Some vectors
+x <- 1:6
+y <- 10:1
+z <- LETTERS[x]
+
+# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+# Abbreviation of output vector
+# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+printf("x = %s.\n", hpaste(x))
+## x = 1, 2, 3, ..., 6.
+
+printf("x = %s.\n", hpaste(x, maxHead = 2))
+## x = 1, 2, ..., 6.
+
+printf("x = %s.\n", hpaste(x), maxHead = 3) # Default
+## x = 1, 2, 3, ..., 6.
+
+# It will never output 1, 2, 3, 4, ..., 6
+printf("x = %s.\n", hpaste(x, maxHead = 4))
+## x = 1, 2, 3, 4, 5 and 6.
+
+# Showing the tail
+printf("x = %s.\n", hpaste(x, maxHead = 1, maxTail = 2))
+## x = 1, ..., 5, 6.
+
+# Turning off abbreviation
+printf("y = %s.\n", hpaste(y, maxHead = Inf))
+## y = 10, 9, 8, 7, 6, 5, 4, 3, 2, 1
+
+## ...or simply
+printf("y = %s.\n", paste(y, collapse = ", "))
+## y = 10, 9, 8, 7, 6, 5, 4, 3, 2, 1
+
+# Change last separator
+printf("x = %s.\n", hpaste(x, lastCollapse = " and "))
+## x = 1, 2, 3, 4, 5 and 6.
+
+# No collapse
+stopifnot(all(hpaste(x, collapse = NULL) == x))
+
+# Empty input
+stopifnot(identical(hpaste(character(0)), character(0)))
+
+message("*** hpaste() ... DONE")
+
+
 message("*** mdebug() ...")
 
 mdebug("Hello #", 1)
@@ -32,6 +80,22 @@ tryCatch(stop_if_not(c(1,2,3,4,5,6,7,8,9,10,1,2,3,4,5,6,7,8,9,10,1,2,3,4,5,6,7,8
 
 message("*** stop_if_not() ... done")
 
+
+message("*** %||% ...")
+
+print(NULL %||% TRUE)
+
+print(TRUE %||% FALSE)
+
+message("*** %||% ... done")
+
+message("*** in_r_cmd_check() ...")
+
+print(in_r_cmd_check())
+
+message("*** in_r_cmd_check() ... done")
+
+
 message("*** utils ... DONE")
 
 source("incl/end.R")