First attempt to fix failing unit tests (bug #64)

aryoda · May 18, 2021 · a0aead0 · a0aead0
1 parent 30c8a9a
commit a0aead0
Show file tree

Hide file tree

Showing 5 changed files with 124 additions and 58 deletions.
diff --git a/tests/testthat/build_log_output_test_data_2.txt b/tests/testthat/build_log_output_test_data_2.txt
@@ -8,71 +8,24 @@ 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 <- conditionMessage(e)
-        invisible(structure(msg, class = "try-error", condition = e))
-    }, silent.warnings = silent.warnings, silent.messages = silent.messages)
+        msg <- condit
   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$mes
+
   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)
-
-  8 .handleSimpleError(function (e) 
+
+  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))
 
+  9 h(simpleError(msg, call))
 
diff --git a/tests/testthat/build_log_output_test_data_2_since_R_05_2021.txt b/tests/testthat/build_log_output_test_data_2_since_R_05_2021.txt
@@ -0,0 +1,32 @@
+[ERROR] msg
+
+Compact call stack:
+  1 tryLog(log("abc"))
+  2 tryLog.R#49: tryCatchLog(expr = expr, dump.errors.to.file = dump.errors.to.file, error = function(e) {
+  3 tryCatchLog.R#135: tryCatch(withCallingHandlers(expr, error = function(e) {
+
+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 <- conditi
+  3 tryCatchLog.R#135: tryCatch(withCallingHandlers(expr, error = function(e) {
+        call.stack <- sys.calls()
+        {
+
+  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())
+
+  8 .handleSimpleError(function (e) 
+    {
+        call.stack <- sys.calls()
+        {
+            .doTrace(browser())
+            lo
+  9 h(simpleError(msg, call))
+
+
diff --git a/tests/testthat/expected_full_stack_trace_since_R_05_2021.txt.txt b/tests/testthat/expected_full_stack_trace_since_R_05_2021.txt.txt
@@ -0,0 +1,68 @@
+  1 tryLog(log("abc"))
+  2 tryLog.R#49: tryCatchLog(expr = expr, dump.errors.to.file = dump.errors.to.file, error = function(e) {
+        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
+  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.tryC
+  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/test_build_log_entry.R b/tests/testthat/test_build_log_entry.R
@@ -64,8 +64,15 @@ test_that("stack trace is correct", {
 
 
 
-  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
+  # 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")
+  }
+
   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" = 1000)  # default value in R is 129 - changed from 129 to 1000 on May 17, 2021 as workaround for bug #64
+options("width" = 129)  # default value in R is 129
 
 
 
@@ -45,9 +45,15 @@ test_that("log output is correct", {
 
 
   out2 <- tryCatchLog::build.log.output(log.entry, include.full.call.stack = TRUE)
-  # expected2 <- paste(readLines("tests/testthat/build_log_output_test_data_2.txt"), collapse = "\n")
-  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
+
+  # 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")
+  }
   expect_equal(out2, expected2, info = "include.full.call.stack = TRUE")