1
0
mirror of https://github.com/msberends/AMR.git synced 2024-12-25 20:06:12 +01:00

unit test fixes

This commit is contained in:
dr. M.S. (Matthijs) Berends 2023-02-13 16:56:25 +01:00
parent b6d2b1398d
commit 3396236eef
5 changed files with 71 additions and 9 deletions

View File

@ -1,5 +1,5 @@
Package: AMR Package: AMR
Version: 1.8.2.9122 Version: 1.8.2.9123
Date: 2023-02-13 Date: 2023-02-13
Title: Antimicrobial Resistance Data Analysis Title: Antimicrobial Resistance Data Analysis
Description: Functions to simplify and standardise antimicrobial resistance (AMR) Description: Functions to simplify and standardise antimicrobial resistance (AMR)

View File

@ -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!)* *(this beta version will eventually become v2.0! We're happy to reach a new major milestone soon!)*

View File

@ -136,7 +136,7 @@
#' # run ?example_isolates for more info. #' # run ?example_isolates for more info.
#' example_isolates #' example_isolates
#' #'
#' #' \donttest{
#' # Traditional antibiogram ---------------------------------------------- #' # Traditional antibiogram ----------------------------------------------
#' #'
#' antibiogram(example_isolates, #' antibiogram(example_isolates,
@ -232,6 +232,7 @@
#' if (requireNamespace("ggplot2")) { #' if (requireNamespace("ggplot2")) {
#' ggplot2::autoplot(ab2) #' ggplot2::autoplot(ab2)
#' } #' }
#' }
antibiogram <- function(x, antibiogram <- function(x,
antibiotics = where(is.sir), antibiotics = where(is.sir),
mo_transform = "shortname", mo_transform = "shortname",
@ -543,12 +544,14 @@ autoplot.antibiogram <- function(object, ...) {
#' @rdname antibiogram #' @rdname antibiogram
print.antibiogram <- function(x, as_kable = !interactive(), ...) { print.antibiogram <- function(x, as_kable = !interactive(), ...) {
meet_criteria(as_kable, allow_class = "logical", has_length = 1) meet_criteria(as_kable, allow_class = "logical", has_length = 1)
if (isTRUE(as_kable) &&
# be sure not to run kable in pkgdown for our website generation kable <- import_fn("kable", "knitr", error_on_fail = FALSE)
!identical(Sys.getenv("IN_PKGDOWN"), "true")) { if (!is.null(kable) &&
stop_ifnot_installed("knitr") isTRUE(as_kable) &&
kable <- import_fn("kable", "knitr", error_on_fail = TRUE) # be sure not to run kable in pkgdown for our website generation
!identical(Sys.getenv("IN_PKGDOWN"), "true")) {
kable(x, ...) kable(x, ...)
} else { } else {
# remove 'antibiogram' class and print with default method # remove 'antibiogram' class and print with default method
class(x) <- class(x)[class(x) != "antibiogram"] class(x) <- class(x)[class(x) != "antibiogram"]

View File

@ -153,7 +153,7 @@ Printing the antibiogram in non-interactive sessions will be done by \code{\link
# run ?example_isolates for more info. # run ?example_isolates for more info.
example_isolates example_isolates
\donttest{
# Traditional antibiogram ---------------------------------------------- # Traditional antibiogram ----------------------------------------------
antibiogram(example_isolates, antibiogram(example_isolates,
@ -250,3 +250,4 @@ if (requireNamespace("ggplot2")) {
ggplot2::autoplot(ab2) ggplot2::autoplot(ab2)
} }
} }
}

View File

@ -64,6 +64,64 @@ if (tryCatch(isTRUE(AMR:::import_fn("isJob", "rstudioapi")()), error = function(
if (getRversion() < "4.0.0") { if (getRversion() < "4.0.0") {
deparse1 <- AMR:::deparse1 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 # start the unit tests
out <- test_package("AMR", out <- test_package("AMR",
testdir = ifelse(dir.exists("inst/tinytest"), testdir = ifelse(dir.exists("inst/tinytest"),