1
0
mirror of https://github.com/msberends/AMR.git synced 2025-07-08 23:21:56 +02:00

(v1.7.1.9065) unit tests

This commit is contained in:
2021-12-11 15:13:44 +01:00
parent 77ba4318ea
commit e0a2634f14
7 changed files with 24 additions and 21 deletions

View File

@ -912,17 +912,18 @@ unique_call_id <- function(entire_session = FALSE, match_fn = NULL) {
# combination of environment ID (such as "0x7fed4ee8c848")
# and relevant system call (where 'match_fn' is being called in)
calls <- sys.calls()
int <- which(vapply(FUN.VALUE = logical(1),
calls,
function(call, fun = match_fn) {
call_clean <- gsub("[^a-zA-Z0-9_().-]", "", as.character(call), perl = TRUE)
any(call_clean %like% paste0(fun, "\\("), na.rm = TRUE)
}))[1L]
if (is.na(int)) {
int <- 1
if (!identical(Sys.getenv("R_RUN_TINYTEST"), "true") &&
!any(as.character(calls[[1]]) %like_case% "run_test_dir|run_test_file|test_all|tinytest|test_package|testthat")) {
for (i in seq_len(length(calls))) {
call_clean <- gsub("[^a-zA-Z0-9_().-]", "", as.character(calls[[i]]), perl = TRUE)
if (any(call_clean %like% paste0(match_fn, "\\("), na.rm = TRUE)) {
return(c(envir = gsub("<environment: (.*)>", "\\1", utils::capture.output(sys.frames()[[1]]), perl = TRUE),
call = paste0(deparse(calls[[i]]), collapse = "")))
}
}
}
c(envir = gsub("<environment: (.*)>", "\\1", utils::capture.output(sys.frames()[[1]]), perl = TRUE),
call = paste0(deparse(calls[[int]]), collapse = ""))
c(envir = paste0(sample(c(c(0:9), letters[1:6]), size = 32, replace = TRUE), collapse = ""),
call = paste0(sample(c(c(0:9), letters[1:6]), size = 32, replace = TRUE), collapse = ""))
}
#' @noRd