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:
parent
b6d2b1398d
commit
3396236eef
@ -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)
|
||||||
|
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!)*
|
*(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.
|
#' # 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) &&
|
|
||||||
|
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
|
# be sure not to run kable in pkgdown for our website generation
|
||||||
!identical(Sys.getenv("IN_PKGDOWN"), "true")) {
|
!identical(Sys.getenv("IN_PKGDOWN"), "true")) {
|
||||||
stop_ifnot_installed("knitr")
|
|
||||||
kable <- import_fn("kable", "knitr", error_on_fail = 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"]
|
||||||
|
@ -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)
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
}
|
||||||
|
@ -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"),
|
||||||
|
Loading…
Reference in New Issue
Block a user