Fix three broken unit test due to bug fix #68. Add option to limit nu…

…mber of output lines in full call stack.

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: tryCatchLog
 Title: Advanced 'tryCatch()' and 'try()' Functions
-Version: 1.2.5
+Version: 1.3.0
 Authors@R: c(
   person("Juergen", "Altfeld", email = "[email protected]", role = c("aut", "cre", "cph")),
   person("Charles", "Epaillard", email = "[email protected]", role = "ctb"),

NEWS.md

@@ -5,7 +5,16 @@ For the conventions for files NEWS and ChangeLog in the GNU project see
 https://www.gnu.org/prep/standards/standards.html#Documentation
 -->
 
-## Version 1.2.5 (Sept. 2021 work in progress)
+## Version 1.3.0 (Sept 30, 2021)
+
+* Fix critical bug #68: Bad condition logging performance with bug data sizes
+  https://github.com/aryoda/tryCatchLog/issues/68
+* Limit the maximum number of source code rows printed in the full call stack per call to 10
+  (was unlimited before which cause bug #68 if large data in arguments was printed too)
+* Add option `tryCatchLog.max.lines.per.call` to change the maximum number of source code rows
+  printed in the full call stack per call
+
+## Version 1.2.5 (Sept 06, 2021)
 
 * Implement feature request #62 (optional logging of conditions).
   Many thanks to Valerian Wrobel for this contribution!

R/limited_Labels_Compact.R

@@ -19,9 +19,12 @@
 
 #' Convert a call stack into a list of printable strings
 #'
+#' By default the maximum number of source code rows that are printed per call in the full stack trace
+#' is 10. You can change this via the option \code{tryCatchLog.max.lines.per.call} (see example).
+#'
 #' @description    Converts a call stack into a list of printable strings ("labels") with a limited length per call.
-#'                 If source code references are available they are also added in the form
-#'                 \<file name\>#\<line number\>: executed R expression (call)
+#'                 If source code references are available they are also printed in the stack trace using this notation:
+#'                 \code{<file name>#<line number>: executed R expression (call)}
 #'
 #' @param value    a list of calls ("call.stack") generated by \code{\link{sys.calls}}
 #' @param compact  if TRUE only calls that contain a source code reference (attribute "srcref") are returned
@@ -48,6 +51,7 @@
 #'
 #' @seealso        \code{\link{sys.calls}}, \code{\link{tryCatchLog}}, \code{\link{get.pretty.call.stack}}
 #' @examples
+#' options(tryCatchLog.max.lines.per.call = 30)
 #' limitedLabelsCompact(sys.calls(), TRUE)
 #' @export
 limitedLabelsCompact <- function(value, compact = FALSE, maxwidth = getOption("width") - 5L) {
@@ -69,12 +73,15 @@ limitedLabelsCompact <- function(value, compact = FALSE, maxwidth = getOption("w
 
   # New implementation fixes bug #68 (performance impact with sparse matrix)
   if (compact == TRUE)
-    max.rows <- 1 else
-      max.rows <- 30    # nobody wants to see more than 30 rows for each call in the call stack ;-)
+    max.rows   <- 1 else
+      max.rows <- getOption("tryCatchLog.max.lines.per.call", 10)
+                        # nobody wants to see too many rows for each call in the call stack ;-)
+                        # R prints even only one line per call for errors:
+                        # https://github.com/wch/r-source/blob/54f94f0433c487fe55553b0df9bae477c9babdd1/src/main/deparse.c#L356
 
     value <- lapply(value, function(x) {
       if (is.language(x))
-        paste(deparse(x, width.cutoff = 500, nlines = max.rows), collapse = "\n") else
+        paste(deparse(x, width.cutoff = 500, control = NULL, nlines = max.rows), collapse = "\n") else
           as.character(x)
     })
 

R/tryCatchLog.R

@@ -29,6 +29,9 @@
 #' Conditions are also logged including the function call stack
 #' with file names and line numbers (if available).
 #'
+#' By default the maximum number of source code rows that are printed per call in the full stack trace
+#' is 10. You can change this via the option \code{tryCatchLog.max.lines.per.call} (see example).
+#'
 #' @param expr                  R expression to be evaluated
 #' @param ...                   condition handler functions (as in \code{\link{tryCatch}}).
 #'                              The following condition names are mainly used in R:
@@ -168,6 +171,8 @@
 #' options("tryCatchLog.write.error.dump.folder" = "my_log")
 #' options("tryCatchLog.write.error.dump.folder" = NULL)
 #'
+#' options(tryCatchLog.max.lines.per.call = 30)
+#'
 #' \dontrun{
 #' # Use case for "execution.context.msg" argument: Loops and parallel execution
 #' library(foreach)       # support parallel execution (requires an parallel execution plan)

tests/testthat/expected_full_stack_trace.txt

@@ -13,35 +13,6 @@
             dump.file.name <- format(Sys.time(), format = "dump_%Y%m%d_%H%M%S")
             utils::dump.frames()
             save.image(file = paste0(dump.file.name, ".rda"))
-            log.message <- paste0(log.message, "\nCall stack environments dumped into file: ", dump.file.name, ".rda")
-        }
-        log.entry <- build.log.entry(names(futile.logger::ERROR), log.message, call.stack, 1)
-        log.msg <- buildLogMessage(log.message, call.stack, 1)
-        append.to.last.tryCatchLog.result(log.entry)
-        futile.logger::flog.error(log.msg)
-    }, warning = function(w) {
-        call.stack <- sys.calls()
-        log.entry <- build.log.entry(names(futile.logger::WARN), w$message, call.stack, 1)
-        log.msg <- buildLogMessage(w$message, call.stack, 1)
-        append.to.last.tryCatchLog.result(log.entry)
-        futile.logger::flog.warn(log.msg)
-        if (silent.warnings) {
-            invokeRestart("muffleWarning")
-        }
-        else {
-        }
-    }, message = function(m) {
-        call.stack <- sys.calls()
-        log.entry <- build.log.entry(names(futile.logger::INFO), m$message, call.stack, 1)
-        log.msg <- buildLogMessage(m$message, call.stack, 1)
-        append.to.last.tryCatchLog.result(log.entry)
-        futile.logger::flog.info(log.msg)
-        if (silent.messages) {
-            invokeRestart("muffleMessage")
-        }
-        else {
-        }
-    }), ..., finally = finally)
   4 tryCatchList(expr, classes, parentenv, handlers)
   5 tryCatchOne(expr, names, parentenv, handlers[[1]])
   6 doTryCatch(return(expr), name, parentenv, handler)
@@ -55,35 +26,6 @@
             dump.file.name <- format(Sys.time(), format = "dump_%Y%m%d_%H%M%S")
             utils::dump.frames()
             save.image(file = paste0(dump.file.name, ".rda"))
-            log.message <- paste0(log.message, "\nCall stack environments dumped into file: ", dump.file.name, ".rda")
-        }
-        log.entry <- build.log.entry(names(futile.logger::ERROR), log.message, call.stack, 1)
-        log.msg <- buildLogMessage(log.message, call.stack, 1)
-        append.to.last.tryCatchLog.result(log.entry)
-        futile.logger::flog.error(log.msg)
-    }, warning = function(w) {
-        call.stack <- sys.calls()
-        log.entry <- build.log.entry(names(futile.logger::WARN), w$message, call.stack, 1)
-        log.msg <- buildLogMessage(w$message, call.stack, 1)
-        append.to.last.tryCatchLog.result(log.entry)
-        futile.logger::flog.warn(log.msg)
-        if (silent.warnings) {
-            invokeRestart("muffleWarning")
-        }
-        else {
-        }
-    }, message = function(m) {
-        call.stack <- sys.calls()
-        log.entry <- build.log.entry(names(futile.logger::INFO), m$message, call.stack, 1)
-        log.msg <- buildLogMessage(m$message, call.stack, 1)
-        append.to.last.tryCatchLog.result(log.entry)
-        futile.logger::flog.info(log.msg)
-        if (silent.messages) {
-            invokeRestart("muffleMessage")
-        }
-        else {
-        }
-    })
   8 .handleSimpleError(function (e) 
     {
         call.stack <- sys.calls()
@@ -94,12 +36,4 @@
         if (dump.errors.to.file == TRUE) {
             dump.file.name <- format(Sys.time(), format = "dump_%Y%m%d_%H%M%S")
             utils::dump.frames()
-            save.image(file = paste0(dump.file.name, ".rda"))
-            log.message <- paste0(log.message, "\nCall stack environments dumped into file: ", dump.file.name, ".rda")
-        }
-        log.entry <- build.log.entry(names(futile.logger::ERROR), log.message, call.stack, 1)
-        log.msg <- buildLogMessage(log.message, call.stack, 1)
-        append.to.last.tryCatchLog.result(log.entry)
-        futile.logger::flog.error(log.msg)
-    }, "non-numeric argument to mathematical function", quote(log("abc")))
   9 h(simpleError(msg, call))