Debug messages are now prepended with a timestamp

Author: HenrikBengtsson

NEWS

@@ -1,7 +1,11 @@
 Package: future.batchtools
 ==========================
 
-Version: 0.7.2-9000 [2019-01-22]
+Version: 0.7.2-9000 [2019-03-15]
+
+NEW FEATURES:
+
+ * Debug messages are now prepended with a timestamp.
 
 BUG FIXES:
 

R/BatchtoolsFuture-class.R

@@ -321,8 +321,6 @@ run.BatchtoolsFuture <- function(future, ...) {
     stop(sprintf("A future ('%s') can only be launched once.", label))
   }
 
-  mdebug <- import_future("mdebug")
-
   ## Assert that the process that created the future is
   ## also the one that evaluates/resolves/queries it.
   assertOwner <- import_future("assertOwner")
@@ -350,7 +348,7 @@ run.BatchtoolsFuture <- function(future, ...) {
   ## (ii) Attach packages that needs to be attached
   packages <- future$packages
   if (length(packages) > 0) {
-    mdebug("Attaching %d packages (%s) ...",
+    mdebugf("Attaching %d packages (%s) ...",
                     length(packages), hpaste(sQuote(packages)))
 
     ## Record which packages in 'pkgs' that are loaded and
@@ -364,7 +362,7 @@ run.BatchtoolsFuture <- function(future, ...) {
     reg$packages <- packages
     saveRegistry(reg = reg)
 
-    mdebug("Attaching %d packages (%s) ... DONE",
+    mdebugf("Attaching %d packages (%s) ... DONE",
                     length(packages), hpaste(sQuote(packages)))
   }
   ## Not needed anymore
@@ -388,7 +386,7 @@ run.BatchtoolsFuture <- function(future, ...) {
 
   ## 2. Update
   future$config$jobid <- jobid
-  mdebug("Created %s future #%d", class(future)[1], jobid$job.id)
+  mdebugf("Created %s future #%d", class(future)[1], jobid$job.id)
 
   ## WORKAROUND: (For multicore and macOS only)
   if (reg$cluster.functions$name == "Multicore") {
@@ -419,7 +417,7 @@ run.BatchtoolsFuture <- function(future, ...) {
 
   batchtools::submitJobs(reg = reg, ids = jobid, resources = resources)
 
-  mdebug("Launched future #%d", jobid$job.id)
+  mdebugf("Launched future #%d", jobid$job.id)
 
   invisible(future)
 } ## run()
@@ -458,7 +456,6 @@ await.BatchtoolsFuture <- function(future, cleanup = TRUE,
                                                      1.0),
                                    alpha = getOption("future.wait.alpha", 1.01),
                                    ...) {
-  mdebug <- import_future("mdebug")
   stop_if_not(is.finite(timeout), timeout >= 0)
   stop_if_not(is.finite(alpha), alpha > 0)
 
@@ -480,9 +477,9 @@ await.BatchtoolsFuture <- function(future, cleanup = TRUE,
 
   res <- waitForJobs(ids = jobid, timeout = timeout, sleep = sleep_fcn,
                      stop.on.error = FALSE, reg = reg)
-  mdebug("- batchtools::waitForJobs(): %s", res)
+  mdebugf("- batchtools::waitForJobs(): %s", res)
   stat <- status(future)
-  mdebug("- status(): %s", paste(sQuote(stat), collapse = ", "))
+  mdebugf("- status(): %s", paste(sQuote(stat), collapse = ", "))
   mdebug("batchtools::waitForJobs() ... done")
 
   finished <- is_na(stat) || any(c("finished", "error", "expired") %in% stat)
@@ -576,8 +573,6 @@ delete.BatchtoolsFuture <- function(future,
                                 delta = getOption("future.wait.interval", 1.0),
                                 alpha = getOption("future.wait.alpha", 1.01),
                                 ...) {
-  mdebug <- import_future("mdebug")
-
   onRunning <- match.arg(onRunning)
   onMissing <- match.arg(onMissing)
   onFailure <- match.arg(onFailure)
@@ -593,7 +588,7 @@ delete.BatchtoolsFuture <- function(future,
   if (is.null(path) || !file_test("-d", path)) {
     if (onMissing %in% c("warning", "error")) {
       msg <- sprintf("Cannot remove batchtools registry, because directory does not exist: %s", sQuote(path)) #nolint
-      mdebug("delete(): %s", msg)
+      mdebugf("delete(): %s", msg)
       if (onMissing == "warning") {
         warning(msg)
       } else if (onMissing == "error") {
@@ -611,7 +606,7 @@ delete.BatchtoolsFuture <- function(future,
     label <- future$label
     if (is.null(label)) label <- "<none>"
     msg <- sprintf("Will not remove batchtools registry, because is appears to hold a non-resolved future (%s; state = %s; batchtools status = %s): %s", sQuote(label), sQuote(future$state), paste(sQuote(status), collapse = ", "), sQuote(path)) #nolint
-    mdebug("delete(): %s", msg)
+    mdebugf("delete(): %s", msg)
     if (onRunning == "warning") {
       warning(msg)
       return(invisible(TRUE))
@@ -627,19 +622,19 @@ delete.BatchtoolsFuture <- function(future,
 
   ## To simplify post mortem troubleshooting in non-interactive sessions,
   ## should the batchtools registry files be removed or not?
-  mdebug("delete(): Option 'future.delete = %s",
+  mdebugf("delete(): Option 'future.delete = %s",
          sQuote(getOption("future.delete", "<NULL>")))
   if (!getOption("future.delete", interactive())) {
     status <- status(future)
     res <- future$result
     if (inherits(res, "FutureResult")) {
       if (result_has_errors(res)) status <- unique(c("error", status))
     }
-    mdebug("delete(): status(<future>) = %s",
+    mdebugf("delete(): status(<future>) = %s",
            paste(sQuote(status), collapse = ", "))
     if (any(c("error", "expired") %in% status)) {
       msg <- sprintf("Will not remove batchtools registry, because the status of the batchtools was %s and option 'future.delete' is FALSE or running in an interactive session: %s", paste(sQuote(status), collapse = ", "), sQuote(path)) #nolint
-      mdebug("delete(): %s", msg)
+      mdebugf("delete(): %s", msg)
       warning(msg)
       return(invisible(FALSE))
     }
@@ -664,7 +659,7 @@ delete.BatchtoolsFuture <- function(future,
   if (file_test("-d", path)) {
     if (onFailure %in% c("warning", "error")) {
       msg <- sprintf("Failed to remove batchtools registry: %s", sQuote(path))
-      mdebug("delete(): %s", msg)
+      mdebugf("delete(): %s", msg)
       if (onMissing == "warning") {
         warning(msg)
       } else if (onMissing == "error") {
@@ -674,7 +669,7 @@ delete.BatchtoolsFuture <- function(future,
     return(invisible(FALSE))
   }
 
-  mdebug("delete(): batchtools registry deleted: %s", sQuote(path))
+  mdebugf("delete(): batchtools registry deleted: %s", sQuote(path))
 
   invisible(TRUE)
 } # delete()

R/utils.R

@@ -47,23 +47,35 @@ capture_output <- function(expr, envir = parent.frame(), ...) {
 
 printf <- function(...) cat(sprintf(...))
 
-mcat <- function(...) message(..., appendLF = FALSE)
+now <- function(x = Sys.time(), format = "[%H:%M:%OS3] ") {
+  ## format(x, format = format) ## slower
+  format(as.POSIXlt(x, tz = ""), format = format)
+}
+
+mdebug <- function(..., debug = getOption("future.debug", FALSE)) {
+  if (!debug) return()
+  message(now(), ...)
+}
 
-mprintf <- function(...) message(sprintf(...), appendLF = FALSE)
+mdebugf <- function(..., appendLF = TRUE,
+                    debug = getOption("future.debug", FALSE)) {
+  if (!debug) return()
+  message(now(), sprintf(...), appendLF = appendLF)
+}
 
-mprint <- function(...) {
-  bfr <- capture_output(print(...))
-  bfr <- paste(c(bfr, ""), collapse = "\n")
-  message(bfr, appendLF = FALSE)
+#' @importFrom utils capture.output
+mprint <- function(..., appendLF = TRUE, debug = getOption("future.debug", FALSE)) {
+  if (!debug) return()
+  message(paste(now(), capture.output(print(...)), sep = "", collapse = "\n"), appendLF = appendLF)
 }
 
-#' @importFrom utils str
-mstr <- function(...) {
-  bfr <- capture_output(str(...))
-  bfr <- paste(c(bfr, ""), collapse = "\n")
-  message(bfr, appendLF = FALSE)
+#' @importFrom utils capture.output str
+mstr <- function(..., appendLF = TRUE, debug = getOption("future.debug", FALSE)) {
+  if (!debug) return()
+  message(paste(now(), capture.output(str(...)), sep = "", collapse = "\n"), appendLF = appendLF)
 }
 
+
 ## From R.utils 2.0.2 (2015-05-23)
 hpaste <- function(..., sep="", collapse=", ", last_collapse=NULL,
                    max_head=if (missing(last_collapse)) 3 else Inf,

tests/incl/start,load-only.R

@@ -37,8 +37,8 @@ is_false <- future.batchtools:::is_false
 is_na <- future.batchtools:::is_na
 is_os <- future.batchtools:::is_os
 hpaste <- future.batchtools:::hpaste
-mcat <- future.batchtools:::mcat
-mprintf <- future.batchtools:::mprintf
+mcat <- function(...) message(..., appendLF = FALSE)
+mprintf <- function(...) message(sprintf(...), appendLF = FALSE)
 mprint <- future.batchtools:::mprint
 mstr <- future.batchtools:::mstr
 printf <- future.batchtools:::printf