From 3396236eef3f2166448fa6f268d3f1f231657d96 Mon Sep 17 00:00:00 2001
From: "Matthijs S. Berends" <m.s.berends@umcg.nl>
Date: Mon, 13 Feb 2023 16:56:25 +0100
Subject: [PATCH] unit test fixes

---
 DESCRIPTION        |  2 +-
 NEWS.md            |  2 +-
 R/antibiogram.R    | 15 +++++++-----
 man/antibiogram.Rd |  3 ++-
 tests/tinytest.R   | 58 ++++++++++++++++++++++++++++++++++++++++++++++
 5 files changed, 71 insertions(+), 9 deletions(-)

diff --git a/DESCRIPTION b/DESCRIPTION
index 7f015583..309c3540 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -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)
diff --git a/NEWS.md b/NEWS.md
index 6dbd1b9a..2022f33b 100755
--- a/NEWS.md
+++ b/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!)*
 
diff --git a/R/antibiogram.R b/R/antibiogram.R
index f2bd4af2..2a021431 100755
--- a/R/antibiogram.R
+++ b/R/antibiogram.R
@@ -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) &&
-    # 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 <- 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")) {
     kable(x, ...)
+  
   } else {
     # remove 'antibiogram' class and print with default method
     class(x) <- class(x)[class(x) != "antibiogram"]
diff --git a/man/antibiogram.Rd b/man/antibiogram.Rd
index 310eddbc..d0eedd66 100644
--- a/man/antibiogram.Rd
+++ b/man/antibiogram.Rd
@@ -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)
 }
 }
+}
diff --git a/tests/tinytest.R b/tests/tinytest.R
index 01ef1c7f..35f88729 100644
--- a/tests/tinytest.R
+++ b/tests/tinytest.R
@@ -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"),