diff --git a/.Rbuildignore b/.Rbuildignore index 82d7b782..0dcd1b0b 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -19,3 +19,4 @@ ^\.ccache$ ^[.]?air[.]toml$ ^\.vscode$ +^\.claude$ diff --git a/.gitignore b/.gitignore index 72f57e82..3d69bca7 100644 --- a/.gitignore +++ b/.gitignore @@ -14,3 +14,4 @@ docs/ inst/docs/ docs .ccache/ +.claude/ diff --git a/DESCRIPTION b/DESCRIPTION index ed99ccc5..0546734c 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -27,7 +27,6 @@ Imports: chk, extras, lifecycle, - purrr, rlang, universals, vctrs @@ -37,8 +36,8 @@ Suggests: RdMacros: lifecycle Config/Needs/website: poissonconsulting/poissontemplate +Config/roxygen2/version: 8.0.0.9000 Config/testthat/edition: 3 Encoding: UTF-8 Language: en-US Roxygen: list(markdown = TRUE) -Config/roxygen2/version: 8.0.0.9000 diff --git a/R/deprecated.R b/R/deprecated.R index 6063343d..4b9ea4ed 100644 --- a/R/deprecated.R +++ b/R/deprecated.R @@ -14,8 +14,7 @@ deprecated <- function(...) NULL #' Replace by [is_term()] #' @export is.term <- function(x) { - deprecate_warn("0.1.0", what = "term::is.term()", with = "term::is_term()") - is_term(x) + deprecate_stop("0.1.0", what = "term::is.term()", with = "term::is_term()") } #' @describeIn deprecated Is Incomplete Terms @@ -25,12 +24,11 @@ is.term <- function(x) { #' Replace by [is_incomplete_terms()] #' @export is.incomplete_terms <- function(x) { - deprecate_warn( + deprecate_stop( "0.1.0", what = "term::is.incomplete_terms()", with = "term::is_incomplete_terms()" ) - is_incomplete_terms(x) } #' @describeIn deprecated Is Inconsistent Terms @@ -40,12 +38,11 @@ is.incomplete_terms <- function(x) { #' Replace by [is_inconsistent_terms()] #' @export is.inconsistent_terms <- function(x) { - deprecate_warn( + deprecate_stop( "0.1.0", what = "term::is.inconsistent_terms()", with = "term::is_inconsistent_terms()" ) - is_inconsistent_terms(x) } #' @describeIn deprecated Get Parameters @@ -55,8 +52,7 @@ is.inconsistent_terms <- function(x) { #' Replace by [pars()] #' @export parameters <- function(x, ...) { - deprecate_warn("0.1.0", what = "parameters()", with = "pars()") - pars(x, ...) + deprecate_stop("0.1.0", what = "parameters()", with = "pars()") } @@ -67,9 +63,7 @@ parameters <- function(x, ...) { #' Replace by pars<- #' @export `parameters<-` <- function(x, value) { - deprecate_warn("0.1.0", what = "`parameters<-`()", with = "`pars<-`()") - pars(x) <- value - x + deprecate_stop("0.1.0", what = "`parameters<-`()", with = "`pars<-`()") } #' @describeIn deprecated Set Parameters @@ -79,12 +73,11 @@ parameters <- function(x, ...) { #' Replace by [set_pars()] #' @export set_parameters <- function(x, pars) { - deprecate_warn( + deprecate_stop( "0.1.0", what = "term::set_parameters()", with = "term::set_pars()" ) - set_pars(x, pars) } #' @describeIn deprecated Term Index @@ -94,6 +87,5 @@ set_parameters <- function(x, pars) { #' Replace by [tindex()] #' @export tdims <- function(x) { - deprecate_warn("0.1.0", what = "term::tdims()", with = "term::tindex()") - tindex(x) + deprecate_stop("0.1.0", what = "term::tdims()", with = "term::tindex()") } diff --git a/R/vec-cast-term.R b/R/vec-cast-term.R index 8059526a..e399ec4b 100644 --- a/R/vec-cast-term.R +++ b/R/vec-cast-term.R @@ -20,7 +20,7 @@ vec_cast.term.term_rcrd <- function(x, to, ...) { chr <- paste0( field(x, "par"), "[", - purrr::map_chr(field(x, "dim"), paste, collapse = ","), + vapply(field(x, "dim"), paste, character(1), collapse = ","), "]" ) chr[is.na(field(x, "par"))] <- NA_character_ diff --git a/tests/testthat/_snaps/as-term-rcrd.md b/tests/testthat/_snaps/as-term-rcrd.md new file mode 100644 index 00000000..a7c2ad20 --- /dev/null +++ b/tests/testthat/_snaps/as-term-rcrd.md @@ -0,0 +1,32 @@ +# as_term_rcrd.character + + Code + as_term_rcrd("a", "b") + Condition + Error in `as_term.character()`: + ! `repair` must be a flag (TRUE or FALSE). + +# as_term_rcrd others + + Code + as_term_rcrd(factor(1)) + Condition + Error in `as_term_rcrd()`: + ! Can't convert `x` > to . + +--- + + Code + as_term_rcrd(data.frame(x = 1)) + Condition + Error in `as_term_rcrd()`: + ! Can't convert `x` to . + +--- + + Code + as_term_rcrd(TRUE) + Condition + Error in `as_term_rcrd()`: + ! Can't convert `x` to . + diff --git a/tests/testthat/_snaps/as-term.md b/tests/testthat/_snaps/as-term.md new file mode 100644 index 00000000..8b95f6bf --- /dev/null +++ b/tests/testthat/_snaps/as-term.md @@ -0,0 +1,32 @@ +# as_term.character + + Code + as_term("a", "b") + Condition + Error in `as_term.character()`: + ! `repair` must be a flag (TRUE or FALSE). + +# as_term others + + Code + as_term(factor(1)) + Condition + Error in `as_term()`: + ! Can't convert `x` > to . + +--- + + Code + as_term(data.frame(x = 1)) + Condition + Error in `as_term()`: + ! Can't convert `x` to . + +--- + + Code + as_term(TRUE) + Condition + Error in `vec_restore_dispatch()`: + ! Can't convert to . + diff --git a/tests/testthat/_snaps/chk.md b/tests/testthat/_snaps/chk.md new file mode 100644 index 00000000..051af864 --- /dev/null +++ b/tests/testthat/_snaps/chk.md @@ -0,0 +1,56 @@ +# chk_term + + Code + chk_term(x) + Condition + Error: + ! `x` must be a term vector. + +--- + + Code + chk_term(x, validate = "valid") + Condition + Error: + ! All elements of term vector `x` must be valid. + +--- + + Code + chk_term(x, validate = "consistent") + Condition + Error: + ! All elements of term vector `x` must be consistent. + +--- + + Code + chk_term(x, validate = "complete") + Condition + Error: + ! All elements of term vector `x` must be complete. + +# chk_term_rcrd + + Code + chk_term_rcrd(x) + Condition + Error: + ! `x` must be a term_rcrd vector. + +--- + + Code + chk_term_rcrd(x, validate = "consistent") + Condition + Error: + ! All elements of term_rcrd vector `x` must be consistent. + +--- + + Code + chk_term_rcrd(x, validate = "complete") + Condition + Error: + ! All elements of term_rcrd vector `x` must be complete. + diff --git a/tests/testthat/_snaps/complete-terms.md b/tests/testthat/_snaps/complete-terms.md new file mode 100644 index 00000000..35024cf1 --- /dev/null +++ b/tests/testthat/_snaps/complete-terms.md @@ -0,0 +1,40 @@ +# complete_terms term + + Code + complete_terms(NA_term_) + Condition + Error: + ! `x` must not have any missing values. + +--- + + Code + complete_terms(new_term(c(NA_term_, "b[2]"))) + Condition + Error: + ! `x` must not have any missing values. + +--- + + Code + complete_terms(new_term(c("b", "b[2,2]"))) + Condition + Error in `complete_terms.term()`: + ! `x` must have terms with consistent parameter dimensions. + +# complete_terms term_rcrd + + Code + complete_terms(term_rcrd(c(NA_term_, "b[2]"))) + Condition + Error in `complete_terms.term_rcrd()`: + ! `x` must not have any missing values. + +--- + + Code + complete_terms(term_rcrd(c("b", "b[2,2]"))) + Condition + Error in `complete_terms.term()`: + ! `x` must have terms with consistent parameter dimensions. + diff --git a/tests/testthat/_snaps/deprecated.md b/tests/testthat/_snaps/deprecated.md new file mode 100644 index 00000000..467e1318 --- /dev/null +++ b/tests/testthat/_snaps/deprecated.md @@ -0,0 +1,64 @@ +# deprecated functions error + + Code + is.term(1) + Condition + Error: + ! `is.term()` was deprecated in term 0.1.0 and is now defunct. + i Please use `is_term()` instead. + +--- + + Code + is.incomplete_terms(term("a[1]")) + Condition + Error: + ! `is.incomplete_terms()` was deprecated in term 0.1.0 and is now defunct. + i Please use `is_incomplete_terms()` instead. + +--- + + Code + is.inconsistent_terms(term("a[1]")) + Condition + Error: + ! `is.inconsistent_terms()` was deprecated in term 0.1.0 and is now defunct. + i Please use `is_inconsistent_terms()` instead. + +--- + + Code + parameters(term("a[1]")) + Condition + Error: + ! `parameters()` was deprecated in term 0.1.0 and is now defunct. + i Please use `pars()` instead. + +--- + + Code + x <- term("a[1]") + parameters(x) <- "b" + Condition + Error: + ! `parameters<-()` was deprecated in term 0.1.0 and is now defunct. + i Please use `pars<-()` instead. + +--- + + Code + set_parameters(term("a[1]"), "b") + Condition + Error: + ! `set_parameters()` was deprecated in term 0.1.0 and is now defunct. + i Please use `set_pars()` instead. + +--- + + Code + tdims(term("a[1]")) + Condition + Error: + ! `tdims()` was deprecated in term 0.1.0 and is now defunct. + i Please use `tindex()` instead. + diff --git a/tests/testthat/_snaps/is-incomplete-terms.md b/tests/testthat/_snaps/is-incomplete-terms.md new file mode 100644 index 00000000..a6ff1775 --- /dev/null +++ b/tests/testthat/_snaps/is-incomplete-terms.md @@ -0,0 +1,8 @@ +# is_incomplete_terms + + Code + is_incomplete_terms(new_term(c("b", "b[2]", "b[4,] "))) + Condition + Error in `is_incomplete_terms()`: + ! `x` must have terms with consistent parameter dimensions. + diff --git a/tests/testthat/_snaps/npars.md b/tests/testthat/_snaps/npars.md new file mode 100644 index 00000000..6d60fb12 --- /dev/null +++ b/tests/testthat/_snaps/npars.md @@ -0,0 +1,16 @@ +# npars.term invalid elements + + Code + out <- npars(new_term(c("a[2]", "b c"))) + Condition + Warning in `lapply()`: + NAs introduced by coercion + +# npars.term scalar invalid elements + + Code + out <- npars(new_term(c("a[2]", "b c")), scalar = TRUE) + Condition + Warning in `lapply()`: + NAs introduced by coercion + diff --git a/tests/testthat/_snaps/npdims.md b/tests/testthat/_snaps/npdims.md new file mode 100644 index 00000000..d3ab0366 --- /dev/null +++ b/tests/testthat/_snaps/npdims.md @@ -0,0 +1,16 @@ +# npdims.term + + Code + npdims(new_term(c("alpha[1]", "alpha[3]", "beta[1,1]", "beta[2,1]")), terms = TRUE) + Condition + Error in `npdims.term()`: + ! `...` must be unused. + +--- + + Code + npdims(NA_term_) + Condition + Error in `npdims.term()`: + ! `x` must not have any missing values. + diff --git a/tests/testthat/_snaps/pdims.md b/tests/testthat/_snaps/pdims.md new file mode 100644 index 00000000..0ebc9cae --- /dev/null +++ b/tests/testthat/_snaps/pdims.md @@ -0,0 +1,32 @@ +# pdims + + Code + pdims(new_term(c("alpha[3]", "beta[2,1]", "alpha[10,]"))) + Condition + Error: + ! `x` must have terms with consistent parameter dimensions. + +# pdims missing value + + Code + pdims(NA_term_) + Condition + Error: + ! `x` must not have any missing values. + +--- + + Code + pdims(new_term(c("alpha[3]", "beta[2,1]", NA))) + Condition + Error: + ! `x` must not have any missing values. + +# pdims inconsistent + + Code + pdims(new_term(c("alpha[1]", "alpha[1,1]"))) + Condition + Error: + ! `x` must have terms with consistent parameter dimensions. + diff --git a/tests/testthat/_snaps/print.md b/tests/testthat/_snaps/print.md new file mode 100644 index 00000000..b9c15ee9 --- /dev/null +++ b/tests/testthat/_snaps/print.md @@ -0,0 +1,48 @@ +# print term + + Code + term() + Output + + Code + term(alpha = 2, beta = c(2, 2), "sigma") + Output + + [1] alpha[1] alpha[2] beta[1,1] beta[2,1] beta[1,2] beta[2,2] sigma + Code + term("alpha[1]", "sigma", "alpha[2]", "beta[1,1]", "beta[2,1]", "beta[1,2]", + "beta[2,2]") + Output + + [1] alpha[1] sigma alpha[2] beta[1,1] beta[2,1] beta[1,2] beta[2,2] + Code + new_term(c("with space", "")) + Output + + [1] `with space` `` + Code + term("r [ 1 ,2 ]") + Output + + [1] r[1,2] + +--- + + Code + term("r[") + Condition + Error in `term_impl()`: + ! All elements of term vector `string_args_term` must be valid. + +# print term_rcrd + + Code + new_term_rcrd() + Output + + Code + as_term_rcrd(term(alpha = 2, beta = c(2, 2), "sigma")) + Output + + [1] alpha[1] alpha[2] beta[1,1] beta[2,1] beta[1,2] beta[2,2] sigma + diff --git a/tests/testthat/_snaps/set-pars.md b/tests/testthat/_snaps/set-pars.md new file mode 100644 index 00000000..b49ec750 --- /dev/null +++ b/tests/testthat/_snaps/set-pars.md @@ -0,0 +1,72 @@ +# set_pars + + Code + set_pars(new_term("a"), c("b", "a")) + Condition + Error: + ! `value` must be length 1, not 2. + +--- + + Code + set_pars(new_term(c("a", "a")), c("b", "a", "c")) + Condition + Error: + ! `value` must be length 1, not 3. + +--- + + Code + set_pars(new_term("a"), "") + Condition + Error in `chk_pars()`: + ! `value` must match regular expression '^[[:alpha:]][[:alnum:]._]*$'. + +--- + + Code + set_pars(new_term("a"), "1") + Condition + Error in `chk_pars()`: + ! `value` must match regular expression '^[[:alpha:]][[:alnum:]._]*$'. + +--- + + Code + set_pars(new_term(rep("a", 7)), value = c("gamma", "theta", "rho")) + Condition + Error: + ! `value` must be length 1, not 3. + +# set_pars missing values + + Code + set_pars(new_term(c("a [ 1]", "b")), c("b", NA)) + Condition + Error in `set_pars.term()`: + ! `value` must not have any missing values. + +--- + + Code + set_pars(NA_term_, "a") + Condition + Error in `set_pars.term()`: + ! `x` must not have any missing values. + +--- + + Code + set_pars(new_term(c("c c", "b")), "a") + Condition + Error in `set_pars.term()`: + ! All elements of term vector `x` must be valid. + +# set_pars no values + + Code + set_pars(term, "c") + Condition + Error: + ! `value` must be length 0, not 1. + diff --git a/tests/testthat/_snaps/subset.md b/tests/testthat/_snaps/subset.md new file mode 100644 index 00000000..960b9f0c --- /dev/null +++ b/tests/testthat/_snaps/subset.md @@ -0,0 +1,48 @@ +# subset.term + + Code + subset(term, "beta") + Condition + Error in `subset.term()`: + ! `pars` must match 'alpha' or 'sigma', not 'beta'. + +--- + + Code + subset(term, "tt") + Condition + Error in `subset.term()`: + ! `pars` must match 'alpha', 'beta' or 'sigma', not 'tt'. + +# subset.term_rcrd + + Code + subset(term_rcrd, "beta") + Condition + Error in `subset.term_rcrd()`: + ! `pars` must match 'alpha' or 'sigma', not 'beta'. + +--- + + Code + subset(term_rcrd, "tt") + Condition + Error in `subset.term_rcrd()`: + ! `pars` must match 'alpha', 'beta' or 'sigma', not 'tt'. + +# subset.term missing values + + Code + subset(NA_term_) + Condition + Error in `subset.term()`: + ! `x` must not have any missing values. + +--- + + Code + subset(c(NA_term_, new_term("a"))) + Condition + Error in `subset.term()`: + ! `x` must not have any missing values. + diff --git a/tests/testthat/_snaps/unique.md b/tests/testthat/_snaps/unique.md new file mode 100644 index 00000000..33fbd734 --- /dev/null +++ b/tests/testthat/_snaps/unique.md @@ -0,0 +1,8 @@ +# unique incomparables + + Code + unique(NA_term_, incomparables = TRUE) + Condition + Error in `unique.term_rcrd()`: + ! `incomparables` must be FALSE. + diff --git a/tests/testthat/_snaps/utils.md b/tests/testthat/_snaps/utils.md new file mode 100644 index 00000000..5636ae7e --- /dev/null +++ b/tests/testthat/_snaps/utils.md @@ -0,0 +1,8 @@ +# c.term + + Code + c(NA_term_, recursive = TRUE) + Condition + Error in `c()`: + ! `recursive` must be `FALSE` when concatenating vctrs classes. + diff --git a/tests/testthat/out/print-term-rcrd.txt b/tests/testthat/out/print-term-rcrd.txt deleted file mode 100644 index 126134e1..00000000 --- a/tests/testthat/out/print-term-rcrd.txt +++ /dev/null @@ -1,7 +0,0 @@ -> new_term_rcrd() - - -> as_term_rcrd(term(alpha = 2, beta = c(2, 2), "sigma")) - -[1] alpha[1] alpha[2] beta[1,1] beta[2,1] beta[1,2] beta[2,2] sigma - diff --git a/tests/testthat/out/print-term.txt b/tests/testthat/out/print-term.txt deleted file mode 100644 index 46a9cf8e..00000000 --- a/tests/testthat/out/print-term.txt +++ /dev/null @@ -1,23 +0,0 @@ -> term() - - -> term(alpha = 2, beta = c(2, 2), "sigma") - -[1] alpha[1] alpha[2] beta[1,1] beta[2,1] beta[1,2] beta[2,2] sigma - -> term("alpha[1]", "sigma", "alpha[2]", "beta[1,1]", "beta[2,1]", "beta[1,2]", -+ "beta[2,2]") - -[1] alpha[1] sigma alpha[2] beta[1,1] beta[2,1] beta[1,2] beta[2,2] - -> new_term(c("with space", "")) - -[1] `with space` `` - -> term("r[") -Error in term_impl(args): All elements of term vector `string_args_term` must be valid. - -> term("r [ 1 ,2 ]") - -[1] r[1,2] - diff --git a/tests/testthat/test-as-term-rcrd.R b/tests/testthat/test-as-term-rcrd.R index 63b682b2..aaa6ca73 100644 --- a/tests/testthat/test-as-term-rcrd.R +++ b/tests/testthat/test-as-term-rcrd.R @@ -85,11 +85,7 @@ test_that("as_term_rcrd.array", { }) test_that("as_term_rcrd.character", { - expect_error( - as_term_rcrd("a", "b"), - "^`repair` must be a flag [(]TRUE or FALSE[)][.]$", - class = "chk_error" - ) + expect_snapshot(error = TRUE, as_term_rcrd("a", "b")) x <- c( "parm3[10]", "parm3[2]", @@ -141,9 +137,9 @@ test_that("as_term_rcrd.character", { }) test_that("as_term_rcrd others", { - expect_error(as_term_rcrd(factor(1)), class = "vctrs_error") - expect_error(as_term_rcrd(data.frame(x = 1)), class = "vctrs_error") - expect_error(as_term_rcrd(TRUE), class = "vctrs_error") + expect_snapshot(error = TRUE, as_term_rcrd(factor(1))) + expect_snapshot(error = TRUE, as_term_rcrd(data.frame(x = 1))) + expect_snapshot(error = TRUE, as_term_rcrd(TRUE)) }) test_that("as_term_rcrd missing values", { diff --git a/tests/testthat/test-as-term.R b/tests/testthat/test-as-term.R index 48d05a3d..47aa161f 100644 --- a/tests/testthat/test-as-term.R +++ b/tests/testthat/test-as-term.R @@ -71,11 +71,7 @@ test_that("as_term.array", { }) test_that("as_term.character", { - expect_error( - as_term("a", "b"), - "^`repair` must be a flag [(]TRUE or FALSE[)][.]$", - class = "chk_error" - ) + expect_snapshot(error = TRUE, as_term("a", "b")) x <- c( "parm3[10]", "parm3[2]", @@ -146,7 +142,7 @@ test_that("as_term others", { test_that("as_term others", { rlang::local_options(lifecycle_verbosity = "quiet") - expect_error(as_term(factor(1)), class = "vctrs_error") - expect_error(as_term(data.frame(x = 1)), class = "vctrs_error") - expect_error(as_term(TRUE), class = "vctrs_error") + expect_snapshot(error = TRUE, as_term(factor(1))) + expect_snapshot(error = TRUE, as_term(data.frame(x = 1))) + expect_snapshot(error = TRUE, as_term(TRUE)) }) diff --git a/tests/testthat/test-chk.R b/tests/testthat/test-chk.R index 0c348db7..5ed9e794 100644 --- a/tests/testthat/test-chk.R +++ b/tests/testthat/test-chk.R @@ -4,29 +4,13 @@ test_that("chk_term", { expect_null(chk_term(new_term(c("x[2]", "x[1]")))) x <- c("x[2]", "x[1]") - expect_error( - chk_term(x), - "^`x` must be a term vector[.]$", - class = "chk_error" - ) + expect_snapshot(error = TRUE, chk_term(x)) x <- new_term(c("x[2]", "x[1")) - expect_error( - chk_term(x, validate = "valid"), - "^All elements of term vector `x` must be valid[.]$", - class = "chk_error" - ) + expect_snapshot(error = TRUE, chk_term(x, validate = "valid")) x <- new_term(c("x[2]", "x[1,1]")) - expect_error( - chk_term(x, validate = "consistent"), - "^All elements of term vector `x` must be consistent[.]$", - class = "chk_error" - ) + expect_snapshot(error = TRUE, chk_term(x, validate = "consistent")) x <- new_term(c("x[2,2]", "x[1,1]")) - expect_error( - chk_term(x, validate = "complete"), - "^All elements of term vector `x` must be complete[.]$", - class = "chk_error" - ) + expect_snapshot(error = TRUE, chk_term(x, validate = "complete")) }) test_that("chk_term_rcrd", { @@ -35,21 +19,9 @@ test_that("chk_term_rcrd", { expect_null(chk_term_rcrd(term_rcrd(c("x[2]", "x[1]")))) x <- c("x[2]", "x[1]") - expect_error( - chk_term_rcrd(x), - "^`x` must be a term_rcrd vector[.]$", - class = "chk_error" - ) + expect_snapshot(error = TRUE, chk_term_rcrd(x)) x <- term_rcrd(c("x[2]", "x[1,1]")) - expect_error( - chk_term_rcrd(x, validate = "consistent"), - "^All elements of term_rcrd vector `x` must be consistent[.]$", - class = "chk_error" - ) + expect_snapshot(error = TRUE, chk_term_rcrd(x, validate = "consistent")) x <- term_rcrd(c("x[2,2]", "x[1,1]")) - expect_error( - chk_term_rcrd(x, validate = "complete"), - "^All elements of term_rcrd vector `x` must be complete[.]$", - class = "chk_error" - ) + expect_snapshot(error = TRUE, chk_term_rcrd(x, validate = "complete")) }) diff --git a/tests/testthat/test-complete-terms.R b/tests/testthat/test-complete-terms.R index 02cf093c..fc5af304 100644 --- a/tests/testthat/test-complete-terms.R +++ b/tests/testthat/test-complete-terms.R @@ -1,15 +1,7 @@ test_that("complete_terms term", { - expect_error( - complete_terms(NA_term_), - "^`x` must not have any missing values[.]$", - class = "chk_error" - ) + expect_snapshot(error = TRUE, complete_terms(NA_term_)) expect_identical(complete_terms(new_term()), new_term()) - expect_error( - complete_terms(new_term(c(NA_term_, "b[2]"))), - "^`x` must not have any missing values[.]$", - class = "chk_error" - ) + expect_snapshot(error = TRUE, complete_terms(new_term(c(NA_term_, "b[2]")))) expect_identical(complete_terms(new_term("b")), new_term("b")) expect_identical(complete_terms(new_term(c("b", "b"))), new_term(c("b", "b"))) expect_identical(complete_terms(new_term("b")), new_term("b")) @@ -26,20 +18,12 @@ test_that("complete_terms term", { complete_terms(new_term(c("z[2,2]", "z[2,1]"))), new_term(c("z[2,2]", "z[2,1]", "z[1,1]", "z[1,2]")) ) - expect_error( - complete_terms(new_term(c("b", "b[2,2]"))), - "`x` must have terms with consistent parameter dimensions.", - class = "chk_error" - ) + expect_snapshot(error = TRUE, complete_terms(new_term(c("b", "b[2,2]")))) }) test_that("complete_terms term_rcrd", { expect_identical(complete_terms(new_term_rcrd()), new_term_rcrd()) - expect_error( - complete_terms(term_rcrd(c(NA_term_, "b[2]"))), - "^`x` must not have any missing values[.]$", - class = "chk_error" - ) + expect_snapshot(error = TRUE, complete_terms(term_rcrd(c(NA_term_, "b[2]")))) expect_identical(complete_terms(term_rcrd("b")), term_rcrd("b")) expect_identical( complete_terms(term_rcrd(c("b", "b"))), @@ -59,9 +43,5 @@ test_that("complete_terms term_rcrd", { complete_terms(term_rcrd(c("z[2,2]", "z[2,1]"))), term_rcrd(c("z[2,2]", "z[2,1]", "z[1,1]", "z[1,2]")) ) - expect_error( - complete_terms(term_rcrd(c("b", "b[2,2]"))), - "`x` must have terms with consistent parameter dimensions.", - class = "chk_error" - ) + expect_snapshot(error = TRUE, complete_terms(term_rcrd(c("b", "b[2,2]")))) }) diff --git a/tests/testthat/test-consistent-term.R b/tests/testthat/test-consistent-term.R index 8fb6799a..dd5a1a63 100644 --- a/tests/testthat/test-consistent-term.R +++ b/tests/testthat/test-consistent-term.R @@ -1,7 +1,8 @@ test_that("consistent_term", { + # not a snapshot as message detail varies with chk version expect_error( consistent_term(1), - "`x` must inherit from S3 class 'term'.", + "`x` must inherit from S3 class 'term'", class = "chk_error" ) expect_identical(consistent_term(new_term()), logical(0)) @@ -31,9 +32,10 @@ test_that("consistent_term", { }) test_that("consistent_term term_rcrd", { + # not a snapshot as message detail varies with chk version expect_error( consistent_term(1), - "`x` must inherit from S3 class 'term_rcrd'.", + "`x` must inherit from S3 class 'term_rcrd'", class = "chk_error" ) expect_identical(consistent_term(term_rcrd()), logical(0)) diff --git a/tests/testthat/test-deprecated.R b/tests/testthat/test-deprecated.R index abc48301..93678209 100644 --- a/tests/testthat/test-deprecated.R +++ b/tests/testthat/test-deprecated.R @@ -1,6 +1,12 @@ -test_that("is.term deprecated", { - rlang::local_options(lifecycle_verbosity = "quiet") - lifecycle::expect_deprecated(is.term(1)) - - expect_false(is.term(1)) +test_that("deprecated functions error", { + expect_snapshot(error = TRUE, is.term(1)) + expect_snapshot(error = TRUE, is.incomplete_terms(term("a[1]"))) + expect_snapshot(error = TRUE, is.inconsistent_terms(term("a[1]"))) + expect_snapshot(error = TRUE, parameters(term("a[1]"))) + expect_snapshot(error = TRUE, { + x <- term("a[1]") + parameters(x) <- "b" + }) + expect_snapshot(error = TRUE, set_parameters(term("a[1]"), "b")) + expect_snapshot(error = TRUE, tdims(term("a[1]"))) }) diff --git a/tests/testthat/test-is-incomplete-terms.R b/tests/testthat/test-is-incomplete-terms.R index dcd5bbdf..72164915 100644 --- a/tests/testthat/test-is-incomplete-terms.R +++ b/tests/testthat/test-is-incomplete-terms.R @@ -3,10 +3,9 @@ test_that("is_incomplete_terms", { expect_false(is_incomplete_terms(new_term("b"))) expect_identical(is_incomplete_terms(new_term(c("b", NA))), NA) expect_false(is_incomplete_terms(new_term(c("b", "b[2]")))) - expect_error( - is_incomplete_terms(new_term(c("b", "b[2]", "b[4,] "))), - "^`x` must have terms with consistent parameter dimensions[.]$", - class = "chk_error" + expect_snapshot( + error = TRUE, + is_incomplete_terms(new_term(c("b", "b[2]", "b[4,] "))) ) expect_false(is_incomplete_terms(new_term("b[1]"))) expect_true(is_incomplete_terms(new_term("b[2]"))) diff --git a/tests/testthat/test-npars.R b/tests/testthat/test-npars.R index 67053048..78bf8e39 100644 --- a/tests/testthat/test-npars.R +++ b/tests/testthat/test-npars.R @@ -33,7 +33,8 @@ test_that("npars.term scalar = FALSE", { }) test_that("npars.term invalid elements", { - expect_warning(expect_identical(npars(new_term(c("a[2]", "b c"))), 2L)) + expect_snapshot(out <- npars(new_term(c("a[2]", "b c")))) + expect_identical(out, 2L) }) test_that("npars.term missing values", { @@ -47,10 +48,8 @@ test_that("npars.term scalar", { }) test_that("npars.term scalar invalid elements", { - expect_warning(expect_identical( - npars(new_term(c("a[2]", "b c")), scalar = TRUE), - 1L - )) + expect_snapshot(out <- npars(new_term(c("a[2]", "b c")), scalar = TRUE)) + expect_identical(out, 1L) }) test_that("npars scalar missing values", { diff --git a/tests/testthat/test-npdims.R b/tests/testthat/test-npdims.R index bf8fa9ca..ce8de2a7 100644 --- a/tests/testthat/test-npdims.R +++ b/tests/testthat/test-npdims.R @@ -17,14 +17,13 @@ test_that("npdims.term", { c(alpha = 1L, beta = 2L, sigma = 1L) ) - testthat::expect_error(npdims( - new_term(c("alpha[1]", "alpha[3]", "beta[1,1]", "beta[2,1]")), - terms = TRUE - )) - - expect_error( - npdims(NA_term_), - "^`x` must not have any missing values[.]$", - class = "chk_error" + expect_snapshot( + error = TRUE, + npdims( + new_term(c("alpha[1]", "alpha[3]", "beta[1,1]", "beta[2,1]")), + terms = TRUE + ) ) + + expect_snapshot(error = TRUE, npdims(NA_term_)) }) diff --git a/tests/testthat/test-pdims.R b/tests/testthat/test-pdims.R index c03a1117..19e44aeb 100644 --- a/tests/testthat/test-pdims.R +++ b/tests/testthat/test-pdims.R @@ -32,32 +32,25 @@ test_that("pdims", { list(alpha = 3L, beta = c(2L, 1L)) ) - expect_error( - pdims(new_term(c("alpha[3]", "beta[2,1]", "alpha[10,]"))), - "^`x` must have terms with consistent parameter dimensions[.]$", - class = "chk_error" + expect_snapshot( + error = TRUE, + pdims(new_term(c("alpha[3]", "beta[2,1]", "alpha[10,]"))) ) }) test_that("pdims missing value", { - expect_error( - pdims(NA_term_), - "^`x` must not have any missing values[.]$", - class = "chk_error" - ) + expect_snapshot(error = TRUE, pdims(NA_term_)) - expect_error( - pdims(new_term(c("alpha[3]", "beta[2,1]", NA))), - "^`x` must not have any missing values[.]$", - class = "chk_error" + expect_snapshot( + error = TRUE, + pdims(new_term(c("alpha[3]", "beta[2,1]", NA))) ) }) test_that("pdims inconsistent", { - expect_error( - pdims(new_term(c("alpha[1]", "alpha[1,1]"))), - "^`x` must have terms with consistent parameter dimensions[.]$", - class = "chk_error" + expect_snapshot( + error = TRUE, + pdims(new_term(c("alpha[1]", "alpha[1,1]"))) ) }) diff --git a/tests/testthat/test-print.R b/tests/testthat/test-print.R index 41adab9f..8d163564 100644 --- a/tests/testthat/test-print.R +++ b/tests/testthat/test-print.R @@ -1,5 +1,5 @@ -test_that("print", { - verify_output("out/print-term.txt", { +test_that("print term", { + expect_snapshot({ term() term(alpha = 2, beta = c(2, 2), "sigma") @@ -16,12 +16,14 @@ test_that("print", { new_term(c("with space", "")) - term("r[") - term("r [ 1 ,2 ]") }) - verify_output("out/print-term-rcrd.txt", { + expect_snapshot(error = TRUE, term("r[")) +}) + +test_that("print term_rcrd", { + expect_snapshot({ new_term_rcrd() as_term_rcrd(term(alpha = 2, beta = c(2, 2), "sigma")) diff --git a/tests/testthat/test-repair-terms.R b/tests/testthat/test-repair-terms.R index 6deba1b0..bb627549 100644 --- a/tests/testthat/test-repair-terms.R +++ b/tests/testthat/test-repair-terms.R @@ -1,7 +1,8 @@ test_that("repair_terms", { + # not a snapshot as message detail varies with chk version expect_error( repair_terms(NA_character_), - "`x` must inherit from S3 class 'term'.", + "`x` must inherit from S3 class 'term'", class = "chk_error" ) expect_identical(repair_terms(new_term()), new_term()) diff --git a/tests/testthat/test-set-pars.R b/tests/testthat/test-set-pars.R index 3cf8c2a5..79f37197 100644 --- a/tests/testthat/test-set-pars.R +++ b/tests/testthat/test-set-pars.R @@ -1,25 +1,12 @@ test_that("set_pars", { expect_identical(set_pars(new_term("a"), "b"), new_term("b")) - expect_error( - set_pars(new_term("a"), c("b", "a")), - "^`value` must be length 1, not 2[.]$", - class = "chk_error" - ) - expect_error( - set_pars(new_term(c("a", "a")), c("b", "a", "c")), - "^`value` must be length 1, not 3[.]$", - class = "chk_error" - ) - expect_error( - set_pars(new_term("a"), ""), - "^`value` must match regular expression", - class = "chk_error" - ) - expect_error( - set_pars(new_term("a"), "1"), - "^`value` must match regular expression", - class = "chk_error" + expect_snapshot(error = TRUE, set_pars(new_term("a"), c("b", "a"))) + expect_snapshot( + error = TRUE, + set_pars(new_term(c("a", "a")), c("b", "a", "c")) ) + expect_snapshot(error = TRUE, set_pars(new_term("a"), "")) + expect_snapshot(error = TRUE, set_pars(new_term("a"), "1")) expect_identical( set_pars(new_term(c("a", "b")), c("b", "a")), @@ -33,39 +20,25 @@ test_that("set_pars", { set_pars(new_term(c("a [ 1]", "b")), c("b", "d")), new_term(c("b [ 1]", "d")) ) - expect_error( - set_pars(new_term(rep("a", 7)), value = c("gamma", "theta", "rho")), - "^`value` must be length 1, not 3[.]$", - class = "chk_error" + expect_snapshot( + error = TRUE, + set_pars(new_term(rep("a", 7)), value = c("gamma", "theta", "rho")) ) }) test_that("set_pars missing values", { - expect_error( - set_pars(new_term(c("a [ 1]", "b")), c("b", NA)), - "^`value` must not have any missing values[.]$", - class = "chk_error" - ) - expect_error( - set_pars(NA_term_, "a"), - "^`x` must not have any missing values[.]$", - class = "chk_error" - ) - expect_error( - set_pars(new_term(c("c c", "b")), "a"), - "^All elements of term vector `x` must be valid[.]$", - class = "chk_error" + expect_snapshot( + error = TRUE, + set_pars(new_term(c("a [ 1]", "b")), c("b", NA)) ) + expect_snapshot(error = TRUE, set_pars(NA_term_, "a")) + expect_snapshot(error = TRUE, set_pars(new_term(c("c c", "b")), "a")) }) test_that("set_pars no values", { term <- new_term(character(0)) expect_identical(set_pars(term, character(0)), term) - expect_error( - set_pars(term, "c"), - "^`value` must be length 0, not 1[.]$", - class = "chk_error" - ) + expect_snapshot(error = TRUE, set_pars(term, "c")) }) test_that("set_pars missing values", { diff --git a/tests/testthat/test-subset.R b/tests/testthat/test-subset.R index 596cc89a..c032eb80 100644 --- a/tests/testthat/test-subset.R +++ b/tests/testthat/test-subset.R @@ -1,11 +1,7 @@ test_that("subset.term", { term <- new_term(c("alpha[1]", "alpha[2]", "sigma")) expect_identical(subset(term, character(0)), new_term()) - expect_error( - subset(term, "beta"), - "^`pars` must match 'alpha' or 'sigma', not 'beta'[.]$", - class = "chk_error" - ) + expect_snapshot(error = TRUE, subset(term, "beta")) term <- new_term(c( "alpha[1]", "alpha[2]", @@ -37,21 +33,13 @@ test_that("subset.term", { "sigma" )) ) - expect_error( - subset(term, "tt"), - "^`pars` must match 'alpha', 'beta' or 'sigma', not 'tt'[.]$", - class = "chk_error" - ) + expect_snapshot(error = TRUE, subset(term, "tt")) }) test_that("subset.term_rcrd", { term_rcrd <- as_term_rcrd(new_term(c("alpha[1]", "alpha[2]", "sigma"))) expect_identical(subset(term_rcrd, character(0)), new_term_rcrd()) - expect_error( - subset(term_rcrd, "beta"), - "^`pars` must match 'alpha' or 'sigma', not 'beta'[.]$", - class = "chk_error" - ) + expect_snapshot(error = TRUE, subset(term_rcrd, "beta")) term_rcrd <- as_term_rcrd(new_term(c( "alpha[1]", "alpha[2]", @@ -83,11 +71,7 @@ test_that("subset.term_rcrd", { "sigma" ))) ) - expect_error( - subset(term_rcrd, "tt"), - "^`pars` must match 'alpha', 'beta' or 'sigma', not 'tt'[.]$", - class = "chk_error" - ) + expect_snapshot(error = TRUE, subset(term_rcrd, "tt")) }) test_that("subset.term deprecated", { @@ -102,14 +86,6 @@ test_that("subset.term deprecated", { test_that("subset.term missing values", { - expect_error( - subset(NA_term_), - "^`x` must not have any missing values[.]$", - class = "chk_error" - ) - expect_error( - subset(c(NA_term_, new_term("a"))), - "^`x` must not have any missing values[.]$", - class = "chk_error" - ) + expect_snapshot(error = TRUE, subset(NA_term_)) + expect_snapshot(error = TRUE, subset(c(NA_term_, new_term("a")))) }) diff --git a/tests/testthat/test-unique.R b/tests/testthat/test-unique.R index ef26d112..59963d0d 100644 --- a/tests/testthat/test-unique.R +++ b/tests/testthat/test-unique.R @@ -1,9 +1,5 @@ test_that("unique incomparables", { - expect_error( - unique(NA_term_, incomparables = TRUE), - "^`incomparables` must be FALSE[.]$", - class = "chk_error" - ) + expect_snapshot(error = TRUE, unique(NA_term_, incomparables = TRUE)) }) test_that("unique term", { diff --git a/tests/testthat/test-utils.R b/tests/testthat/test-utils.R index fd4e190c..44fe53cb 100644 --- a/tests/testthat/test-utils.R +++ b/tests/testthat/test-utils.R @@ -1,5 +1,5 @@ test_that("c.term", { - expect_error(c(NA_term_, recursive = TRUE)) + expect_snapshot(error = TRUE, c(NA_term_, recursive = TRUE)) expect_identical( c(NA_term_, "b", "a[1]", ""), c(NA, "b", "a[1]", "") diff --git a/tests/testthat/test-valid-term.R b/tests/testthat/test-valid-term.R index 992566c1..b53d3ab1 100644 --- a/tests/testthat/test-valid-term.R +++ b/tests/testthat/test-valid-term.R @@ -1,4 +1,5 @@ test_that("valid_term character", { + # not a snapshot as message detail varies with chk version expect_error( valid_term(NA_character_), "`x` must inherit from S3 class 'term'",