R Under development (unstable) (2024-02-08 r85876 ucrt) -- "Unsuffered Consequences"
Copyright (C) 2024 The R Foundation for Statistical Computing
Platform: x86_64-w64-mingw32/x64

R is free software and comes with ABSOLUTELY NO WARRANTY.
You are welcome to redistribute it under certain conditions.
Type 'license()' or 'licence()' for distribution details.

R is a collaborative project with many contributors.
Type 'contributors()' for more information and
'citation()' on how to cite R or R packages in publications.

Type 'demo()' for some demos, 'help()' for on-line help, or
'help.start()' for an HTML browser interface to help.
Type 'q()' to quit R.

> expect_equal <- function(x, y, attributes = TRUE) {
+   if (is.data.frame(x) && !attributes) 
+     return(expect_equal_data.frame(x, y, attributes))
+   if (!attributes) attributes(x) <- NULL
+   if (!attributes) attributes(y) <- NULL
+   stopifnot(isTRUE(all.equal(x, y)))
+ }
> 
> expect_equal_data.frame <- function(x, y, attributes = TRUE) {
+   if (!attributes) {
+     expect_equal(class(x), class(y))
+     expect_equal(names(x), names(y))
+     for (col in names(x)) 
+       expect_equal(x[[col]], y[[col]], attributes = FALSE)
+   } else expect_equal(x, y, attributes)
+ }
> 
> expect_attribute <- function(x, name, value) {
+   v <- attr(x, name)
+   stopifnot(!is.null(v))
+   expect_equal(v, value)
+ }
> 
> expect_error <- function(expr) {
+   expect_error.error <- TRUE
+   try({
+     expr
+     expect_error.error <- FALSE
+   }, silent = TRUE)
+   if (!expect_error.error) stop("Expression did not throw an error.")
+ }
> 
> expect_warning <- function(expr) {
+   messages <- list()
+   warnings <- list()  
+   errors   <- list()
+   #tryCatch(
+     withCallingHandlers(
+       expr, 
+       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))
+   #)
+   stopifnot(length(warnings) > 0)
+ }
>  
> 
> proc.time()
   user  system elapsed 
   0.18    0.06    0.21