Last updated on 2026-11-02 10:53:30 CET.
| Flavor | Version | Tinstall | Tcheck | Ttotal | Status | Flags |
|---|---|---|---|---|---|---|
| r-devel-linux-x86_64-debian-clang | 1.7-0 | 2.13 | 43.70 | 45.83 | OK | |
| r-devel-linux-x86_64-debian-gcc | 1.7-0 | 1.61 | 35.73 | 37.34 | ERROR | |
| r-devel-linux-x86_64-fedora-clang | 1.7-0 | 34.12 | ERROR | |||
| r-devel-linux-x86_64-fedora-gcc | 1.7-0 | 41.77 | ERROR | |||
| r-devel-windows-x86_64 | 1.7-0 | 5.00 | 93.00 | 98.00 | OK | |
| r-patched-linux-x86_64 | 1.7-0 | 2.28 | 39.00 | 41.28 | OK | |
| r-release-linux-x86_64 | 1.7-0 | 2.06 | 39.29 | 41.35 | OK | |
| r-release-macos-arm64 | 1.7-0 | 1.00 | 20.00 | 21.00 | OK | |
| r-release-macos-x86_64 | 1.7-0 | 2.00 | 63.00 | 65.00 | OK | |
| r-release-windows-x86_64 | 1.7-0 | 3.00 | 72.00 | 75.00 | OK | |
| r-oldrel-macos-arm64 | 1.7-0 | OK | ||||
| r-oldrel-macos-x86_64 | 1.7-0 | 2.00 | 55.00 | 57.00 | OK | |
| r-oldrel-windows-x86_64 | 1.7-0 | 4.00 | 80.00 | 84.00 | OK |
Version: 1.7-0
Check: tests
Result: ERROR
Running ‘test_non_interactive.R’ [4s/7s]
Running ‘test_ok.R’ [0s/0s]
Running ‘test_ok_group.R’ [1s/1s]
Running ‘test_output.R’ [0s/1s]
Running ‘test_ut_cmp.R’ [1s/1s]
Running ‘test_ut_cmp_error.R’ [0s/0s]
Running ‘test_ut_cmp_warning.R’ [0s/0s]
Running ‘test_ut_with_report.R’ [1s/2s]
Running the tests in ‘tests/test_ut_cmp.R’ failed.
Complete output:
> options(useFancyQuotes = FALSE) # Force to stabilise all.equal output
>
> library(unittest)
>
> # Compare character output of a (failing) cmp function, ignoring colors
> cmp_lines <- function (actual, ...) {
+ # Remove color escape codes
+ no_color <- gsub('\033\\[.*?m', '', actual, perl = TRUE)
+ if(identical(no_color, c(...)[!is.null(c(...))])) {
+ return(TRUE)
+ }
+ # utils::str(no_color, vec.len = 1000, digits.d = 5, nchar.max = 1000)
+ return(c(c(...)[!is.null(c(...))], '----', actual))
+ }
>
> # Mock (fn) in namespace with (replacement) whilst (block) is being evaluated
> mock <- function (fn, replacement, block) {
+ # Get the name of the function from the unevaluated argument,
+ # assuming it's of the form package::name
+ fn_name <- as.character(as.list(sys.call()[[2]])[[3]])
+ ns <- environment(fn)
+
+ orig_fn <- get(fn_name, env = ns)
+ unlockBinding(fn_name, env = ns)
+ assign(fn_name, replacement, envir = ns)
+ on.exit(assign(fn_name, orig_fn, envir = ns), add = TRUE)
+
+ block
+ }
>
> ok_group("ut_cmp_equal", (function () {
+ ok(isTRUE(ut_cmp_equal(4, 4)), "Identical objects return true")
+ ok(isTRUE(ut_cmp_equal(as.integer(4), 4)), "Equivalent objects return true (i.e. integer vs. number)")
+ ok(isTRUE(ut_cmp_equal(0.01, 0.02, tolerance = 0.1)), "Additional arguments passed through to all.equal")
+
+ if (!file.exists(unittest:::git_binary())) {
+ ok(TRUE, "# skip git not available")
+ return()
+ }
+
+ ok(cmp_lines(ut_cmp_equal(c(2,4,2,8), c(5,4,2,1)),
+ 'Mean relative difference: 1',
+ '--- c(2, 4, 2, 8)',
+ '+++ c(5, 4, 2, 1)',
+ '[1] [-2-]{+5+} 4 2 [-8-]{+1+}',
+ NULL), "Vectors filtered by str, individual differences highlighted")
+
+ ok(!withVisible(ut_cmp_equal("apples", "oranges"))$visible,
+ "Output of comparision isn't visible (we should print it at a real console though)")
+
+ do_a_thing <- function (x) seq(x)
+ ok(cmp_lines(ut_cmp_equal(do_a_thing(4), do_a_thing(1 + 2)),
+ 'Numeric: lengths (4, 3) differ',
+ '--- do_a_thing(4)',
+ '+++ do_a_thing(1 + 2)',
+ '[1] 1 2 3[-4-]',
+ NULL), "The ---/+++ lines show expressions handed to ut_cmp_equal()")
+
+ ok(cmp_lines(ut_cmp_equal(list(c(1, 2, 8), c(2, 3, 2), 10, 11, 12, 13), list(c(1, 2, 3), c(2, 3, 2), 10, 11, 12, 13)),
+ "Component 1: Mean relative difference: 0.625",
+ "--- list(c(1, 2, 8), c(2, 3, 2), 10, 11, 12, 13)",
+ "+++ list(c(1, 2, 3), c(2, 3, 2), 10, 11, 12, 13)",
+ "[[1]]",
+ "[1] 1 2 [-8-]{+3+}",
+ "",
+ "[[2]]",
+ "[1] 2 3 2",
+ "",
+ "[[3]]",
+ "[1] 10",
+ "",
+ "[[4]]",
+ "[1] 11",
+ "",
+ "[[5]]",
+ "[1] 12",
+ "",
+ "[[6]]",
+ "[1] 13",
+ NULL), "We return the whole file as context, not just the usual 3 lines")
+
+ ok(cmp_lines(ut_cmp_equal(c("'Ouch!' he said,", "it was an iron bar."), c("Ooops!", "it was an accident.")),
+ '2 string mismatches',
+ '--- c("\'Ouch!\' he said,", "it was an iron bar.")',
+ '+++ c("Ooops!", "it was an accident.")',
+ "[-'Ouch!' he said,-]{+Ooops!+}",
+ 'it was an [-iron bar.-]{+accident.+}',
+ NULL), "Character vectors get compared one per line")
+
+ ok(cmp_lines(ut_cmp_equal(as.environment(list(a=3, b=4)), as.environment(list(a=5, b=4, c=9))),
+ 'Length mismatch: comparison on first 2 components',
+ 'Component "a": Mean relative difference: 0.6666667',
+ '--- as.environment(list(a = 3, b = 4))',
+ '+++ as.environment(list(a = 5, b = 4, c = 9))',
+ '{+$c+}',
+ '{+[1] 9+}',
+ '',
+ '$b',
+ '[1] 4',
+ '',
+ '$a',
+ '[1] [-3-]{+5+}',
+ NULL), "Environments get converted to lists")
+
+ cmp_helper <- function (a, b) ut_cmp_equal(a, b, deparse_frame = -2)
+ ok(cmp_lines(cmp_helper(2, 8),
+ 'Mean relative difference: 3',
+ '--- 2',
+ '+++ 8',
+ '[1] [-2-]{+8+}',
+ NULL), "A helper function can up deparse_frame to improve output")
+ })())
# ut_cmp_equal
ok - Identical objects return true
ok - Equivalent objects return true (i.e. integer vs. number)
ok - Additional arguments passed through to all.equal
ok - Vectors filtered by str, individual differences highlighted
ok - Output of comparision isn't visible (we should print it at a real console though)
ok - The ---/+++ lines show expressions handed to ut_cmp_equal()
ok - We return the whole file as context, not just the usual 3 lines
ok - Character vectors get compared one per line
ok - Environments get converted to lists
ok - A helper function can up deparse_frame to improve output
>
> # Mock git_binary(), so we don't find git even if it is available
> ok_group("ut_cmp_equal:nogit", mock(unittest:::git_binary, function () "/not-here", {
+ ok(cmp_lines(ut_cmp_equal(c(2,4,2,8), c(5,4,2,1)),
+ 'Mean relative difference: 1',
+ '--- c(2, 4, 2, 8)',
+ '[1] 2 4 2 8',
+ '+++ c(5, 4, 2, 1)',
+ '[1] 5 4 2 1',
+ NULL), "No git available, so show outputs side by side")
+
+ ok(cmp_lines(ut_cmp_equal(as.environment(list(a=3, b=4)), as.environment(list(a=5, b=4, c=9))),
+ 'Length mismatch: comparison on first 2 components',
+ 'Component "a": Mean relative difference: 0.6666667',
+ '--- as.environment(list(a = 3, b = 4))',
+ '$b',
+ '[1] 4',
+ '',
+ '$a',
+ '[1] 3',
+ '',
+ '+++ as.environment(list(a = 5, b = 4, c = 9))',
+ '$c',
+ '[1] 9',
+ '',
+ '$b',
+ '[1] 4',
+ '',
+ '$a',
+ '[1] 5',
+ '',
+ NULL), "Environments get converted to lists")
+ }))
# ut_cmp_equal:nogit
ok - No git available, so show outputs side by side
ok - Environments get converted to lists
>
> ok_group("ut_cmp_identical", (function () {
+ if (!file.exists(unittest:::git_binary())) {
+ ok(TRUE, "# skip git not available")
+ return()
+ }
+
+ ok(isTRUE(ut_cmp_identical(4, 4)), "Identical objects return true")
+ ok(cmp_lines(ut_cmp_identical(as.integer(4), 4),
+ '--- as.integer(4)',
+ '+++ 4',
+ ' [-int-]{+num+} 4',
+ NULL), "Equivalent objects do not, unlike ut_cmp_equal(). We also fall back to using str(), as print() will produce identical output")
+
+ # NB: On r-oldrel-windows-ix86+x86_64 this produces 1.0000000001,
+ # not 1.000000000100000008274, regardless expecting this much
+ # numerical consistency is a bit enthusiastic.
+ ok(cmp_lines(gsub("1.0000000001[0-9]+", "1.0000000001", ut_cmp_identical(1, 1 + 1e-10)),
+ '--- 1',
+ '+++ 1 + 1e-10',
+ ' num [-1-]{+1.0000000001+}',
+ NULL), "Increase str() digits to 22 show a difference")
+
+ ok(cmp_lines(ut_cmp_identical(1 + 1e-10, 1 + 1e-7),
+ '--- 1 + 1e-10',
+ '+++ 1 + 1e-07',
+ ' num [-1-]{+1.0000001+}',
+ NULL), "Increase str() digits (7 is enough) show a difference")
+
+ cmp_helper <- function (a, b) ut_cmp_identical(a, b, deparse_frame = -2)
+ ok(cmp_lines(cmp_helper(2, 8),
+ '--- 2',
+ '+++ 8',
+ '[1] [-2-]{+8+}',
+ NULL), "A helper function can up deparse_frame to improve output")
+ })())
# ut_cmp_identical
ok - Identical objects return true
not ok - Equivalent objects do not, unlike ut_cmp_equal(). We also fall back to using str(), as print() will produce identical output
# Test returned non-TRUE value:
# --- as.integer(4)
# +++ 4
# [-int-]{+num+} 4
# ----
# --- as.integer(4)
# +++ 4
# [-int-]{+num+} 4
not ok - Increase str() digits to 22 show a difference
# Test returned non-TRUE value:
# --- 1
# +++ 1 + 1e-10
# num [-1-]{+1.0000000001+}
# ----
# --- 1
# +++ 1 + 1e-10
# num [-1-]{+1.0000000001+}
not ok - Increase str() digits (7 is enough) show a difference
# Test returned non-TRUE value:
# --- 1 + 1e-10
# +++ 1 + 1e-07
# num [-1-]{+1.0000001+}
# ----
# --- 1 + 1e-10
# +++ 1 + 1e-07
# num [-1-]{+1.0000001+}
ok - A helper function can up deparse_frame to improve output
>
> ok_group("output_diff", (function () {
+ if (!file.exists(unittest:::git_binary())) {
+ ok(TRUE, "# skip git not available")
+ return()
+ }
+
+ options("cli.num_colors" = 256)
+ ok(any(grepl('\033\\[.*?m', ut_cmp_identical(1L, 2L), perl = TRUE)), "cli.num_colors honoured (escape code in output)")
+
+ options("cli.num_colors" = 1)
+ ok(!all(grepl('\033\\[.*?m', ut_cmp_identical(1L, 2L), perl = TRUE)), "cli.num_colors honoured (no escape code in output)")
+ })())
# output_diff
<1b>[0;1mok - cli.num_colors honoured (escape code in output)<1b>[0m
ok - cli.num_colors honoured (no escape code in output)
>
> ok_group("context_lines", local({
+ ok(cmp_lines(ut_cmp_identical(as.list(1:10), {x <- 1:10 ; x[[5]] <- 99 ; as.list(x)}, context_lines = 3),
+ '--- as.list(1:10)',
+ '+++ {',
+ '[1] 4',
+ '',
+ '[[5]]',
+ '[1] [-5-]{+99+}',
+ '',
+ '[[6]]',
+ '[1] 6',
+ NULL), "ut_cmp_identical: context_lines = 3 returned 3 lines of context")
+
+ ok(cmp_lines(ut_cmp_equal(as.list(1:10), {x <- 1:10 ; x[[5]] <- 99 ; as.list(x)}, context_lines = 3),
+ 'Component 5: Mean relative difference: 18.8',
+ '--- as.list(1:10)',
+ '+++ {',
+ '[1] 4',
+ '',
+ '[[5]]',
+ '[1] [-5-]{+99+}',
+ '',
+ '[[6]]',
+ '[1] 6',
+ NULL), "ut_cmp_equal: context_lines = 3 returned 3 lines of context")
+ }))
# context_lines
ok - ut_cmp_identical: context_lines = 3 returned 3 lines of context
ok - ut_cmp_equal: context_lines = 3 returned 3 lines of context
>
> ok_group("ut_cmp_identical:nogit", mock(unittest:::git_binary, function () "/not-here", {
+ ok(isTRUE(ut_cmp_identical(4, 4)), "Identical objects return true")
+ ok(cmp_lines(ut_cmp_identical(as.integer(4), 4),
+ '--- as.integer(4)',
+ ' int 4',
+ '+++ 4',
+ ' num 4',
+ NULL), "Equivalent objects do not, unlike ut_cmp_equal(). We also fall back to using str(), as print() will produce identical output")
+ }))
# ut_cmp_identical:nogit
ok - Identical objects return true
not ok - Equivalent objects do not, unlike ut_cmp_equal(). We also fall back to using str(), as print() will produce identical output
# Test returned non-TRUE value:
# --- as.integer(4)
# int 4
# +++ 4
# num 4
# ----
# --- as.integer(4)
# int 4
# +++ 4
# num 4
>
> proc.time()
user system elapsed
0.488 0.141 1.046
1..23
# Looks like you failed 4 of 23 tests.
# 14: Equivalent objects do not, unlike ut_cmp_equal(). We also fall back to using str(), as print() will produce identical output
# 15: Increase str() digits to 22 show a difference
# 16: Increase str() digits (7 is enough) show a difference
# 23: Equivalent objects do not, unlike ut_cmp_equal(). We also fall back to using str(), as print() will produce identical output
Flavor: r-devel-linux-x86_64-debian-gcc
Version: 1.7-0
Check: tests
Result: ERROR
Running ‘test_non_interactive.R’
Running ‘test_ok.R’
Running ‘test_ok_group.R’
Running ‘test_output.R’
Running ‘test_ut_cmp.R’
Running ‘test_ut_cmp_error.R’
Running ‘test_ut_cmp_warning.R’
Running ‘test_ut_with_report.R’
Running the tests in ‘tests/test_ut_cmp.R’ failed.
Complete output:
> options(useFancyQuotes = FALSE) # Force to stabilise all.equal output
>
> library(unittest)
>
> # Compare character output of a (failing) cmp function, ignoring colors
> cmp_lines <- function (actual, ...) {
+ # Remove color escape codes
+ no_color <- gsub('\033\\[.*?m', '', actual, perl = TRUE)
+ if(identical(no_color, c(...)[!is.null(c(...))])) {
+ return(TRUE)
+ }
+ # utils::str(no_color, vec.len = 1000, digits.d = 5, nchar.max = 1000)
+ return(c(c(...)[!is.null(c(...))], '----', actual))
+ }
>
> # Mock (fn) in namespace with (replacement) whilst (block) is being evaluated
> mock <- function (fn, replacement, block) {
+ # Get the name of the function from the unevaluated argument,
+ # assuming it's of the form package::name
+ fn_name <- as.character(as.list(sys.call()[[2]])[[3]])
+ ns <- environment(fn)
+
+ orig_fn <- get(fn_name, env = ns)
+ unlockBinding(fn_name, env = ns)
+ assign(fn_name, replacement, envir = ns)
+ on.exit(assign(fn_name, orig_fn, envir = ns), add = TRUE)
+
+ block
+ }
>
> ok_group("ut_cmp_equal", (function () {
+ ok(isTRUE(ut_cmp_equal(4, 4)), "Identical objects return true")
+ ok(isTRUE(ut_cmp_equal(as.integer(4), 4)), "Equivalent objects return true (i.e. integer vs. number)")
+ ok(isTRUE(ut_cmp_equal(0.01, 0.02, tolerance = 0.1)), "Additional arguments passed through to all.equal")
+
+ if (!file.exists(unittest:::git_binary())) {
+ ok(TRUE, "# skip git not available")
+ return()
+ }
+
+ ok(cmp_lines(ut_cmp_equal(c(2,4,2,8), c(5,4,2,1)),
+ 'Mean relative difference: 1',
+ '--- c(2, 4, 2, 8)',
+ '+++ c(5, 4, 2, 1)',
+ '[1] [-2-]{+5+} 4 2 [-8-]{+1+}',
+ NULL), "Vectors filtered by str, individual differences highlighted")
+
+ ok(!withVisible(ut_cmp_equal("apples", "oranges"))$visible,
+ "Output of comparision isn't visible (we should print it at a real console though)")
+
+ do_a_thing <- function (x) seq(x)
+ ok(cmp_lines(ut_cmp_equal(do_a_thing(4), do_a_thing(1 + 2)),
+ 'Numeric: lengths (4, 3) differ',
+ '--- do_a_thing(4)',
+ '+++ do_a_thing(1 + 2)',
+ '[1] 1 2 3[-4-]',
+ NULL), "The ---/+++ lines show expressions handed to ut_cmp_equal()")
+
+ ok(cmp_lines(ut_cmp_equal(list(c(1, 2, 8), c(2, 3, 2), 10, 11, 12, 13), list(c(1, 2, 3), c(2, 3, 2), 10, 11, 12, 13)),
+ "Component 1: Mean relative difference: 0.625",
+ "--- list(c(1, 2, 8), c(2, 3, 2), 10, 11, 12, 13)",
+ "+++ list(c(1, 2, 3), c(2, 3, 2), 10, 11, 12, 13)",
+ "[[1]]",
+ "[1] 1 2 [-8-]{+3+}",
+ "",
+ "[[2]]",
+ "[1] 2 3 2",
+ "",
+ "[[3]]",
+ "[1] 10",
+ "",
+ "[[4]]",
+ "[1] 11",
+ "",
+ "[[5]]",
+ "[1] 12",
+ "",
+ "[[6]]",
+ "[1] 13",
+ NULL), "We return the whole file as context, not just the usual 3 lines")
+
+ ok(cmp_lines(ut_cmp_equal(c("'Ouch!' he said,", "it was an iron bar."), c("Ooops!", "it was an accident.")),
+ '2 string mismatches',
+ '--- c("\'Ouch!\' he said,", "it was an iron bar.")',
+ '+++ c("Ooops!", "it was an accident.")',
+ "[-'Ouch!' he said,-]{+Ooops!+}",
+ 'it was an [-iron bar.-]{+accident.+}',
+ NULL), "Character vectors get compared one per line")
+
+ ok(cmp_lines(ut_cmp_equal(as.environment(list(a=3, b=4)), as.environment(list(a=5, b=4, c=9))),
+ 'Length mismatch: comparison on first 2 components',
+ 'Component "a": Mean relative difference: 0.6666667',
+ '--- as.environment(list(a = 3, b = 4))',
+ '+++ as.environment(list(a = 5, b = 4, c = 9))',
+ '{+$c+}',
+ '{+[1] 9+}',
+ '',
+ '$b',
+ '[1] 4',
+ '',
+ '$a',
+ '[1] [-3-]{+5+}',
+ NULL), "Environments get converted to lists")
+
+ cmp_helper <- function (a, b) ut_cmp_equal(a, b, deparse_frame = -2)
+ ok(cmp_lines(cmp_helper(2, 8),
+ 'Mean relative difference: 3',
+ '--- 2',
+ '+++ 8',
+ '[1] [-2-]{+8+}',
+ NULL), "A helper function can up deparse_frame to improve output")
+ })())
# ut_cmp_equal
ok - Identical objects return true
ok - Equivalent objects return true (i.e. integer vs. number)
ok - Additional arguments passed through to all.equal
ok - Vectors filtered by str, individual differences highlighted
ok - Output of comparision isn't visible (we should print it at a real console though)
ok - The ---/+++ lines show expressions handed to ut_cmp_equal()
ok - We return the whole file as context, not just the usual 3 lines
ok - Character vectors get compared one per line
ok - Environments get converted to lists
ok - A helper function can up deparse_frame to improve output
>
> # Mock git_binary(), so we don't find git even if it is available
> ok_group("ut_cmp_equal:nogit", mock(unittest:::git_binary, function () "/not-here", {
+ ok(cmp_lines(ut_cmp_equal(c(2,4,2,8), c(5,4,2,1)),
+ 'Mean relative difference: 1',
+ '--- c(2, 4, 2, 8)',
+ '[1] 2 4 2 8',
+ '+++ c(5, 4, 2, 1)',
+ '[1] 5 4 2 1',
+ NULL), "No git available, so show outputs side by side")
+
+ ok(cmp_lines(ut_cmp_equal(as.environment(list(a=3, b=4)), as.environment(list(a=5, b=4, c=9))),
+ 'Length mismatch: comparison on first 2 components',
+ 'Component "a": Mean relative difference: 0.6666667',
+ '--- as.environment(list(a = 3, b = 4))',
+ '$b',
+ '[1] 4',
+ '',
+ '$a',
+ '[1] 3',
+ '',
+ '+++ as.environment(list(a = 5, b = 4, c = 9))',
+ '$c',
+ '[1] 9',
+ '',
+ '$b',
+ '[1] 4',
+ '',
+ '$a',
+ '[1] 5',
+ '',
+ NULL), "Environments get converted to lists")
+ }))
# ut_cmp_equal:nogit
ok - No git available, so show outputs side by side
ok - Environments get converted to lists
>
> ok_group("ut_cmp_identical", (function () {
+ if (!file.exists(unittest:::git_binary())) {
+ ok(TRUE, "# skip git not available")
+ return()
+ }
+
+ ok(isTRUE(ut_cmp_identical(4, 4)), "Identical objects return true")
+ ok(cmp_lines(ut_cmp_identical(as.integer(4), 4),
+ '--- as.integer(4)',
+ '+++ 4',
+ ' [-int-]{+num+} 4',
+ NULL), "Equivalent objects do not, unlike ut_cmp_equal(). We also fall back to using str(), as print() will produce identical output")
+
+ # NB: On r-oldrel-windows-ix86+x86_64 this produces 1.0000000001,
+ # not 1.000000000100000008274, regardless expecting this much
+ # numerical consistency is a bit enthusiastic.
+ ok(cmp_lines(gsub("1.0000000001[0-9]+", "1.0000000001", ut_cmp_identical(1, 1 + 1e-10)),
+ '--- 1',
+ '+++ 1 + 1e-10',
+ ' num [-1-]{+1.0000000001+}',
+ NULL), "Increase str() digits to 22 show a difference")
+
+ ok(cmp_lines(ut_cmp_identical(1 + 1e-10, 1 + 1e-7),
+ '--- 1 + 1e-10',
+ '+++ 1 + 1e-07',
+ ' num [-1-]{+1.0000001+}',
+ NULL), "Increase str() digits (7 is enough) show a difference")
+
+ cmp_helper <- function (a, b) ut_cmp_identical(a, b, deparse_frame = -2)
+ ok(cmp_lines(cmp_helper(2, 8),
+ '--- 2',
+ '+++ 8',
+ '[1] [-2-]{+8+}',
+ NULL), "A helper function can up deparse_frame to improve output")
+ })())
# ut_cmp_identical
ok - Identical objects return true
not ok - Equivalent objects do not, unlike ut_cmp_equal(). We also fall back to using str(), as print() will produce identical output
# Test returned non-TRUE value:
# --- as.integer(4)
# +++ 4
# [-int-]{+num+} 4
# ----
# --- as.integer(4)
# +++ 4
# [-int-]{+num+} 4
not ok - Increase str() digits to 22 show a difference
# Test returned non-TRUE value:
# --- 1
# +++ 1 + 1e-10
# num [-1-]{+1.0000000001+}
# ----
# --- 1
# +++ 1 + 1e-10
# num [-1-]{+1.0000000001+}
not ok - Increase str() digits (7 is enough) show a difference
# Test returned non-TRUE value:
# --- 1 + 1e-10
# +++ 1 + 1e-07
# num [-1-]{+1.0000001+}
# ----
# --- 1 + 1e-10
# +++ 1 + 1e-07
# num [-1-]{+1.0000001+}
ok - A helper function can up deparse_frame to improve output
>
> ok_group("output_diff", (function () {
+ if (!file.exists(unittest:::git_binary())) {
+ ok(TRUE, "# skip git not available")
+ return()
+ }
+
+ options("cli.num_colors" = 256)
+ ok(any(grepl('\033\\[.*?m', ut_cmp_identical(1L, 2L), perl = TRUE)), "cli.num_colors honoured (escape code in output)")
+
+ options("cli.num_colors" = 1)
+ ok(!all(grepl('\033\\[.*?m', ut_cmp_identical(1L, 2L), perl = TRUE)), "cli.num_colors honoured (no escape code in output)")
+ })())
# output_diff
<1b>[0;1mok - cli.num_colors honoured (escape code in output)<1b>[0m
ok - cli.num_colors honoured (no escape code in output)
>
> ok_group("context_lines", local({
+ ok(cmp_lines(ut_cmp_identical(as.list(1:10), {x <- 1:10 ; x[[5]] <- 99 ; as.list(x)}, context_lines = 3),
+ '--- as.list(1:10)',
+ '+++ {',
+ '[1] 4',
+ '',
+ '[[5]]',
+ '[1] [-5-]{+99+}',
+ '',
+ '[[6]]',
+ '[1] 6',
+ NULL), "ut_cmp_identical: context_lines = 3 returned 3 lines of context")
+
+ ok(cmp_lines(ut_cmp_equal(as.list(1:10), {x <- 1:10 ; x[[5]] <- 99 ; as.list(x)}, context_lines = 3),
+ 'Component 5: Mean relative difference: 18.8',
+ '--- as.list(1:10)',
+ '+++ {',
+ '[1] 4',
+ '',
+ '[[5]]',
+ '[1] [-5-]{+99+}',
+ '',
+ '[[6]]',
+ '[1] 6',
+ NULL), "ut_cmp_equal: context_lines = 3 returned 3 lines of context")
+ }))
# context_lines
ok - ut_cmp_identical: context_lines = 3 returned 3 lines of context
ok - ut_cmp_equal: context_lines = 3 returned 3 lines of context
>
> ok_group("ut_cmp_identical:nogit", mock(unittest:::git_binary, function () "/not-here", {
+ ok(isTRUE(ut_cmp_identical(4, 4)), "Identical objects return true")
+ ok(cmp_lines(ut_cmp_identical(as.integer(4), 4),
+ '--- as.integer(4)',
+ ' int 4',
+ '+++ 4',
+ ' num 4',
+ NULL), "Equivalent objects do not, unlike ut_cmp_equal(). We also fall back to using str(), as print() will produce identical output")
+ }))
# ut_cmp_identical:nogit
ok - Identical objects return true
not ok - Equivalent objects do not, unlike ut_cmp_equal(). We also fall back to using str(), as print() will produce identical output
# Test returned non-TRUE value:
# --- as.integer(4)
# int 4
# +++ 4
# num 4
# ----
# --- as.integer(4)
# int 4
# +++ 4
# num 4
>
> proc.time()
user system elapsed
0.397 0.208 0.862
1..23
# Looks like you failed 4 of 23 tests.
# 14: Equivalent objects do not, unlike ut_cmp_equal(). We also fall back to using str(), as print() will produce identical output
# 15: Increase str() digits to 22 show a difference
# 16: Increase str() digits (7 is enough) show a difference
# 23: Equivalent objects do not, unlike ut_cmp_equal(). We also fall back to using str(), as print() will produce identical output
Flavor: r-devel-linux-x86_64-fedora-clang
Version: 1.7-0
Check: tests
Result: ERROR
Running ‘test_non_interactive.R’ [4s/12s]
Running ‘test_ok.R’
Running ‘test_ok_group.R’
Running ‘test_output.R’
Running ‘test_ut_cmp.R’
Running ‘test_ut_cmp_error.R’
Running ‘test_ut_cmp_warning.R’
Running ‘test_ut_with_report.R’
Running the tests in ‘tests/test_ut_cmp.R’ failed.
Complete output:
> options(useFancyQuotes = FALSE) # Force to stabilise all.equal output
>
> library(unittest)
>
> # Compare character output of a (failing) cmp function, ignoring colors
> cmp_lines <- function (actual, ...) {
+ # Remove color escape codes
+ no_color <- gsub('\033\\[.*?m', '', actual, perl = TRUE)
+ if(identical(no_color, c(...)[!is.null(c(...))])) {
+ return(TRUE)
+ }
+ # utils::str(no_color, vec.len = 1000, digits.d = 5, nchar.max = 1000)
+ return(c(c(...)[!is.null(c(...))], '----', actual))
+ }
>
> # Mock (fn) in namespace with (replacement) whilst (block) is being evaluated
> mock <- function (fn, replacement, block) {
+ # Get the name of the function from the unevaluated argument,
+ # assuming it's of the form package::name
+ fn_name <- as.character(as.list(sys.call()[[2]])[[3]])
+ ns <- environment(fn)
+
+ orig_fn <- get(fn_name, env = ns)
+ unlockBinding(fn_name, env = ns)
+ assign(fn_name, replacement, envir = ns)
+ on.exit(assign(fn_name, orig_fn, envir = ns), add = TRUE)
+
+ block
+ }
>
> ok_group("ut_cmp_equal", (function () {
+ ok(isTRUE(ut_cmp_equal(4, 4)), "Identical objects return true")
+ ok(isTRUE(ut_cmp_equal(as.integer(4), 4)), "Equivalent objects return true (i.e. integer vs. number)")
+ ok(isTRUE(ut_cmp_equal(0.01, 0.02, tolerance = 0.1)), "Additional arguments passed through to all.equal")
+
+ if (!file.exists(unittest:::git_binary())) {
+ ok(TRUE, "# skip git not available")
+ return()
+ }
+
+ ok(cmp_lines(ut_cmp_equal(c(2,4,2,8), c(5,4,2,1)),
+ 'Mean relative difference: 1',
+ '--- c(2, 4, 2, 8)',
+ '+++ c(5, 4, 2, 1)',
+ '[1] [-2-]{+5+} 4 2 [-8-]{+1+}',
+ NULL), "Vectors filtered by str, individual differences highlighted")
+
+ ok(!withVisible(ut_cmp_equal("apples", "oranges"))$visible,
+ "Output of comparision isn't visible (we should print it at a real console though)")
+
+ do_a_thing <- function (x) seq(x)
+ ok(cmp_lines(ut_cmp_equal(do_a_thing(4), do_a_thing(1 + 2)),
+ 'Numeric: lengths (4, 3) differ',
+ '--- do_a_thing(4)',
+ '+++ do_a_thing(1 + 2)',
+ '[1] 1 2 3[-4-]',
+ NULL), "The ---/+++ lines show expressions handed to ut_cmp_equal()")
+
+ ok(cmp_lines(ut_cmp_equal(list(c(1, 2, 8), c(2, 3, 2), 10, 11, 12, 13), list(c(1, 2, 3), c(2, 3, 2), 10, 11, 12, 13)),
+ "Component 1: Mean relative difference: 0.625",
+ "--- list(c(1, 2, 8), c(2, 3, 2), 10, 11, 12, 13)",
+ "+++ list(c(1, 2, 3), c(2, 3, 2), 10, 11, 12, 13)",
+ "[[1]]",
+ "[1] 1 2 [-8-]{+3+}",
+ "",
+ "[[2]]",
+ "[1] 2 3 2",
+ "",
+ "[[3]]",
+ "[1] 10",
+ "",
+ "[[4]]",
+ "[1] 11",
+ "",
+ "[[5]]",
+ "[1] 12",
+ "",
+ "[[6]]",
+ "[1] 13",
+ NULL), "We return the whole file as context, not just the usual 3 lines")
+
+ ok(cmp_lines(ut_cmp_equal(c("'Ouch!' he said,", "it was an iron bar."), c("Ooops!", "it was an accident.")),
+ '2 string mismatches',
+ '--- c("\'Ouch!\' he said,", "it was an iron bar.")',
+ '+++ c("Ooops!", "it was an accident.")',
+ "[-'Ouch!' he said,-]{+Ooops!+}",
+ 'it was an [-iron bar.-]{+accident.+}',
+ NULL), "Character vectors get compared one per line")
+
+ ok(cmp_lines(ut_cmp_equal(as.environment(list(a=3, b=4)), as.environment(list(a=5, b=4, c=9))),
+ 'Length mismatch: comparison on first 2 components',
+ 'Component "a": Mean relative difference: 0.6666667',
+ '--- as.environment(list(a = 3, b = 4))',
+ '+++ as.environment(list(a = 5, b = 4, c = 9))',
+ '{+$c+}',
+ '{+[1] 9+}',
+ '',
+ '$b',
+ '[1] 4',
+ '',
+ '$a',
+ '[1] [-3-]{+5+}',
+ NULL), "Environments get converted to lists")
+
+ cmp_helper <- function (a, b) ut_cmp_equal(a, b, deparse_frame = -2)
+ ok(cmp_lines(cmp_helper(2, 8),
+ 'Mean relative difference: 3',
+ '--- 2',
+ '+++ 8',
+ '[1] [-2-]{+8+}',
+ NULL), "A helper function can up deparse_frame to improve output")
+ })())
# ut_cmp_equal
ok - Identical objects return true
ok - Equivalent objects return true (i.e. integer vs. number)
ok - Additional arguments passed through to all.equal
ok - Vectors filtered by str, individual differences highlighted
ok - Output of comparision isn't visible (we should print it at a real console though)
ok - The ---/+++ lines show expressions handed to ut_cmp_equal()
ok - We return the whole file as context, not just the usual 3 lines
ok - Character vectors get compared one per line
ok - Environments get converted to lists
ok - A helper function can up deparse_frame to improve output
>
> # Mock git_binary(), so we don't find git even if it is available
> ok_group("ut_cmp_equal:nogit", mock(unittest:::git_binary, function () "/not-here", {
+ ok(cmp_lines(ut_cmp_equal(c(2,4,2,8), c(5,4,2,1)),
+ 'Mean relative difference: 1',
+ '--- c(2, 4, 2, 8)',
+ '[1] 2 4 2 8',
+ '+++ c(5, 4, 2, 1)',
+ '[1] 5 4 2 1',
+ NULL), "No git available, so show outputs side by side")
+
+ ok(cmp_lines(ut_cmp_equal(as.environment(list(a=3, b=4)), as.environment(list(a=5, b=4, c=9))),
+ 'Length mismatch: comparison on first 2 components',
+ 'Component "a": Mean relative difference: 0.6666667',
+ '--- as.environment(list(a = 3, b = 4))',
+ '$b',
+ '[1] 4',
+ '',
+ '$a',
+ '[1] 3',
+ '',
+ '+++ as.environment(list(a = 5, b = 4, c = 9))',
+ '$c',
+ '[1] 9',
+ '',
+ '$b',
+ '[1] 4',
+ '',
+ '$a',
+ '[1] 5',
+ '',
+ NULL), "Environments get converted to lists")
+ }))
# ut_cmp_equal:nogit
ok - No git available, so show outputs side by side
ok - Environments get converted to lists
>
> ok_group("ut_cmp_identical", (function () {
+ if (!file.exists(unittest:::git_binary())) {
+ ok(TRUE, "# skip git not available")
+ return()
+ }
+
+ ok(isTRUE(ut_cmp_identical(4, 4)), "Identical objects return true")
+ ok(cmp_lines(ut_cmp_identical(as.integer(4), 4),
+ '--- as.integer(4)',
+ '+++ 4',
+ ' [-int-]{+num+} 4',
+ NULL), "Equivalent objects do not, unlike ut_cmp_equal(). We also fall back to using str(), as print() will produce identical output")
+
+ # NB: On r-oldrel-windows-ix86+x86_64 this produces 1.0000000001,
+ # not 1.000000000100000008274, regardless expecting this much
+ # numerical consistency is a bit enthusiastic.
+ ok(cmp_lines(gsub("1.0000000001[0-9]+", "1.0000000001", ut_cmp_identical(1, 1 + 1e-10)),
+ '--- 1',
+ '+++ 1 + 1e-10',
+ ' num [-1-]{+1.0000000001+}',
+ NULL), "Increase str() digits to 22 show a difference")
+
+ ok(cmp_lines(ut_cmp_identical(1 + 1e-10, 1 + 1e-7),
+ '--- 1 + 1e-10',
+ '+++ 1 + 1e-07',
+ ' num [-1-]{+1.0000001+}',
+ NULL), "Increase str() digits (7 is enough) show a difference")
+
+ cmp_helper <- function (a, b) ut_cmp_identical(a, b, deparse_frame = -2)
+ ok(cmp_lines(cmp_helper(2, 8),
+ '--- 2',
+ '+++ 8',
+ '[1] [-2-]{+8+}',
+ NULL), "A helper function can up deparse_frame to improve output")
+ })())
# ut_cmp_identical
ok - Identical objects return true
not ok - Equivalent objects do not, unlike ut_cmp_equal(). We also fall back to using str(), as print() will produce identical output
# Test returned non-TRUE value:
# --- as.integer(4)
# +++ 4
# [-int-]{+num+} 4
# ----
# --- as.integer(4)
# +++ 4
# [-int-]{+num+} 4
not ok - Increase str() digits to 22 show a difference
# Test returned non-TRUE value:
# --- 1
# +++ 1 + 1e-10
# num [-1-]{+1.0000000001+}
# ----
# --- 1
# +++ 1 + 1e-10
# num [-1-]{+1.0000000001+}
not ok - Increase str() digits (7 is enough) show a difference
# Test returned non-TRUE value:
# --- 1 + 1e-10
# +++ 1 + 1e-07
# num [-1-]{+1.0000001+}
# ----
# --- 1 + 1e-10
# +++ 1 + 1e-07
# num [-1-]{+1.0000001+}
ok - A helper function can up deparse_frame to improve output
>
> ok_group("output_diff", (function () {
+ if (!file.exists(unittest:::git_binary())) {
+ ok(TRUE, "# skip git not available")
+ return()
+ }
+
+ options("cli.num_colors" = 256)
+ ok(any(grepl('\033\\[.*?m', ut_cmp_identical(1L, 2L), perl = TRUE)), "cli.num_colors honoured (escape code in output)")
+
+ options("cli.num_colors" = 1)
+ ok(!all(grepl('\033\\[.*?m', ut_cmp_identical(1L, 2L), perl = TRUE)), "cli.num_colors honoured (no escape code in output)")
+ })())
# output_diff
<1b>[0;1mok - cli.num_colors honoured (escape code in output)<1b>[0m
ok - cli.num_colors honoured (no escape code in output)
>
> ok_group("context_lines", local({
+ ok(cmp_lines(ut_cmp_identical(as.list(1:10), {x <- 1:10 ; x[[5]] <- 99 ; as.list(x)}, context_lines = 3),
+ '--- as.list(1:10)',
+ '+++ {',
+ '[1] 4',
+ '',
+ '[[5]]',
+ '[1] [-5-]{+99+}',
+ '',
+ '[[6]]',
+ '[1] 6',
+ NULL), "ut_cmp_identical: context_lines = 3 returned 3 lines of context")
+
+ ok(cmp_lines(ut_cmp_equal(as.list(1:10), {x <- 1:10 ; x[[5]] <- 99 ; as.list(x)}, context_lines = 3),
+ 'Component 5: Mean relative difference: 18.8',
+ '--- as.list(1:10)',
+ '+++ {',
+ '[1] 4',
+ '',
+ '[[5]]',
+ '[1] [-5-]{+99+}',
+ '',
+ '[[6]]',
+ '[1] 6',
+ NULL), "ut_cmp_equal: context_lines = 3 returned 3 lines of context")
+ }))
# context_lines
ok - ut_cmp_identical: context_lines = 3 returned 3 lines of context
ok - ut_cmp_equal: context_lines = 3 returned 3 lines of context
>
> ok_group("ut_cmp_identical:nogit", mock(unittest:::git_binary, function () "/not-here", {
+ ok(isTRUE(ut_cmp_identical(4, 4)), "Identical objects return true")
+ ok(cmp_lines(ut_cmp_identical(as.integer(4), 4),
+ '--- as.integer(4)',
+ ' int 4',
+ '+++ 4',
+ ' num 4',
+ NULL), "Equivalent objects do not, unlike ut_cmp_equal(). We also fall back to using str(), as print() will produce identical output")
+ }))
# ut_cmp_identical:nogit
ok - Identical objects return true
not ok - Equivalent objects do not, unlike ut_cmp_equal(). We also fall back to using str(), as print() will produce identical output
# Test returned non-TRUE value:
# --- as.integer(4)
# int 4
# +++ 4
# num 4
# ----
# --- as.integer(4)
# int 4
# +++ 4
# num 4
>
> proc.time()
user system elapsed
0.428 0.220 1.900
1..23
# Looks like you failed 4 of 23 tests.
# 14: Equivalent objects do not, unlike ut_cmp_equal(). We also fall back to using str(), as print() will produce identical output
# 15: Increase str() digits to 22 show a difference
# 16: Increase str() digits (7 is enough) show a difference
# 23: Equivalent objects do not, unlike ut_cmp_equal(). We also fall back to using str(), as print() will produce identical output
Flavor: r-devel-linux-x86_64-fedora-gcc