First promising candidate to fix bug #64 (failing unit tests) for all…

… R versions
aryoda · May 19, 2021 · 62e3712 · 62e3712
1 parent bccd626
commit 62e3712
Show file tree

Hide file tree

Showing 8 changed files with 141 additions and 31 deletions.
diff --git a/NEWS.md b/NEWS.md
@@ -7,9 +7,10 @@ https://www.gnu.org/prep/standards/standards.html#Documentation
 
 ## Version 1.2.3 (May 16, 2021)
 
-* Fix bug #64: Unit tests fail on R-devel (test_build_log_entry.R and test_build_log_output)
-
+* Fix bug #64: Unit tests fail on R-devel (test_build_log_entry.R and test_build_log_output).
   Many thanks to Brodie Gaslam to find and fix this bug!
+* Extend the maximum value of the `maxwidth argument of limitedLabels() from 1000 to 2000.
+  This was required for a decent fix of bug #64.
 
 ## Version 1.2.2 (Jan. 8, 2021)
 

diff --git a/R/limited_Labels_Compact.R b/R/limited_Labels_Compact.R
@@ -27,7 +27,7 @@
 #' @param compact  if TRUE only calls that contain a source code reference (attribute "srcref") are returned
 #'                 (plus always the first call); if FALSE all calls will be returned.
 #' @param maxwidth Maximum number of characters per call in the return value (longer strings will be cutted).
-#'                 Must be between 40 and 1000
+#'                 Must be between 40 and 2000 (until version 1.2.2: 1000)
 #'
 #' @return         A list of strings (one for each call).
 #'                 If \code{compact} is \code{TRUE} at the last call is returned even if it does not contain
@@ -75,7 +75,7 @@ limitedLabelsCompact <- function(value, compact = FALSE, maxwidth = getOption("w
   # cut lines that are too long
   if (is.null(maxwidth) || maxwidth < 40L)
     maxwidth <- 40L
-  maxwidth <- min(maxwidth, 1000L)
+  maxwidth <- min(maxwidth, 2000L)  # May 19, 2021: Maxwidth changed from 1000 to 2000 due to unit testing problem (issue #64)
   value <- strtrim(value, maxwidth)
 
   if (compact == TRUE) {

diff --git a/man/limitedLabelsCompact.Rd b/man/limitedLabelsCompact.Rd
diff --git a/tests/testthat/build_log_output_test_data_2.txt b/tests/testthat/build_log_output_test_data_2.txt
@@ -8,25 +8,108 @@ Compact call stack:
 Full call stack:
   1 tryLog(log("abc"))
   2 tryLog.R#49: tryCatchLog(expr = expr, dump.errors.to.file = dump.errors.to.file, error = function(e) {
-        msg <- condit
+        msg <- conditionMessage(e)
+        invisible(structure(msg, class = "try-error", condition = e))
+    }, silent.warnings = silent.warnings, silent.messages = silent.messages)
   3 tryCatchLog.R#135: tryCatch(withCallingHandlers(expr, error = function(e) {
         call.stack <- sys.calls()
         {
-
+            .doTrace(browser())
+            log.message <- e$message
+        }
+        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)
+    }, 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)
   7 withCallingHandlers(expr, error = function(e) {
         call.stack <- sys.calls()
         {
             .doTrace(browser())
-
+            log.message <- e$message
+        }
+        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)
+    }, 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()
         {
             .doTrace(browser())
-
+            log.message <- e$message
+        }
+        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))
 
 
diff --git a/tests/testthat/expected_full_stack_trace.txt b/tests/testthat/expected_full_stack_trace.txt
@@ -22,7 +22,26 @@
     }, 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$mes
+        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)
@@ -46,7 +65,25 @@
         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()

diff --git a/tests/testthat/test_build_log_entry.R b/tests/testthat/test_build_log_entry.R
@@ -11,7 +11,7 @@ source("init_unit_test.R")
 
 
 
-options("width" = 1000)  # default is 129
+options("width" = 2000)  # default is 129
 
 
 
@@ -64,14 +64,8 @@ test_that("stack trace is correct", {
 
 
 
-  # Are we running an R version > 4.x with the fix to treat trailing newline as zero width (see issue #64)?
-  if (nchar("hello\n", type = "width") == 5) {
-    # writeLines(log.entry$full.stack.trace, "expected_full_stack_trace_since_R_05_2021.txt.txt")  # to write the expected result after checking it manually
-    expected_FST <- paste(readLines("expected_full_stack_trace_since_R_05_2021.txt.txt"), collapse = "\n")
-  } else {   # R versions without the fix (before about May 2021)
-    # writeLines(log.entry$full.stack.trace, "expected_full_stack_trace.txt")  # to write the expected result after checking it manually
-    expected_FST <- paste(readLines("expected_full_stack_trace.txt"), collapse = "\n")
-  }
+  # writeLines(log.entry$full.stack.trace, "expected_full_stack_trace.txt")  # to write the expected result after checking it manually
+  expected_FST <- paste(readLines("expected_full_stack_trace.txt"), collapse = "\n")
 
   expect_equal(log.entry$full.stack.trace, expected_FST, info = "full stack trace")
 

diff --git a/tests/testthat/test_build_log_output.R b/tests/testthat/test_build_log_output.R
@@ -11,7 +11,7 @@ source("init_unit_test.R")
 
 
 
-options("width" = 129)  # default value in R is 129
+options("width" = 2000)  # default value in R is 129
 
 
 
@@ -46,14 +46,9 @@ test_that("log output is correct", {
 
   out2 <- tryCatchLog::build.log.output(log.entry, include.full.call.stack = TRUE)
 
-  # Are we running an R version > 4.x with the fix to treat trailing newline as zero width (see issue #64)?
-  if (nchar("hello\n", type = "width") == 5) {
-    # writeLines(out2, "build_log_output_test_data_2_since_R_05_2021.txt")  # to write the expected result after checking it manually
-    expected2 <- paste(readLines("build_log_output_test_data_2_since_R_05_2021.txt"), collapse = "\n")
-  } else {   # R versions without the fix (before about May 2021)
-    # writeLines(out2, "build_log_output_test_data_2.txt")  # to write the expected result after checking it manually
-    expected2 <- paste(readLines("build_log_output_test_data_2.txt"), collapse = "\n")
-  }
+  # writeLines(out2, "build_log_output_test_data_2.txt")  # to write the expected result after checking it manually
+  expected2 <- paste(readLines("build_log_output_test_data_2.txt"), collapse = "\n")
+
   expect_equal(out2, expected2, info = "include.full.call.stack = TRUE")
 
 

diff --git a/tests/testthat/test_limited_Labels_Compact.R b/tests/testthat/test_limited_Labels_Compact.R
@@ -29,9 +29,9 @@ test_that("maxwidth argument ensures width limits", {
 
 
   # maxwidth cutted to 1000 characters
-  call.stack <- call("a.function", paste(rep(string.pattern, 110), collapse = ""))
+  call.stack <- call("a.function", paste(rep(string.pattern, 250), collapse = ""))
   res <- tryCatchLog:::limitedLabelsCompact(call.stack, compact = FALSE, maxwidth = 9999)
 
-  expect_equal(res[2], paste(rep(string.pattern, 100), collapse = ""), info = "maxwidth is cutted after 1000 chars")
+  expect_equal(res[2], paste(rep(string.pattern, 200), collapse = ""), info = "maxwidth is cut after 2000 chars")
 
 })