testit/0000755000176200001440000000000015201003667011566 5ustar liggesuserstestit/tests/0000755000176200001440000000000015200763601012730 5ustar liggesuserstestit/tests/testit/0000755000176200001440000000000015200762273014250 5ustar liggesuserstestit/tests/testit/test-utils.R0000644000176200001440000002077015200762273016516 0ustar liggesuserslibrary(testit) # no need to use testit:::available_dir() assert('available_dir() should find an existing directory', { (file.exists( available_dir(c('foobar', 'whatever', '~', system.file('man', package = 'testit'))) )) (has_error(available_dir('asdfasdf'))) }) exprs = parse(text = 'if (TRUE) {T&F}\n1+1') assert('deparse_key() fetches the n-1 element if code is in {}', { (deparse_key(exprs[[1]]) %==% 'if (TRUE) { .... T & F') }) assert('deparse_key() returns the parsed code if length == 1', { (deparse_key(exprs[[2]]) %==% '1 + 1') }) assert('deparse_one() collapses multi-line deparse to a single string', { (deparse_one(1:3) %==% '1:3') (nchar(deparse_one(seq_len(100))) > 0) (!grepl('\n', deparse_one(seq_len(100)))) }) assert('insert_identical() should not work in a non-interactive R session', { (interactive() || has_error(insert_identical())) }) assert('sys.source2() works on empty files', { f = tempfile() writeLines(' ', f) (sys.source2(f, environment()) %==% NULL) }) assert('parse_snapshot() accepts both ```r and ```{r} blocks', { blocks = parse_snapshot(c( '```r', '1 + 1', '```', '', '```', '[1] 2', '```', '', '```{r}', '2 + 2', '```' ), 'x.md') types = vapply(blocks, `[[`, '', 'type') (all(c('r', '{r}', '') %in% types)) }) assert('snapshot updates preserve the original R fence style', { env = new.env(parent = baseenv()) f1 = tempfile(fileext = '.md') writeLines(c('```r', '1 + 1', '```'), f1) suppressMessages(test_snap(f1, env, update = TRUE)) l1 = readLines(f1, warn = FALSE) (grepl('^```r$', l1[1])) (!any(grepl('^```\\{r\\}$', l1))) f2 = tempfile(fileext = '.md') writeLines(c('```{r}', '1 + 1', '```'), f2) suppressMessages(test_snap(f2, env, update = TRUE)) l2 = readLines(f2, warn = FALSE) (grepl('^```\\{r\\}$', l2[1])) }) assert('test_snap() inserts missing output block before a later code block with output', { env = new.env(parent = baseenv()) # first block has no output; second block has output f = tempfile(fileext = '.md') writeLines(c( '```r', '1 + 1', '```', '```r', '2 + 2', '```', '```', '[1] 4', '```' ), f) suppressMessages(test_snap(f, env, update = TRUE)) lines = readLines(f, warn = FALSE) # output for first block must have been inserted (any(grepl('^\\[1\\] 2$', lines))) # output for second block must still be present (any(grepl('^\\[1\\] 4$', lines))) }) assert('pkg_name() errors when no DESCRIPTION file is found', { d = tempdir() owd = setwd(d); on.exit(setwd(owd)) (has_error(pkg_name())) }) assert('get_fence() adds an extra backtick when extra = TRUE and content has ```', { text = c('````', 'some text') fence = get_fence(text, extra = TRUE) # should be 5 backticks (4 found + 1 extra) (fence %==% '`````') }) assert('get_fence() returns ``` when content has no fences', { (get_fence(c('hello', 'world')) %==% '```') }) assert('parse_snapshot() errors on unbalanced fences', { (has_error(parse_snapshot(c('```r', '1 + 1'), 'test.md'))) }) assert('test_snap() fails when snapshot output does not match (update = FALSE)', { env = new.env(parent = baseenv()) f = tempfile(fileext = '.md') writeLines(c( '```r', '1 + 1', '```', '```', '[1] 999', '```' ), f) (length(test_snap(f, env, update = FALSE)) > 0) }) assert('test_snap() passes when snapshot output matches (update = FALSE)', { env = new.env(parent = baseenv()) f = tempfile(fileext = '.md') writeLines(c( '```r', '1 + 1', '```', '```', '[1] 2', '```' ), f) (test_snap(f, env, update = FALSE) %==% NULL) }) assert('test_snap() rebuilds fence correctly including text blocks', { env = new.env(parent = baseenv()) # Include text before the code block to cover the 'text' type branch f = tempfile(fileext = '.md') writeLines(c('# Title', '', '```r', '1 + 1', '```'), f) suppressMessages(test_snap(f, env, update = TRUE)) lines = readLines(f, warn = FALSE) # text is preserved and output block is added (lines[1] %==% '# Title') (any(grepl('^\\[1\\] 2$', lines))) }) assert('capture_output() captures errors as Error: messages', { env = new.env(parent = baseenv()) out = capture_output("stop('oops')", env, tempdir()) ('Error: oops' %==% out) }) assert('clean_output() removes bytecode and environment addresses', { x = c('', '', 'normal') (clean_output(x) %==% c('', '', 'normal')) }) assert('all_true() handles edge cases', { (!all_true(logical(0))) (!all_true(NA)) (!all_true(c(TRUE, NA))) (!all_true(1)) (all_true(TRUE)) (all_true(c(TRUE, TRUE))) }) assert('test_pkg() sources helper files before tests', { d = tempfile(); dir.create(d) # write a helper file that defines a variable writeLines('helper_val = 42', file.path(d, 'helper.R')) # write a test that uses the helper value writeLines( 'library(testit)\nassert("helper sourced", (helper_val %==% 42))', file.path(d, 'test-helper-check.R') ) # test_pkg should source helper.R before test-helper-check.R (test_pkg('testit', dir = d) %==% NULL) }) assert('test_pkg() collects all errors across and within files', { d = tempfile(); dir.create(d) writeLines(c('stop("error one")', 'stop("error one and a half")'), file.path(d, 'test-aaa.R')) writeLines('stop("error two")', file.path(d, 'test-bbb.R')) out = NULL msg = tryCatch(withCallingHandlers( test_pkg('testit', dir = d), message = function(m) { out <<- c(out, conditionMessage(m)); invokeRestart('muffleMessage') } ), error = conditionMessage) (grepl('error one', msg)) (grepl('error one and a half', msg)) (grepl('error two', msg)) if (exists('.traceback', baseenv(), inherits = FALSE)) { (grepl('error one at .+#\\d+', msg)) (grepl('error one and a half at .+#\\d+', msg)) (grepl('error two at .+#\\d+', msg)) } }) assert('test_pkg() prints details via message() when errors exceed warning.length', { d = tempfile(); dir.create(d) op = options(warning.length = 100L) writeLines(c( 'stop("error one with extra padding to ensure length exceeds the limit")', 'stop("error one and a half with additional padding for length")' ), file.path(d, 'test-aaa.R')) writeLines( 'stop("error two with more padding to guarantee overflow")', file.path(d, 'test-bbb.R') ) out = NULL msg = tryCatch(withCallingHandlers( test_pkg('testit', dir = d), message = function(m) { out <<- c(out, conditionMessage(m)); invokeRestart('muffleMessage') } ), error = conditionMessage) options(op) (msg %==% '3 tests failed (see details above)') printed = paste(out, collapse = '') (grepl('error one', printed)) (grepl('error two', printed)) (grepl('error one and a half', printed)) }) assert('parse_args() extracts --filter and --update from command-line args', { res = parse_args(c('--filter=parse', '--update')) (res$filter %==% 'parse') (res$update %==% TRUE) }) assert('parse_args() returns defaults when no relevant args are present', { res = parse_args(character(0)) (res$filter %==% NULL) (res$update %==% NA) }) assert('test_pkg() filter selects a subset of test files', { d = tempfile(); dir.create(d) writeLines( 'library(testit)\nassert("a passes", (TRUE))', file.path(d, 'test-aaa.R') ) writeLines('stop("should not run")', file.path(d, 'test-bbb.R')) # filter matches only "aaa", so "bbb" should not run (test_pkg('testit', dir = d, filter = 'aaa') %==% NULL) # filter matches "bbb", which errors (has_error(test_pkg('testit', dir = d, filter = 'bbb'))) }) if (Sys.which('git') != '') assert('test_snap() with update = NA on git-tracked file writes and diffs', { # create a temp git repo with a snapshot file d = tempfile(); dir.create(d) owd = getwd(); setwd(d) system2('git', c('init', '-q')) system2('git', c('config', 'user.email', 'test@test.com')) system2('git', c('config', 'user.name', 'Test')) f = file.path(d, 'test.md') writeLines(c('```r', '1 + 1', '```', '```', '[1] 2', '```'), f) system2('git', c('add', 'test.md')) system2('git', c('commit', '-q', '-m', 'init')) # now change the output to be wrong writeLines(c('```r', '1 + 1', '```', '```', '[1] 999', '```'), f) system2('git', c('add', 'test.md')) system2('git', c('commit', '-q', '-m', shQuote('wrong output'))) env = new.env(parent = baseenv()) # update = NA on a tracked file should rewrite and return an error message (length(test_snap(f, env, update = NA)) > 0) # check that the file was updated with correct output lines = readLines(f, warn = FALSE) (any(grepl('^\\[1\\] 2$', lines))) setwd(owd) }) testit/tests/testit/test-utils.md0000644000176200001440000000124615200762273016712 0ustar liggesusersThis block checks deletion-style mini_diff output. ```r cat(mini_diff(c('a', 'b', 'c'), c('a', 'c')), sep = '\n') ``` ``` a - b c ``` This block checks insertion-style mini_diff output. ```r cat(mini_diff(c('a', 'c'), c('a', 'b', 'c')), sep = '\n') ``` ``` a + b c ``` This block checks replacement-style mini_diff output. ```r cat(mini_diff(c('a'), c('b')), sep = '\n') ``` ``` - a + b ``` This block checks that mini_diff emits an ellipsis for skipped context. ```r x1 = paste0('L', 1:16) x2 = x1 x2[c(3, 13)] = c('X', 'Y') cat(mini_diff(x1, x2), sep = '\n') ``` ``` L1 L2 - L3 + X L4 L5 L6 ... L10 L11 L12 - L13 + Y L14 L15 L16 ``` testit/tests/testit/helper.R0000644000176200001440000000010115200762273015642 0ustar liggesusers# shared test utilities is_true = function(x) identical(x, TRUE) testit/tests/testit/test-assert-msg.md0000644000176200001440000000422015200767323017633 0ustar liggesusersShort `%==%` failure shows full LHS/RHS display. ```r msg = tryCatch( assert('short', { (list(a = 1, b = 2) %==% list(a = 1, b = 99)) }), error = conditionMessage ) cat(msg, sep = '\n') ``` ``` -- Assertion failed: short -- list(a = 1, b = 2) (LHS) ==> List of 2 $ a: num 1 $ b: num 2 ---------- List of 2 $ a: num 1 $ b: num 99 <== (RHS) list(a = 1, b = 99) list(a = 1, b = 2) %==% list(a = 1, b = 99) is not TRUE but FALSE at #2 ``` Long `%==%` failure shows `mini_diff` instead. ```r x = as.list(setNames(1:15, paste0('item', 1:15))) y = x; y$item5 = 99; y$item12 = 88 msg = tryCatch( assert('long', { (x %==% y) }), error = conditionMessage ) cat(msg, sep = '\n') ``` ``` -- Assertion failed: long -- Structure diff: x (- LHS) vs y (+ RHS): ... $ item2 : int 2 $ item3 : int 3 $ item4 : int 4 - $ item5 : int 5 + $ item5 : num 99 $ item6 : int 6 $ item7 : int 7 $ item8 : int 8 $ item9 : int 9 $ item10: int 10 $ item11: int 11 - $ item12: int 12 + $ item12: num 88 $ item13: int 13 $ item14: int 14 $ item15: int 15 x %==% y is not TRUE but FALSE at #4 ``` Long `%==%` failure when `str()` is the same for x amd y. ```r x = as.list(setNames(as.numeric(1:15), paste0('item', 1:15))) y = x; y$item5 = x$item5 + 1/2^10 msg = tryCatch( assert('long', { (x %==% y) }), error = conditionMessage ) cat(msg, sep = '\n') ``` ``` -- Assertion failed: long -- x (LHS) ==> List of 15 $ item1 : num 1 $ item2 : num 2 $ item3 : num 3 $ item4 : num 4 $ item5 : num 5 $ item6 : num 6 $ item7 : num 7 $ item8 : num 8 $ item9 : num 9 ... ---------- List of 15 $ item1 : num 1 $ item2 : num 2 $ item3 : num 3 $ item4 : num 4 $ item5 : num 5 $ item6 : num 6 $ item7 : num 7 $ item8 : num 8 $ item9 : num 9 ... <== (RHS) y Detailed diff (- LHS, + RHS): ... item2 = 2 item3 = 3 item4 = 4 - item5 = 5 + item5 = 5.0009765625 item6 = 6 item7 = 7 item8 = 8 x %==% y is not TRUE but FALSE at #4 ``` testit/tests/testit/test-testit.R0000644000176200001440000001233615200762273016671 0ustar liggesuserslibrary(testit) assert('assert works', { (1 == 1) }) # Okay, that is kind of cheating assert('assert() should signal an error if a condition does not hold', { (has_error(assert('this should produce an error', 1 == 2))) }) # a meaningless test in terms of R (failure is irrelevant to Frequentist or Bayesian) has_error(assert('Frequentists must be correct (http://xkcd.com/1132/): the sun has exploded!', { (sample(6, 2) == c(6, 6)) })) # fail logical(0) assert('assert() should stop on logical(0)', { (has_error(assert('1 equals integer(0)', 1 == integer(0)))) }) assert('the infix operator %==% works', { (1 %==% 1) (!(1 %==% 1L)) }) assert('has_message() works', { (has_message(message('hello'))) (!has_message(1 + 1)) (has_message(message('hello world'), 'hello')) (!has_message(message('hello world'), 'bye')) (has_message(message('Hello World'), 'hello', ignore.case = TRUE)) }) assert('has_warning() works', { (has_warning(warning('An intentional warning'))) (has_warning((function() {1:2 + 1:3})())) (has_warning(warning('longer object'), 'longer')) (!has_warning(warning('something'), 'else')) (has_warning(warning('Longer Object'), 'longer', ignore.case = TRUE)) }) assert('has_error() works', { (has_error(stop('An intentional error'))) (has_error(1 + 'a')) (has_error(stop('error occurred'), 'error')) (!has_error(stop('oops'), 'different')) (has_error(stop('Error Occurred'), 'error', ignore.case = TRUE)) }) assert('has_error() works without message matching', { (has_error(stop('An intentional error'))) (!has_error(1 + 1)) }) assert('tests can be written in () in a single {}', { (1 == 1L) z = 1:10 (rev(z) %==% 10:1) }) assert('() works inside control structures', { if (TRUE) (1 == 1) for (i in 1:3) (i > 0) # prove that () inside if/for actually triggers checks (not just grouping) (has_error(assert('if body', { if (TRUE) (1 == 2) }), '1 == 2')) (has_error(assert('for body', { for (i in 1) (i == 0) }), 'i == 0')) }) assert('assert() handles non-symbol call heads (e.g., obj$method())', { env = list2env(list(x = 1)) # $ calls and [[ calls should not confuse the AST walker (env$x %==% 1) l = list(f = function() TRUE) (l$f()) (l[['f']]()) }) assert('assert() treats a non-string first arg as an expression (fact-as-expression)', { # when fact is not a character literal, assert2 detects fact=val at i==1 (has_error(assert({x = 'fact msg'; x}, 1 == 2))) }) assert('%==% emits diagnostic info on failure inside assert()', { # trigger the %==% failure message branch msg = tryCatch( assert('check %==% message', { (1 %==% 2) }), error = function(e) conditionMessage(e) ) (grepl('not TRUE but FALSE', msg)) }) assert('error_loc() returns NULL for empty input', { (error_loc(character(0)) %==% NULL) }) # test error_loc() outside assert() to allow on.exit() to work properly local({ old = Sys.getenv('RSTUDIO_CLI_HYPERLINKS', unset = NA) Sys.setenv(RSTUDIO_CLI_HYPERLINKS = 'false') on.exit(if (is.na(old)) Sys.unsetenv('RSTUDIO_CLI_HYPERLINKS') else Sys.setenv(RSTUDIO_CLI_HYPERLINKS = old)) loc = error_loc('test.R', 5) assert('error_loc() formats location without ANSI when env var is not set', { (loc %==% ' at test.R#5') }) }) local({ old = Sys.getenv('RSTUDIO_CLI_HYPERLINKS', unset = NA) Sys.setenv(RSTUDIO_CLI_HYPERLINKS = 'TRUE') on.exit(if (is.na(old)) Sys.unsetenv('RSTUDIO_CLI_HYPERLINKS') else Sys.setenv(RSTUDIO_CLI_HYPERLINKS = old)) f = tempfile(fileext = '.R'); writeLines('x', f) loc = error_loc(f, 3) assert('error_loc() formats ANSI link when RSTUDIO_CLI_HYPERLINKS is TRUE', { (grepl('\033]8;', loc)) (grepl('#3', loc)) }) }) assert('assert() captures all failures, not just the first', { msg = tryCatch( assert('multi', { (1 == 2); (1 == 0) }), error = function(e) conditionMessage(e) ) (grepl('1 == 2', msg)) (grepl('1 == 0', msg)) # multi-argument form msg2 = tryCatch( assert('multi arg', 1 == 2, 1 == 0), error = function(e) conditionMessage(e) ) (grepl('1 == 2', msg2)) (grepl('1 == 0', msg2)) }) assert('stop_errs() throws a short summary when message exceeds warning.length', { op = options(warning.length = 200L) msgs = c( paste(rep('x', 100), collapse = ''), paste(rep('y', 100), collapse = ''), paste(rep('z', 100), collapse = '') ) err = tryCatch(stop_errs(msgs), error = function(e) conditionMessage(e)) options(op) (err %==% '3 tests failed (see details above)') }) assert('stop_errs() throws full message when it fits in warning.length', { msgs = c('error 1', 'error 2', 'error 3') err = tryCatch(stop_errs(msgs), error = function(e) conditionMessage(e)) (grepl('error 1', err)) (grepl('error 2', err)) (grepl('error 3', err)) }) assert('assert() error includes precise line number of failing () expression', { f = tempfile(fileext = '.R') writeLines(c( 'library(testit)', 'assert("loc test", {', ' x = 1', ' (x == 2)', '})' ), f) msg = tryCatch( sys.source(f, envir = new.env(parent = .GlobalEnv), keep.source = TRUE), error = function(e) conditionMessage(e) ) # line 4 is where (x == 2) lives (grepl('#4', msg)) }) assert('helper functions are available in tests', { (is_true(1 == 1)) (!is_true(1 == 2)) }) testit/tests/testit/test-snapshots-basic.md0000644000176200001440000000057615171452605020662 0ustar liggesusersThis block checks simple vector printing output. ```r 1:5 ``` ``` [1] 1 2 3 4 5 ``` This block checks tabular printing from a data frame. ```r data.frame(x = 1:3, y = letters[1:3]) ``` ``` x y 1 1 a 2 2 b 3 3 c ``` This block checks mixed cat()/print() output ordering. ```r cat('Line 1\n') print('Text output') cat('Line 2\n') ``` ``` Line 1 [1] "Text output" Line 2 ``` testit/tests/testit/test-snapshots-advanced.md0000644000176200001440000000050015171452605021331 0ustar liggesusersThis block checks nested backticks in output text. `````r cat("Use `code` for inline code\n") cat("````r for R code blocks\n") ````` ````` Use `code` for inline code ````r for R code blocks ````` This block checks stabilized environment printing. `````r e <- new.env() print(e) ````` ````` ````` testit/tests/test-r35/0000755000176200001440000000000015200762273014322 5ustar liggesuserstestit/tests/test-r35/test-deparse-diff.md0000644000176200001440000000470615200764434020162 0ustar liggesusersTest deparse_diff() via equ_info() when str() is identical for both sides. Tiny numeric difference (str() shows the same, deparse reveals the diff): ```r cat(equ_info(1.0000000000001, 1.0000000000002), sep = '\n') ``` ``` x (LHS) ==> num 1 ---------- num 1 <== (RHS) y Detailed diff (- LHS, + RHS): - 1.0000000000000999 + 1.0000000000002001 ``` When str() already differs, no detailed diff is shown: ```r cat(equ_info('hello', 'world'), sep = '\n') ``` ``` x (LHS) ==> chr "hello" ---------- chr "world" <== (RHS) y ``` Large vector where only a deep element differs (invisible to str()): ```r x = as.double(1:200) y = x; y[100] = y[100] * (1 + 1e-14) cat(equ_info(x, y), sep = '\n') ``` ``` x (LHS) ==> num [1:200] 1 2 3 4 5 6 7 8 9 10 ... ---------- num [1:200] 1 2 3 4 5 6 7 8 9 10 ... <== (RHS) y Detailed diff (- LHS, + RHS): ... 97 98 99 - 100 + 100.00000000000099 101 102 103 ``` Data frame where one cell differs (invisible to str()): ```r x = data.frame(a = 1:3, b = c(1.1, 2.2, 3.3)) y = x; y$b[2] = 2.2000000000001 cat(equ_info(x, y), sep = '\n') ``` ``` x (LHS) ==> 'data.frame': 3 obs. of 2 variables: $ a: int 1 2 3 $ b: num 1.1 2.2 3.3 ---------- 'data.frame': 3 obs. of 2 variables: $ a: int 1 2 3 $ b: num 1.1 2.2 3.3 <== (RHS) y Detailed diff (- LHS, + RHS): structure(list(a = 1:3 b = c(1.1000000000000001 - 2.2000000000000002 + 2.2000000000001001 3.2999999999999998)) - class = "data.frame" row.names = c(NA - -3L)) + -3L) + class = "data.frame") ``` Large diff hits max_diff and returns partial output: ```r x = as.double(1:200) y = x; y[20:200] = y[20:200] * (1 + 1e-14) cat(equ_info(x, y), sep = '\n') ``` ``` x (LHS) ==> num [1:200] 1 2 3 4 5 6 7 8 9 10 ... ---------- num [1:200] 1 2 3 4 5 6 7 8 9 10 ... <== (RHS) y Detailed diff (- LHS, + RHS): ... 17 18 19 - 20 + 20.000000000000199 - 21 + 21.00000000000021 - 22 + 22.00000000000022 - 23 + 23.000000000000231 - 24 + 24.000000000000242 - 25 + 25.000000000000249 - 26 + 26.000000000000259 - 27 + 27.00000000000027 - 28 + 28.000000000000281 - 29 + 29.000000000000291 - 30 + 30.000000000000298 - 31 + 31.000000000000309 - 32 + 32.00000000000032 - 33 + 33.000000000000327 - 34 + 34.000000000000341 - 35 + 35.000000000000348 - 36 + 36.000000000000362 - 37 + 37.000000000000369 - 38 + 38.000000000000377 - 39 + 39.000000000000391 - 40 + 40.000000000000398 - 41 + 41.000000000000412 - 42 + 42.000000000000419 - 43 + 43.000000000000426 - 44 + 44.000000000000441 ``` testit/tests/test-error/0000755000176200001440000000000015200762273015042 5ustar liggesuserstestit/tests/test-error/test-error.R0000644000176200001440000000011615200762273017271 0ustar liggesusersassert('has_error() works', { (has_error(stop('An intentional error!'))) }) testit/tests/test-all.R0000644000176200001440000000020115200762273014575 0ustar liggesuserslibrary(testit) test_pkg('testit') test_pkg('testit', 'test-error') if (getRversion() >= '3.5.0') test_pkg('testit', 'test-r35') testit/MD50000644000176200001440000000220115201003667012071 0ustar liggesusers2aaf1a26945f17d6f3992943487bd9d8 *DESCRIPTION 63bebe4f6c4b27ba48b6f525abb42320 *LICENSE d57e523327abb0981d2d7dd1dd6ed5fc *NAMESPACE ba2a9b564c6fc5aa3be653ce7e11f0b6 *R/testit.R 859b75f754e4bb3e3dfa5b43f5c9954a *R/utils.R 352cf7e56a0dff25b25fe49c8c46bae5 *R/zzz.R df271e1b16c7d1fd4eae3599f10e716b *inst/NEWS.Rd 4aae9b69bfa4f9baa95bd50f98274ba3 *inst/rstudio/addins.dcf 30dada83ac11024f3b67c5b67a12495b *man/assert.Rd 6287d66525b7e25e84df9811a53495bd *man/has_message.Rd b2a5e32f794ced310d1c1e681d466283 *man/test_pkg.Rd cf03ff3ba57b65d6dc2f1a7117ef5f2d *tests/test-all.R d6254f66e8adc6226751e63f9fbabe51 *tests/test-error/test-error.R fe3e76c19ac03c95c84121d25bd0df0a *tests/test-r35/test-deparse-diff.md d9e762fa165278b1724af6390517cf46 *tests/testit/helper.R 2432afbc6b7572c4fc37c9c55597e2b4 *tests/testit/test-assert-msg.md b9b26d000206d5075216308fa03a98db *tests/testit/test-snapshots-advanced.md 217281806efb04e19c8494678833d714 *tests/testit/test-snapshots-basic.md b6c3d88d7041de074c40f8ed73635a20 *tests/testit/test-testit.R 19b3edfa4d6fadf3099ef15d3a662adf *tests/testit/test-utils.R f0d66bda779f1124c4df0fceea30b8ac *tests/testit/test-utils.md testit/R/0000755000176200001440000000000015200762273011773 5ustar liggesuserstestit/R/zzz.R0000644000176200001440000000122215200762273012750 0ustar liggesusers# clean up the temp library created in test_pkg() at the end of the R session .onLoad = function(libname, pkgname) { reg.finalizer(.env, function(e) { if (is.null(e$lib_new)) return() # unload DLLs loaded from lib_new, otherwise its libs/ dir can't be removed prefix = paste0(e$lib_new, .Platform$file.sep) for (d in getLoadedDLLs()) { p = norm_path(d[['path']], mustWork = FALSE) if (starts_with(p, prefix)) tryCatch(dyn.unload(d[['path']]), error = identity) } unlink(e$lib_new, recursive = TRUE, force = TRUE) cleanup_msg(e$lib_new) if (!is.null(e$lib_old)) .libPaths(e$lib_old) }, onexit = TRUE) } testit/R/utils.R0000644000176200001440000002735015200765105013262 0ustar liggesusers# an internal environment to store objects .env = new.env(parent = emptyenv()) one_string = function(x, collapse = '\n') paste(x, collapse = collapse) # signal an error from one or more failure messages; when check = TRUE, # print full details via message() if they would exceed warning.length stop_errs = function(msgs, check = TRUE) { if (!(n <- length(msgs))) return(invisible()) msgs = vapply(msgs, function(m) { if (starts_with(m, '-- ')) m else one_string(c('-- Error --', paste0(' ', strsplit(m, '\n')[[1]]))) }, '', USE.NAMES = FALSE) full = one_string(msgs, '\n\n') if (!check || nchar(full, type = 'bytes') <= getOption('warning.length', 1000L)) stop(full, call. = FALSE) message(full) stop(sprintf( '%d test%s failed (see details above)', n, if (n > 1) 's' else '' ), call. = FALSE) } # trigger %==% diagnostics and return the collected info (for testing) equ_info = function(x, y) { .env$equ_info = NULL op = options(testit.asserting = TRUE); on.exit(options(op)) x %==% y .env$equ_info } # base::startsWith() requires R >= 3.3 starts_with = function(x, prefix) substring(x, 1, nchar(prefix)) == prefix norm_path = function(x, ...) normalizePath(x, '/', ...) # check if a source package needs (re)installation by comparing source file # mtimes against the installed package timestamp pkg_needs_install = function(pkg_root, package) { pkg_root = norm_path(pkg_root) libs = .libPaths() libs = libs[norm_path(libs, mustWork = FALSE) != dirname(pkg_root)] # if the namespace is already loaded from outside .libPaths() (e.g., covr's # temp lib or load_all()), the caller set it up intentionally — skip reinstall if (isNamespaceLoaded(package)) { ns_path = norm_path(getNamespaceInfo(package, 'path'), mustWork = FALSE) if (!any(starts_with(ns_path, norm_path(libs, mustWork = FALSE)))) return(FALSE) } lib = find.package(package, lib.loc = libs, quiet = TRUE) if (!length(lib)) return(TRUE) installed_time = file.mtime(file.path(lib, 'Meta', 'package.rds')) if (is.na(installed_time)) return(TRUE) src_files = list.files(pkg_root, recursive = TRUE, full.names = TRUE) tests_dir = paste0(pkg_root, '/tests/') src_files = src_files[!starts_with(src_files, tests_dir)] if (!length(src_files)) return(TRUE) max(file.mtime(src_files), na.rm = TRUE) > installed_time } # get package name from DESCRIPTION file pkg_name = function() { for (desc in c('DESCRIPTION', '../DESCRIPTION')) { if (file.exists(desc)) { d = read.dcf(desc, fields = 'Package') if (!is.na(d[1, 1])) return(d[1, 1]) } } stop('Package name cannot be detected from DESCRIPTION.') } dir_exists = function(x) utils::file_test('-d', x) # find an available dir available_dir = function(dirs) { for (i in dirs) if (dir_exists(i)) return(i) stop('None of the directories exists:\n', one_string(utils::formatUL(dirs))) } # a compact way to display tempfile() short_temp = function(x) paste0('tempdir()/', basename(x)) cleanup_msg = function(path) message( if (dir_exists(path)) 'Failed to clean' else 'Cleaned', ' up ', short_temp(path) ) # tailored for assert(): extract the expression that is likely to be useful for # diagnostics if possible deparse_key = function(expr) { x = deparse(expr, width.cutoff = 100L) if ((n <- length(x)) <= 1) return(x) # if expression is in {}, fetch the line n-1, otherwise use the first line paste(x[1], '....', if (x[n] == '}') sub('^\\s*', '', x[n - 1L])) } deparse_one = function(expr) one_string(deparse(expr, 500L), '') # whether every element of x is strictly TRUE all_true = function(x) { is.logical(x) && length(x) && !any(is.na(x)) && all(x) } insert_identical = function() { insert = getFromNamespace('insertText', 'rstudioapi') insert(text = ' %==% ') } # A modification of base::sys.source that uses the package namespace as the # top-level environment and collects all errors instead of stopping at the # first. Returns a character vector of error messages (empty if no errors). sys.source2 = function(file, envir, top.env = as.environment(envir)) { oop = options(keep.source = TRUE, topLevelEnvironment = top.env) on.exit(options(oop), add = TRUE) file = norm_path(file) lines = readLines(file, warn = FALSE, encoding = 'UTF-8') srcfile = srcfilecopy(file, lines, file.mtime(file), isFile = TRUE) exprs = parse(text = lines, srcfile = srcfile, encoding = 'UTF-8') if (length(exprs) == 0L) return() owd = setwd(dirname(file)); on.exit(setwd(owd), add = TRUE) errs = NULL for (i in seq_along(exprs)) tryCatch( loc_stop(eval(exprs[i], envir)), error = function(e) errs <<- c(errs, conditionMessage(e)) ) errs } # Clean output to remove unstable elements like bytecode addresses clean_output = function(lines) { # Remove addresses like , , gsub('<(bytecode|environment|pointer): 0x[0-9a-f]+>', '<\\1: ...>', lines) } # get fence for code blocks based on content get_fence = function(text, extra = FALSE) { ms = gregexpr('^`+', text, perl = TRUE) n = max(unlist(lapply(ms, attr, 'match.length'))) if (extra && n >= 3) n = n + 1 one_string(rep('`', max(n, 3)), '') } # Parse markdown file to extract code blocks parse_snapshot = function(lines, file) { # Find all fence lines with optional R language labels ({r} or r) idx = grepl(r <- sprintf('^%s\\s*(\\{r\\}|r)?\\s*$', get_fence(lines)), lines) if (sum(idx) %% 2 != 0) stop('Unbalanced code fences in ', error_loc(file)) # Change TRUE to FALSE for idx elements at even positions and their next # elements to TRUE to mark the start of the next block fences = which(idx) i = seq_len(length(fences)/2) * 2 idx[fences[i]] = FALSE idx[fences[i] + 1] = TRUE # Split lines into code, output, and text blocks N = seq_along(lines) blocks = split(data.frame(lines, N, stringsAsFactors = FALSE), cumsum(idx[N])) lapply(blocks, function(b) { n = nrow(b) if (n < 2 || !grepl(r, b[1, 1])) list(type = 'text', content = b[, 1]) else { list(type = gsub('^```+|\\s+', '', b[1, 1]), content = b[-c(1, n), 1], line = b[1, 2]) } }) } # Execute snapshot tests from a markdown file containing R code blocks and # expected output blocks. Returns error messages (if any) like sys.source2(). test_snap = function(f, env, update = NA) { raw_lines = readLines(f, warn = FALSE, encoding = 'UTF-8') blocks = parse_snapshot(raw_lines, f) new_blocks = list(); changed = FALSE pos = NULL # record the first line of the first failed block for error reporting # Process blocks in pairs: R code block followed by output block N = length(blocks) for (i in seq_len(N)) { block = blocks[[i]] new_blocks[[length(new_blocks) + 1]] = block # Add current block to new_blocks if (!block$type %in% c('{r}', 'r')) next out = capture_output(block$content, env, dirname(f), f, block$line) # look for the next output block k (stop at the next R code block) k = NULL if (i + 1 <= N) for (j in (i + 1):N) { if (blocks[[j]]$type %in% c('{r}', 'r')) break if (blocks[[j]]$type == '') { k = j; break } } if (is.null(k)) { # no output block, add one new_blocks[[length(new_blocks) + 1]] = list(type = '', content = out) changed = TRUE } else { expected_lines = blocks[[k]]$content if (identical(out, expected_lines)) next changed = TRUE if (!isTRUE(update) && is.null(pos)) pos = block$line blocks[[k]] = list(type = '', content = out) } } if (!changed) return() # Write updated markdown all_content = unlist(lapply(new_blocks, function(b) b$content)) fence = get_fence(all_content, TRUE) out_lines = unlist(lapply(new_blocks, function(b) { if (b$type == 'text') b$content else { c(paste0(fence, b$type), b$content, fence) } })) if (isTRUE(update) || is.null(pos)) { write_utf8(out_lines, f) message('Updated snapshot file: ', f) return() } tracked = system2( 'git', c('ls-files', '--error-unmatch', shQuote(f)), stdout = FALSE, stderr = FALSE ) == 0 if (tracked && is.na(update)) { write_utf8(out_lines, f) d = system2('git', c('diff', '--color=auto', shQuote(f)), stdout = TRUE, stderr = FALSE) message(one_string(d)) } else { message(one_string(mini_diff(raw_lines, out_lines))) } paste0( 'Snapshot test failed', error_loc(f, pos), '\n', if (tracked) 'If the changes are not expected, revert them in GIT.' else 'Call testit::test_pkg(update = TRUE) to update.' ) } capture_output = function(code, envir, wd, file = NULL, line = NULL) { owd = setwd(wd); on.exit(setwd(owd), add = TRUE) err_i = NULL out = tryCatch(capture.output(quietly({ exprs = if (length(code)) parse(text = code, keep.source = TRUE) for (i in seq_along(exprs)) { err_i = i res = withVisible(eval(exprs[[i]], envir = envir)) if (res$visible) print(res$value) } })), error = function(e) { loc = if (!is.null(file) && !is.null(err_i)) { sr = attr(exprs, 'srcref') err_line = if (!is.null(sr[[err_i]])) line + sr[[err_i]][1] if (!is.null(err_line)) error_loc(file, err_line) } paste0('Error: ', conditionMessage(e), loc) }) clean_output(out) } write_utf8 = function(text, con) { opts = options(encoding = "native.enc") on.exit(options(opts)) writeLines(enc2utf8(text), con, useBytes = TRUE) } # Deparse two values with full precision, split on ", " for token-level diff deparse_diff = function(x, y, max_diff = 50L) { dx = one_string(deparse(x, width.cutoff = 500L, control = 'all'), ' ') dy = one_string(deparse(y, width.cutoff = 500L, control = 'all'), ' ') if (identical(dx, dy)) return() tx = trimws(strsplit(dx, ', ')[[1]]) ty = trimws(strsplit(dy, ', ')[[1]]) mini_diff(tx, ty, max_diff) } # parse command-line args for test_pkg() defaults (--filter=PATTERN, --update) parse_args = function(args = commandArgs(TRUE)) { filter = NULL update = NA for (a in args) { if (starts_with(a, '--filter=')) filter = sub('^--filter=', '', a) else if (a == '--update') update = TRUE } list(filter = filter, update = update) } # Output a minimal diff between two character vectors, showing only lines that # are different and 3 lines of context around them. Lines starting with " " are # unchanged, "-" are in x1 but not x2, "+" are in x2 but not x1. When max_diff # is finite, bail out after that many diff lines are found (returns NULL). mini_diff = function(x1, x2, max_diff = Inf) { out = character() n_diff = 0L i = 1; j = 1 n1 = length(x1); n2 = length(x2) # 1. Alignment Loop while (i <= n1 || j <= n2) { if (i <= n1 && j <= n2 && x1[i] == x2[j]) { out = c(out, paste(" ", x1[i])); i = i + 1; j = j + 1 } else { m_i = if (i <= n1 && j <= n2) match(x2[j], x1[i:n1]) else NA m_j = if (i <= n1 && j <= n2) match(x1[i], x2[j:n2]) else NA if (!is.na(m_i) && (is.na(m_j) || m_i <= m_j)) { out = c(out, paste("-", x1[i])); i = i + 1; n_diff = n_diff + 1L } else if (!is.na(m_j)) { out = c(out, paste("+", x2[j])); j = j + 1; n_diff = n_diff + 1L } else { if (i <= n1) { out = c(out, paste("-", x1[i])); i = i + 1; n_diff = n_diff + 1L } if (j <= n2) { out = c(out, paste("+", x2[j])); j = j + 1; n_diff = n_diff + 1L } } if (n_diff >= max_diff) break } } # 2. Context Filtering (Keep 3 lines around any change) if (length(out) > 0) { change_idx = grep("^[-+]", out) # Identify indices within 3 steps of a change keep_idx = unique(as.integer(outer(change_idx, -3:3, "+"))) keep_idx = sort(keep_idx[keep_idx > 0 & keep_idx <= length(out)]) # Build output with "..." where gaps occur lines = character() last_idx = 0 for (idx in keep_idx) { if (idx > last_idx + 1) lines = c(lines, ' ...') lines = c(lines, out[idx]) last_idx = idx } lines } } testit/R/testit.R0000644000176200001440000003676315200767220013446 0ustar liggesusers#' Assert that conditions are true, with an informative failure message #' #' Test that one or more conditions are `TRUE`. If any condition fails, an error #' is raised with the `fact` message, making it easy to identify which test #' failed and why. This is the primary function for writing tests with #' **testit**. #' #' The recommended usage is to pass a single expression wrapped in `{}` as the #' second argument. Inside `{}`, any **statement-level** sub-expression wrapped #' in parentheses `()` is treated as a test condition -- its value is checked #' and must be `TRUE`. Parentheses used for grouping within a larger expression #' (e.g., `(a + b) * c`) are not checked. Sub-expressions *without* parentheses #' are ordinary R code (e.g., variable assignments or setup steps) and are never #' checked. #' #' `()` tests work inside `if`, `for`, `while`, and `repeat` bodies. Internally, #' `assert()` walks the expression tree and transforms statement-level `()` into #' checks before evaluating the entire block in one frame (so `on.exit()` works #' as expected). #' @param fact A character string describing what is being tested. This message #' is shown when an assertion fails, so make it descriptive (e.g., `'log() #' returns correct values'`). If `fact` is not a character string, it is #' treated as a test expression (i.e., the message is optional). #' @param ... An R expression wrapped in `{}`; see Details. #' @return Invisible `NULL` if all conditions pass. If any condition fails, an #' error is signaled that includes the `fact` message and the expression that #' failed. For `%==%`, `TRUE` or `FALSE`. #' @note Key differences from [stopifnot()]: #' #' - `assert()` shows your custom `fact` message on failure, making errors #' easier to diagnose. #' - `logical(0)` (empty logical) is treated as a failure, not a pass. #' - All conditions are evaluated even if earlier ones fail; all failures are #' reported together in a single error message. #' @export #' @examples #' library(testit) #' assert('T is bad for TRUE, and so is F for FALSE', { #' T = FALSE; F = TRUE #' (T != TRUE) # note the parentheses #' (F != FALSE) #' }) #' #' assert('A Poisson random number is non-negative', { #' x = rpois(1, 10) #' (x >= 0) #' (x > -1) #' }) #' #' # () works inside control structures too #' assert('conditional test', { #' if (requireNamespace('base', quietly = TRUE)) (1 + 1 == 2) #' }) assert = function(fact, ...) { opt = options(testit.asserting = TRUE); on.exit(options(opt), add = TRUE) mc = match.call() msg = if (is.character(fact)) { mc = mc[-2]; fact } one = length(mc) == 2 && length(mc[[2]]) >= 1 && identical(mc[[c(2, 1)]], as.symbol('{')) expr = if (one) mc[[2]] else as.call(c(list(as.symbol('{')), lapply(as.list(mc[-1]), function(x) call('(', x)))) assert_exec(msg, transform_assert(expr), parent.frame()) } # indices of body sub-expressions for each control-flow construct .assert_body_idx = list('if' = 3:4, 'for' = 4L, 'while' = 3L, 'repeat' = 2L) # walk AST to replace statement-level ( with .testit_check transform_assert = function(expr) { if (!is.call(expr)) return(expr) head = expr[[1]] if (identical(head, as.symbol('('))) { expr[[1]] = as.symbol('.testit_check') } else if (identical(head, as.symbol('{'))) { for (i in seq_along(expr)[-1]) expr[[i]] = transform_assert(expr[[i]]) } else if (is.symbol(head)) { for (i in intersect(.assert_body_idx[[as.character(head)]], seq_along(expr))) expr[[i]] = transform_assert(expr[[i]]) } expr } assert_exec = function(fact, expr, envir) { errs = NULL .env$equ_info = NULL on.exit(.env$equ_info <- NULL, add = TRUE) e = new.env(parent = envir) e[['.testit_check']] = function(val) { if (!all_true(val)) { sc = sys.call() ec = sc[[2]] info = if (length(.env$equ_info)) one_string(.env$equ_info) sr = attr(sc, 'srcref') loc = if (!is.null(sr)) error_loc(attr(sr, 'srcfile')$filename, sr[1]) errs <<- c(errs, paste0(one_string(c(info, sprintf( ngettext(length(val), '%s is not TRUE', '%s are not all TRUE'), deparse_key(ec) ))), ' but ', deparse_one(val), loc)) } .env$equ_info = NULL val } eval(expr, envir = e) if (length(errs)) { header = if (!is.null(fact)) paste0('-- Assertion failed: ', fact, ' --') else '-- Assertion failed --' n = length(errs) body = if (n == 1) paste0(' ', strsplit(errs, '\n')[[1]]) else { pad = nchar(n) + 5L vapply(seq_along(errs), function(i) { lines = strsplit(errs[i], '\n')[[1]] lines[-1] = paste0(one_string(rep(' ', pad), ''), lines[-1]) paste0(' ', sprintf(paste0('%', nchar(n), 'd'), i), '. ', one_string(lines)) }, '') } stop_errs(one_string(c(header, body)), check = FALSE) } } #' @description The infix operator `%==%` is a shortcut for [identical()] that #' provides helpful diagnostics on failure. `x %==% y` returns `TRUE` if `x` #' and `y` are identical, and `FALSE` otherwise. When used inside `assert()`, #' a failing `%==%` comparison will display both values via [str()] so you can #' see exactly what differed. #' @param x,y Two R objects to be compared for identity. #' @rdname assert #' @import utils #' @export `%==%` = function(x, y) { res = identical(x, y) if (!res && getOption('testit.asserting', FALSE)) { mc = match.call() sx = capture.output(str(x)); sy = capture.output(str(y)) nx = length(sx); ny = length(sy) dx = deparse_key(mc[[2]]); dy = deparse_key(mc[[3]]) show_diff = (nx + ny > 10L) && length(d <- mini_diff(sx, sy, 50L)) info = one_string(if (show_diff) { c('Structure diff:', paste(dx, '(- LHS) vs', dy, '(+ RHS):'), d) } else { sx = trunc_vec(sx, 10L, nx); sy = trunc_vec(sy, 10L, ny) c(paste(dx, '(LHS) ==>'), sx, '----------', sy, paste('<== (RHS)', dy)) }) # show deparse diff only when str() is uninformative (identical for both) if (identical(sx, sy)) { diff = deparse_diff(x, y) if (length(diff)) info = one_string(c(info, '', 'Detailed diff (- LHS, + RHS):', diff)) } .env$equ_info = c(.env$equ_info, info) } res } trunc_vec = function(x, n, N) if (N > n) c(head(x, n), '...') else x #' Run all tests for a package #' #' Discover and execute test files (`test-*.R` and `test-*.md`) for a package. #' Tests are run inside the package namespace, so you can call internal #' (non-exported) functions directly without the `:::` operator. #' #' Test files are looked up in the `testit/` or `tests/testit/` directory by #' default. Files must be named `test-*.R` for regular tests or `test-*.md` for #' snapshot tests. Other files in the directory are ignored (but you can #' [source()] them from your tests if needed). #' #' Helper files named `helper*.R` (e.g., `helper.R`, `helper-utils.R`) are #' sourced before any test file runs. Objects defined in helpers are available #' to all tests. #' #' Each test file runs in a clean environment (previous test objects are #' removed), and the working directory is set to the directory containing the #' test file. #' #' See for more details about #' snapshot testing. #' @param package The package name. By default, it is detected from the #' `DESCRIPTION` file. #' @param dir The directory containing test files. If `NULL` (the default), #' `testit/` or `tests/testit/` under the current working directory is used #' (whichever exists). You can also pass a custom path. #' @param filter An optional regular expression to select a subset of test #' files. Only files whose names match the pattern will be run. For example, #' `filter = "plot"` runs only test files with "plot" in their names. #' @param update Controls snapshot file behavior: #' - `TRUE`: always update snapshot files with actual output (never errors). #' - `NA` (default): update only if the file is tracked by Git (so you can #' review diffs before accepting). #' - `FALSE`: never update; always compare and error on mismatch. #' @return Invisible `NULL`. If any tests fail, a single error is thrown at the #' end with all failure messages combined. #' @note You must call `library(testit)` before `test_pkg()`. Test scripts use #' [assert()] and other **testit** functions without the `testit::` prefix, so #' the package needs to be on the search path. Without `library(testit)`, you #' will get "could not find function" errors. #' #' All test scripts must be encoded in UTF-8 if they contain multibyte #' characters. #' #' When `filter` or `update` are not explicitly provided, `test_pkg()` checks #' `commandArgs(TRUE)` for command-line arguments: `--filter=PATTERN` sets the #' filter, and `--update` sets `update = TRUE`. This allows you to pass these #' options via `Rscript tests/*.R --filter=PATTERN --update` without modifying #' individual `test_pkg()` calls. #' @export #' @examples #' \dontrun{ #' library(testit) #' test_pkg('testit') #' } test_pkg = function(package = pkg_name(), dir = NULL, filter = NULL, update = NA) { args = parse_args() if (missing(filter)) filter = args$filter if (missing(update)) update = args$update # install the source package before running tests when this function is called # in a non-interactive R session that is not `R CMD check` pkg_root = if (file.exists('DESCRIPTION')) '.' else if (file.exists('../DESCRIPTION')) '..' install = !interactive() && is.na(Sys.getenv('_R_CHECK_PACKAGE_NAME_', NA)) && !is.null(pkg_root) && package == pkg_name() && pkg_needs_install(pkg_root, package) if (install) { .env$lib_old = lib_old = .libPaths() dir.create(lib_new <- tempfile('R-lib-')) .env$lib_new = norm_path(lib_new) message( "Installing '", package, "' to ", short_temp(lib_new), ' for testing... ', appendLF = FALSE ) res = system2( file.path(R.home('bin'), 'R'), c( 'CMD', 'INSTALL', paste0('--library=', lib_new), '--no-help', '--no-staged-install', '--no-test-load', pkg_root ), stdout = FALSE, stderr = FALSE ) message(if (res == 0) { .libPaths(c(lib_new, lib_old)) if (!is.na(i <- match(paste0('package:', package), search()))) detach(pos = i, unload = TRUE, force = TRUE) 'Done.' } else 'Failed.') } if (is.null(dir)) dir = c('testit', 'tests/testit') if (identical(pkg_root, '.')) dir = c(dir, file.path('tests', dir)) path = available_dir(dir) td = paste0(norm_path(getwd()), '/') op = options(testit.test_dir = td); on.exit(options(op), add = TRUE) fs = list.files(path, full.names = TRUE) # clean up new files/dirs generated during testing if (getOption('testit.cleanup', TRUE)) on.exit({ unlink(setdiff(list.files(path, full.names = TRUE), fs), recursive = TRUE) }, add = TRUE) rs = fs[grep('^test-.+[.][rR]$', basename(fs))] ms = fs[grep('^test-.+[.]md$', basename(fs))] if (!is.null(filter)) { rs = rs[grep(filter, basename(rs))] ms = ms[grep(filter, basename(ms))] } hs = fs[grep('^helper.*[.][rR]$', basename(fs))] # source helpers into a dedicated environment; tests inherit from it ns = getNamespace(package) henv = new.env(parent = ns) env = new.env(parent = henv) errs = NULL # run each file, print the relative path, and collect error messages run_files = function(files, helper = FALSE, snap = FALSE) for (f in files) { if (!helper) { message('Testing ', sub(td, '', f, fixed = TRUE), '... ', appendLF = FALSE) rm(list = ls(env, all.names = TRUE), envir = env) } err = if (snap) test_snap(f, env, update) else quietly(sys.source2(f, envir = if (helper) henv else env, top.env = ns)) if (!helper) message(if (length(err) == 0) 'OK' else 'FAILED') errs <<- c(errs, err) } # run helper scripts run_files(hs, TRUE); stop_errs(errs) # run test scripts and snapshots run_files(rs); run_files(ms, snap = TRUE); stop_errs(errs) } # evaluate expr; on error, append source location to the error message and re-throw loc_stop = function(expr) { loc = NULL tryCatch(withCallingHandlers(expr, error = function(e) { if (!exists('.traceback', baseenv(), inherits = FALSE)) return() for (skip in 0:20) { z = .traceback(skip) if (length(z) == 0) break sr = attr(z[[1]], 'srcref') if (!is.null(sr)) { loc <<- error_loc(attr(sr, 'srcfile')$filename, sr[1]) break } } }), error = function(e) { msg = conditionMessage(e) if (!is.null(loc) && !grepl(' at .+#\\d+', msg)) msg = paste0(msg, loc) stop(msg, call. = FALSE) }) } # add ANSI link on file path if supported error_loc = function(x, line = 1) { if (!length(x)) return() if (!file.exists(x)) return(sprintf(' at %s#%d', x, line)) full = norm_path(x) d = getOption('testit.test_dir') n = nchar(d) rel = if (!is.null(d) && starts_with(full, d)) substring(full, n + 1) else full if (!isTRUE(as.logical(Sys.getenv('RSTUDIO_CLI_HYPERLINKS')))) return(sprintf(' at %s#%d', rel, line)) sprintf(' at \033]8;line = %d:col = 1;file://%s\a%s#%d\033]8;;\a', line, full, rel, line) } #' Test whether an expression signals a condition #' #' Check if evaluating an expression produces a message, warning, or error. #' These functions are designed to be used inside [assert()] to verify that code #' signals the expected conditions. Optionally, you can match against the #' condition's text to ensure the *right* message/warning/error was signaled. #' @param expr An R expression to evaluate. #' @param message An optional string to match against the condition text. Uses #' fixed (literal) matching by default. If provided, the function returns #' `TRUE` only when the condition is signaled *and* the message matches. #' @param ... Additional arguments passed to [grepl()] for matching (e.g., #' `fixed = FALSE` to use regex, or `ignore.case = TRUE`). Note that #' `fixed = TRUE` is the default. #' @return `TRUE` if the condition was signaled (and the message matched, if #' provided), `FALSE` otherwise. #' @export #' @rdname has_message #' @examples #' has_message(message('hello')) #' has_message(1 + 1) #' has_message(message('hello world'), 'hello') #' #' has_warning(1 + 1) #' has_warning(1:2 + 1:3) #' has_warning(1:2 + 1:3, 'longer object length') #' #' has_error(2 - 3) #' has_error(1 + 'a') #' has_error(stop('err'), 'err') #' has_error(stop('error occurred'), 'error') has_message = function(expr, message = NULL, ...) { msg_text = NULL withCallingHandlers(expr, message = function(m) { msg_text <<- paste0(c(msg_text, conditionMessage(m)), collapse = '') invokeRestart('muffleMessage') }) match_cond(msg_text, message, ...) } #' @export #' @rdname has_message has_warning = function(expr, message = NULL, ...) { warn_text = NULL op = options(warn = -1); on.exit(options(op)) withCallingHandlers(expr, warning = function(w) { warn_text <<- paste0(c(warn_text, conditionMessage(w)), collapse = '') invokeRestart('muffleWarning') }) match_cond(warn_text, message, ...) } #' @export #' @rdname has_message has_error = function(expr, message = NULL, ...) { tryCatch({ expr; FALSE }, error = function(e) { match_cond(conditionMessage(e), message, ...) }) } match_cond = function(text, message, ...) { if (is.null(text)) FALSE else if (is.null(message)) TRUE else grepl2(message, text, ...) } grepl2 = function(..., fixed = TRUE, ignore.case = FALSE) { if (ignore.case && fixed) fixed = FALSE grepl(..., fixed = fixed, ignore.case = ignore.case) } quietly = function(expr) { withCallingHandlers( expr, message = function(m) invokeRestart('muffleMessage'), warning = function(w) invokeRestart('muffleWarning') ) } testit/NAMESPACE0000644000176200001440000000024515176765564013034 0ustar liggesusers# Generated by roxygen2: do not edit by hand export("%==%") export(assert) export(has_error) export(has_message) export(has_warning) export(test_pkg) import(utils) testit/LICENSE0000644000176200001440000000005415145770737012612 0ustar liggesusersYEAR: 2013-2026 COPYRIGHT HOLDER: Yihui Xie testit/inst/0000755000176200001440000000000014477352571012562 5ustar liggesuserstestit/inst/rstudio/0000755000176200001440000000000014477352571014253 5ustar liggesuserstestit/inst/rstudio/addins.dcf0000644000176200001440000000017012660730065016157 0ustar liggesusersName: Insert %==% Description: Insert the infix operator %==% from testit. Binding: insert_identical Interactive: false testit/inst/NEWS.Rd0000644000176200001440000000043414035566656013627 0ustar liggesusers\name{NEWS} \title{News for Package 'testit'} \section{CHANGES IN testit VERSION 999.999}{ \itemize{ \item This NEWS file is only a placeholder. The version 999.999 does not really exist. Please read the NEWS on Github: \url{https://github.com/yihui/testit/releases} } } testit/man/0000755000176200001440000000000015200762273012345 5ustar liggesuserstestit/man/has_message.Rd0000644000176200001440000000307715200762273015122 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/testit.R \name{has_message} \alias{has_message} \alias{has_warning} \alias{has_error} \title{Test whether an expression signals a condition} \usage{ has_message(expr, message = NULL, ...) has_warning(expr, message = NULL, ...) has_error(expr, message = NULL, ...) } \arguments{ \item{expr}{An R expression to evaluate.} \item{message}{An optional string to match against the condition text. Uses fixed (literal) matching by default. If provided, the function returns \code{TRUE} only when the condition is signaled \emph{and} the message matches.} \item{...}{Additional arguments passed to \code{\link[=grepl]{grepl()}} for matching (e.g., \code{fixed = FALSE} to use regex, or \code{ignore.case = TRUE}). Note that \code{fixed = TRUE} is the default.} } \value{ \code{TRUE} if the condition was signaled (and the message matched, if provided), \code{FALSE} otherwise. } \description{ Check if evaluating an expression produces a message, warning, or error. These functions are designed to be used inside \code{\link[=assert]{assert()}} to verify that code signals the expected conditions. Optionally, you can match against the condition's text to ensure the \emph{right} message/warning/error was signaled. } \examples{ has_message(message('hello')) has_message(1 + 1) has_message(message('hello world'), 'hello') has_warning(1 + 1) has_warning(1:2 + 1:3) has_warning(1:2 + 1:3, 'longer object length') has_error(2 - 3) has_error(1 + 'a') has_error(stop('err'), 'err') has_error(stop('error occurred'), 'error') } testit/man/test_pkg.Rd0000644000176200001440000000577015200762273014465 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/testit.R \name{test_pkg} \alias{test_pkg} \title{Run all tests for a package} \usage{ test_pkg(package = pkg_name(), dir = NULL, filter = NULL, update = NA) } \arguments{ \item{package}{The package name. By default, it is detected from the \code{DESCRIPTION} file.} \item{dir}{The directory containing test files. If \code{NULL} (the default), \verb{testit/} or \verb{tests/testit/} under the current working directory is used (whichever exists). You can also pass a custom path.} \item{filter}{An optional regular expression to select a subset of test files. Only files whose names match the pattern will be run. For example, \code{filter = "plot"} runs only test files with "plot" in their names.} \item{update}{Controls snapshot file behavior: \itemize{ \item \code{TRUE}: always update snapshot files with actual output (never errors). \item \code{NA} (default): update only if the file is tracked by Git (so you can review diffs before accepting). \item \code{FALSE}: never update; always compare and error on mismatch. }} } \value{ Invisible \code{NULL}. If any tests fail, a single error is thrown at the end with all failure messages combined. } \description{ Discover and execute test files (\verb{test-*.R} and \verb{test-*.md}) for a package. Tests are run inside the package namespace, so you can call internal (non-exported) functions directly without the \code{:::} operator. } \details{ Test files are looked up in the \verb{testit/} or \verb{tests/testit/} directory by default. Files must be named \verb{test-*.R} for regular tests or \verb{test-*.md} for snapshot tests. Other files in the directory are ignored (but you can \code{\link[=source]{source()}} them from your tests if needed). Helper files named \code{helper*.R} (e.g., \code{helper.R}, \code{helper-utils.R}) are sourced before any test file runs. Objects defined in helpers are available to all tests. Each test file runs in a clean environment (previous test objects are removed), and the working directory is set to the directory containing the test file. See \url{https://pkg.yihui.org/testit/#snapshot-testing} for more details about snapshot testing. } \note{ You must call \code{library(testit)} before \code{test_pkg()}. Test scripts use \code{\link[=assert]{assert()}} and other \strong{testit} functions without the \verb{testit::} prefix, so the package needs to be on the search path. Without \code{library(testit)}, you will get "could not find function" errors. All test scripts must be encoded in UTF-8 if they contain multibyte characters. When \code{filter} or \code{update} are not explicitly provided, \code{test_pkg()} checks \code{commandArgs(TRUE)} for command-line arguments: \code{--filter=PATTERN} sets the filter, and \code{--update} sets \code{update = TRUE}. This allows you to pass these options via \verb{Rscript tests/*.R --filter=PATTERN --update} without modifying individual \code{test_pkg()} calls. } \examples{ \dontrun{ library(testit) test_pkg('testit') } } testit/man/assert.Rd0000644000176200001440000000611015200762273014133 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/testit.R \name{assert} \alias{assert} \alias{\%==\%} \title{Assert that conditions are true, with an informative failure message} \usage{ assert(fact, ...) x \%==\% y } \arguments{ \item{fact}{A character string describing what is being tested. This message is shown when an assertion fails, so make it descriptive (e.g., \code{'log() returns correct values'}). If \code{fact} is not a character string, it is treated as a test expression (i.e., the message is optional).} \item{...}{An R expression wrapped in \code{{}}; see Details.} \item{x, y}{Two R objects to be compared for identity.} } \value{ Invisible \code{NULL} if all conditions pass. If any condition fails, an error is signaled that includes the \code{fact} message and the expression that failed. For \verb{\%==\%}, \code{TRUE} or \code{FALSE}. } \description{ Test that one or more conditions are \code{TRUE}. If any condition fails, an error is raised with the \code{fact} message, making it easy to identify which test failed and why. This is the primary function for writing tests with \strong{testit}. The infix operator \verb{\%==\%} is a shortcut for \code{\link[=identical]{identical()}} that provides helpful diagnostics on failure. \code{x \%==\% y} returns \code{TRUE} if \code{x} and \code{y} are identical, and \code{FALSE} otherwise. When used inside \code{assert()}, a failing \verb{\%==\%} comparison will display both values via \code{\link[=str]{str()}} so you can see exactly what differed. } \details{ The recommended usage is to pass a single expression wrapped in \code{{}} as the second argument. Inside \code{{}}, any \strong{statement-level} sub-expression wrapped in parentheses \verb{()} is treated as a test condition -- its value is checked and must be \code{TRUE}. Parentheses used for grouping within a larger expression (e.g., \code{(a + b) * c}) are not checked. Sub-expressions \emph{without} parentheses are ordinary R code (e.g., variable assignments or setup steps) and are never checked. \verb{()} tests work inside \code{if}, \code{for}, \code{while}, and \code{repeat} bodies. Internally, \code{assert()} walks the expression tree and transforms statement-level \verb{()} into checks before evaluating the entire block in one frame (so \code{on.exit()} works as expected). } \note{ Key differences from \code{\link[=stopifnot]{stopifnot()}}: \itemize{ \item \code{assert()} shows your custom \code{fact} message on failure, making errors easier to diagnose. \item \code{logical(0)} (empty logical) is treated as a failure, not a pass. \item All conditions are evaluated even if earlier ones fail; all failures are reported together in a single error message. } } \examples{ library(testit) assert('T is bad for TRUE, and so is F for FALSE', { T = FALSE; F = TRUE (T != TRUE) # note the parentheses (F != FALSE) }) assert('A Poisson random number is non-negative', { x = rpois(1, 10) (x >= 0) (x > -1) }) # () works inside control structures too assert('conditional test', { if (requireNamespace('base', quietly = TRUE)) (1 + 1 == 2) }) } testit/DESCRIPTION0000644000176200001440000000241715201003667013300 0ustar liggesusersPackage: testit Type: Package Title: A Simple Package for Testing R Packages Version: 1.0 Authors@R: c( person("Yihui", "Xie", role = c("aut", "cre"), email = "xie@yihui.name", comment = c(ORCID = "0000-0003-0645-5666", URL = "https://yihui.org")), person("Tomas", "Kalibera", role = "ctb"), person("Steven", "Mortimer", role = "ctb", email="reportmort@gmail.com") ) Description: A minimal, dependency-free testing framework for R packages. Write tests as simple R expressions that return TRUE, using assert() for assertions (with informative error messages on failure), has_error() / has_warning() / has_message() for testing conditions, and test_pkg() to run all tests with full access to internal (non-exported) package functions. Snapshot testing via Markdown files is also supported. License: MIT + file LICENSE URL: https://github.com/yihui/testit BugReports: https://github.com/yihui/testit/issues Encoding: UTF-8 Config/roxygen2/version: 8.0.0 NeedsCompilation: no Packaged: 2026-05-13 03:30:46 UTC; yihui Author: Yihui Xie [aut, cre] (ORCID: , URL: https://yihui.org), Tomas Kalibera [ctb], Steven Mortimer [ctb] Maintainer: Yihui Xie Repository: CRAN Date/Publication: 2026-05-13 05:10:15 UTC