mirror of
https://github.com/msberends/AMR.git
synced 2024-12-25 08:06:12 +01:00
unit test fixes
This commit is contained in:
parent
b6d2b1398d
commit
3396236eef
@ -1,5 +1,5 @@
|
||||
Package: AMR
|
||||
Version: 1.8.2.9122
|
||||
Version: 1.8.2.9123
|
||||
Date: 2023-02-13
|
||||
Title: Antimicrobial Resistance Data Analysis
|
||||
Description: Functions to simplify and standardise antimicrobial resistance (AMR)
|
||||
|
2
NEWS.md
2
NEWS.md
@ -1,4 +1,4 @@
|
||||
# AMR 1.8.2.9122
|
||||
# AMR 1.8.2.9123
|
||||
|
||||
*(this beta version will eventually become v2.0! We're happy to reach a new major milestone soon!)*
|
||||
|
||||
|
@ -136,7 +136,7 @@
|
||||
#' # run ?example_isolates for more info.
|
||||
#' example_isolates
|
||||
#'
|
||||
#'
|
||||
#' \donttest{
|
||||
#' # Traditional antibiogram ----------------------------------------------
|
||||
#'
|
||||
#' antibiogram(example_isolates,
|
||||
@ -232,6 +232,7 @@
|
||||
#' if (requireNamespace("ggplot2")) {
|
||||
#' ggplot2::autoplot(ab2)
|
||||
#' }
|
||||
#' }
|
||||
antibiogram <- function(x,
|
||||
antibiotics = where(is.sir),
|
||||
mo_transform = "shortname",
|
||||
@ -543,12 +544,14 @@ autoplot.antibiogram <- function(object, ...) {
|
||||
#' @rdname antibiogram
|
||||
print.antibiogram <- function(x, as_kable = !interactive(), ...) {
|
||||
meet_criteria(as_kable, allow_class = "logical", has_length = 1)
|
||||
if (isTRUE(as_kable) &&
|
||||
|
||||
kable <- import_fn("kable", "knitr", error_on_fail = FALSE)
|
||||
if (!is.null(kable) &&
|
||||
isTRUE(as_kable) &&
|
||||
# be sure not to run kable in pkgdown for our website generation
|
||||
!identical(Sys.getenv("IN_PKGDOWN"), "true")) {
|
||||
stop_ifnot_installed("knitr")
|
||||
kable <- import_fn("kable", "knitr", error_on_fail = TRUE)
|
||||
kable(x, ...)
|
||||
|
||||
} else {
|
||||
# remove 'antibiogram' class and print with default method
|
||||
class(x) <- class(x)[class(x) != "antibiogram"]
|
||||
|
@ -153,7 +153,7 @@ Printing the antibiogram in non-interactive sessions will be done by \code{\link
|
||||
# run ?example_isolates for more info.
|
||||
example_isolates
|
||||
|
||||
|
||||
\donttest{
|
||||
# Traditional antibiogram ----------------------------------------------
|
||||
|
||||
antibiogram(example_isolates,
|
||||
@ -250,3 +250,4 @@ if (requireNamespace("ggplot2")) {
|
||||
ggplot2::autoplot(ab2)
|
||||
}
|
||||
}
|
||||
}
|
||||
|
@ -64,6 +64,64 @@ if (tryCatch(isTRUE(AMR:::import_fn("isJob", "rstudioapi")()), error = function(
|
||||
if (getRversion() < "4.0.0") {
|
||||
deparse1 <- AMR:::deparse1
|
||||
}
|
||||
|
||||
# temporary fix for tinytest, https://github.com/markvanderloo/tinytest/pull/114
|
||||
expect_warning <- function (current, pattern = ".*", class = "warning", info = NA_character_, ...) {
|
||||
messages <- list()
|
||||
warnings <- list()
|
||||
errors <- list()
|
||||
tryCatch(withCallingHandlers(current, warning = function(w) {
|
||||
warnings <<- append(warnings, list(w))
|
||||
invokeRestart("muffleWarning")
|
||||
}, message = function(m) {
|
||||
messages <<- append(messages, list(m))
|
||||
invokeRestart("muffleMessage")
|
||||
}), error = function(e) errors <<- append(errors, list(e)))
|
||||
nmsg <- length(messages)
|
||||
nwrn <- length(warnings)
|
||||
nerr <- length(errors)
|
||||
results <- sapply(warnings, function(w) {
|
||||
inherits(w, class) && any(grepl(pattern, w$message, ...), na.rm = TRUE)
|
||||
})
|
||||
if (any(results)) {
|
||||
result <- TRUE
|
||||
short <- diff <- NA_character_
|
||||
}
|
||||
else {
|
||||
result <- FALSE
|
||||
short <- "xcpt"
|
||||
diff <- if (nwrn == 0) {
|
||||
"No warning was emitted"
|
||||
}
|
||||
else {
|
||||
n_right_class <- sum(sapply(warnings, function(w) inherits(w,
|
||||
class)))
|
||||
if (n_right_class == 0) {
|
||||
head <- sprintf("Found %d warning(s), but not of class '%s'.",
|
||||
nwrn, class)
|
||||
head <- paste(head, "Showing up to three warnings:\n")
|
||||
body <- first_n(warnings)
|
||||
paste(head, body)
|
||||
}
|
||||
else {
|
||||
wrns <- Filter(function(w) inherits(w, class),
|
||||
warnings)
|
||||
head <- sprintf("Found %d warnings(s) of class '%s', but not matching '%s'.",
|
||||
nwrn, class, pattern)
|
||||
head <- paste(head, "\nShowing up to three warnings:\n")
|
||||
body <- first_n(wrns)
|
||||
paste(head, body)
|
||||
}
|
||||
}
|
||||
}
|
||||
if (!result && (nmsg > 0 || nerr > 0))
|
||||
diff <- paste0(diff, sprintf("\nAlso found %d message(s) and %d error(s)",
|
||||
nmsg, nerr))
|
||||
tinytest::tinytest(result, call = sys.call(sys.parent(1)), short = short,
|
||||
diff = diff, info = info)
|
||||
}
|
||||
|
||||
|
||||
# start the unit tests
|
||||
out <- test_package("AMR",
|
||||
testdir = ifelse(dir.exists("inst/tinytest"),
|
||||
|
Loading…
Reference in New Issue
Block a user