snapshot test untested erroring code (closes #1231)

R/aaa-documentation-helper.R

@@ -1,3 +1,5 @@
+# nocov start
+
 # TODO:
 #  - catch errors and throw a warning visible to the user
 #  - warn when custom arg is taking precedence over something well-defined
@@ -140,3 +142,5 @@ return_augment <- function(...,
 
   do.call("return_evalrd", args)
 }
+
+# nocov end

R/fixest.R

@@ -119,9 +119,7 @@ augment.fixest <- function(
     df <- newdata
   }
   if (is.null(df)) {
-    cli::cli_abort(
-      "Must specify either a {.arg data} or {.arg newdata} argument."
-    )
+    data_error()
   }
   df <- as_augment_tibble(df)
   if (is.null(newdata)) {

R/stats-glm.R

@@ -155,9 +155,9 @@ glance.glm <- function(x, ...) {
   )
 }
 
-warn_on_appropriated_glm_class <- function(x) {
+warn_on_appropriated_glm_class <- function(x, call = caller_env()) {
   warn_on_glm2(x)
-  warn_on_stanreg(x)
+  warn_on_stanreg(x, call = call)
 
   invisible(TRUE)
 }

R/utilities.R

@@ -34,8 +34,6 @@ exponentiate <- function(data, col = "estimate") {
 #' @return A `tibble` potentially with a `.rownames` column
 #' @noRd
 #'
-
-
 as_augment_tibble <- function(data, arg = caller_arg(data), call = caller_env()) {
   if (inherits(data, "matrix") & is.null(colnames(data))) {
     cli::cli_abort(c(

tests/testthat/_snaps/data-frame.md

@@ -0,0 +1,9 @@
+# glance.tbl_df errors informatively
+
+    Code
+      glance.tbl_df(tibble::tibble(x = 1))
+    Condition
+      Error in `glance.tbl_df()`:
+      ! There is no glance method for tibbles.
+      i Did you mean `tibble::glimpse()`?
+

tests/testthat/_snaps/fixest.md

@@ -1,5 +1,14 @@
 # all other fixest estimators run
 
+    Code
+      augment(res_fenegbin)
+    Condition
+      Error in `augment()`:
+      ! augment is only supported for fixest models estimated with `feols()`, `feglm()`, or `femlm()`.
+      i Supplied model used `fenegbin()`.
+
+---
+
     Code
       augment(res_fenegbin, df)
     Condition

tests/testthat/_snaps/lfe.md

@@ -23,3 +23,12 @@
       Error in `augment()`:
       ! `felm()` models with multiple responses are not supported.
 
+# tidy.felm errors informatively
+
+    Code
+      .res <- tidy.felm(fit, se.type = "cluster")
+    Condition
+      Warning:
+      Clustered SEs requested, but weren't calculated in underlying model object.
+      i Reverting to default SEs.
+

tests/testthat/_snaps/list-svd.md

@@ -0,0 +1,8 @@
+# tidy_svd errors informatively
+
+    Code
+      tidy_svd(matrix = c("u", "v"))
+    Condition
+      Error in `tidy_svd()`:
+      ! Must specify a single matrix to tidy.
+

tests/testthat/_snaps/mass-polr.md

@@ -0,0 +1,7 @@
+# tidy.polr messages informatively
+
+    Code
+      .res <- tidy(fit, p.values = TRUE)
+    Message
+      p-values can presently only be returned for models that contain no categorical variables with more than two levels.
+

tests/testthat/_snaps/mediation.md

@@ -0,0 +1,9 @@
+# tidy.mediate errors informatively
+
+    Code
+      tidy(psych_mediate)
+    Condition
+      Error in `tidy()`:
+      ! No tidy method for objects of class <mediate> from the psych package.
+      i The `tidy.mediate()` method is intended for <mediate> objects from the mediation package.
+

tests/testthat/_snaps/mgcv.md

@@ -0,0 +1,22 @@
+# tidy.gam handles messages informatively
+
+    Code
+      .res <- tidy(x, conf.int = TRUE)
+    Message
+      Confidence intervals only available for parametric terms.
+
+---
+
+    Code
+      .res <- tidy(x, exponentiate = TRUE)
+    Message
+      Exponentiating coefficients only available for parametric terms.
+
+---
+
+    Code
+      .res <- tidy(x, conf.int = TRUE, exponentiate = TRUE)
+    Message
+      Confidence intervals only available for parametric terms.
+      Exponentiating coefficients only available for parametric terms.
+

tests/testthat/_snaps/robust-glmrob.md

@@ -0,0 +1,9 @@
+# augment.glmRob errors informatively
+
+    Code
+      augment(x)
+    Condition
+      Error in `augment()`:
+      ! `augment.glmRob()` has been deprecated as the robust package doesn't provide the functionality necessary to implement an augment method.
+      i Please see the augment method for <glmrob> objects from robustbase.
+

tests/testthat/_snaps/stats-glm.md

@@ -0,0 +1,18 @@
+# glm tidiers warn informatively with glm.fit2 input
+
+    Code
+      .res <- tidy(gfit)
+    Condition
+      Warning:
+      `x` seems to be outputted from the glm2 package.
+      i Tidiers for glm2 output are currently not maintained; please use caution in interpreting broom output.
+
+# glm tidiers warn informatively with stanreg input
+
+    Code
+      .res <- tidy(gfit)
+    Condition
+      Error in `tidy()`:
+      ! `x` seems to be outputted from the rstanarm package.
+      i Tidiers for mixed model output now live in broom.mixed.
+

tests/testthat/_snaps/stats-htest.md

@@ -5,6 +5,13 @@
     Message
       Multiple parameters; naming those columns num.df and den.df.
 
+---
+
+    Code
+      gl <- glance(ot)
+    Message
+      Multiple parameters; naming those columns num.df and den.df.
+
 # augment.htest (chi squared test)
 
     Code
@@ -29,3 +36,11 @@
       Error in `augment()`:
       ! `augment.htest()` is only defined for chi squared hypothesis tests.
 
+# tidy.htest handles various test types
+
+    Code
+      .res <- tidy(tt)
+    Condition
+      Warning:
+      Multiple unnamed parameters in hypothesis test; dropping them.
+

tests/testthat/_snaps/utilities.md

@@ -64,3 +64,12 @@
       
       This warning is displayed once per session.
 
+# as_augment_tibble errors informatively
+
+    Code
+      as_augment_tibble(m)
+    Condition
+      Error in `as_augment_tibble()`:
+      ! `m` is an unnamed matrix.
+      i Please supply a matrix or data frame with column names.
+

tests/testthat/test-data-frame.R

@@ -0,0 +1,3 @@
+test_that("glance.tbl_df errors informatively", {
+  expect_snapshot(error = TRUE, glance.tbl_df(tibble::tibble(x = 1)))
+})

tests/testthat/test-fixest.R

@@ -128,6 +128,8 @@ test_that("all other fixest estimators run", {
     strict = FALSE
   )
 
+  expect_snapshot(error = TRUE, augment(res_fenegbin))
+
   expect_snapshot(error = TRUE, augment(res_fenegbin, df))
   expect_snapshot(error = TRUE, augment(res_feNmlm, df))
   expect_snapshot(error = TRUE, augment(res_fepois, df))

tests/testthat/test-lfe.R

@@ -143,3 +143,11 @@ test_that("augment.felm", {
   expect_false(inherits(aug$.fitted, "matrix"))
   expect_null(c(colnames(aug$.resid), colnames(aug$.fitted)))
 })
+
+test_that("tidy.felm errors informatively", {
+  fit <- lfe::felm(v2 ~ v3, df)
+
+  expect_snapshot(
+    .res <- tidy.felm(fit, se.type = "cluster")
+  )
+})

tests/testthat/test-list-svd.R

@@ -22,3 +22,7 @@ test_that("tidy_svd", {
   check_dims(tdd, 12, 4)
   check_dims(tdv, 144, 3)
 })
+
+test_that("tidy_svd errors informatively", {
+  expect_snapshot(error = TRUE, tidy_svd(matrix = c("u", "v")))
+})

tests/testthat/test-mass-polr.R

@@ -57,3 +57,16 @@ test_that("augment.polr", {
 test_that("suppress Waiting for profiling to be done... message", {
   expect_silent(tidy(fit, conf.int = TRUE))
 })
+
+test_that("tidy.polr messages informatively", {
+  mtcars$cyl <- as.factor(mtcars$cyl)
+  mtcars$gear <- as.factor(mtcars$gear)
+
+  fit <- polr(
+    gear ~ cyl,
+    data = mtcars,
+    Hess = TRUE
+  )
+
+  expect_snapshot(.res <- tidy(fit, p.values = TRUE))
+})

tests/testthat/test-mediation.R

@@ -24,3 +24,9 @@ test_that("tidy.mediation", {
 
   check_dims(td1, 4, 6)
 })
+
+test_that("tidy.mediate errors informatively", {
+  # Test error for psych package mediate object
+  psych_mediate <- structure(list(), class = c("mediate", "psych"))
+  expect_snapshot(error = TRUE, tidy(psych_mediate))
+})

tests/testthat/test-mgcv.R

@@ -43,3 +43,10 @@ test_that("augment.gam", {
     )
   )
 })
+
+test_that("tidy.gam handles messages informatively", {
+  x <- fit <- mgcv::gam(weight ~ s(Time) + factor(Diet), data = ChickWeight)
+  expect_snapshot(.res <- tidy(x, conf.int = TRUE))
+  expect_snapshot(.res <- tidy(x, exponentiate = TRUE))
+  expect_snapshot(.res <- tidy(x, conf.int = TRUE, exponentiate = TRUE))
+})

tests/testthat/test-robust-glmrob.R

@@ -0,0 +1,4 @@
+test_that("augment.glmRob errors informatively", {
+  x <- structure(1L, class = "glmRob")
+  expect_snapshot(error = TRUE, augment(x))
+})

tests/testthat/test-stats-glm.R

@@ -7,6 +7,7 @@ test_that("glm tidier arguments", {
   check_arguments(augment.glm)
 })
 
+data("mtcars")
 nrow_mtcars <- nrow(mtcars)
 glm_weights <- rep(c(0, 1), each = nrow_mtcars / 2)
 gfit <- glm(am ~ wt, mtcars, family = "binomial")
@@ -73,3 +74,17 @@ test_that("augment.glm", {
     rstandard(gfit2, type = "deviance") %>% unname()
   )
 })
+
+test_that("glm tidiers warn informatively with glm.fit2 input", {
+  gfit <- glm(am ~ wt, mtcars, family = "binomial")
+  gfit$method <- "glm.fit2"
+
+  expect_snapshot(.res <- tidy(gfit))
+})
+
+test_that("glm tidiers warn informatively with stanreg input", {
+  gfit <- glm(am ~ wt, mtcars, family = "binomial")
+  gfit$stan_function <- "howdy"
+
+  expect_snapshot(error = TRUE, .res <- tidy(gfit))
+})

tests/testthat/test-stats-htest.R

@@ -19,7 +19,7 @@ test_that("tidy.htest/oneway.test", {
   mtcars$cyl <- as.factor(mtcars$cyl)
   ot <- oneway.test(mpg ~ cyl, mtcars)
   expect_snapshot(td <- tidy(ot))
-  gl <- glance(ot)
+  expect_snapshot(gl <- glance(ot))
 
   check_tidy_output(td)
   check_dims(td, expected_cols = 5)
@@ -117,3 +117,10 @@ test_that("tidy.htest does not return matrix columns", {
       purrr::none(~ inherits(., "matrix"))
   )
 })
+
+test_that("tidy.htest handles various test types", {
+  tt <- t.test(rnorm(10))
+  tt$parameter <- c(9, 10)
+
+  expect_snapshot(.res <- tidy(tt))
+})

tests/testthat/test-utilities.R

@@ -148,3 +148,8 @@ test_that("appropriate warning on (g)lm-subclassed models", {
     warn_on_subclass(x, "tidy")
   )
 })
+
+test_that("as_augment_tibble errors informatively", {
+  m <- matrix(1:4, ncol = 2)
+  expect_snapshot(error = TRUE, as_augment_tibble(m))
+})