diff --git a/NAMESPACE b/NAMESPACE index 8e934b3f..70675729 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -18,6 +18,19 @@ export(xportr_write) export(xpt_validate) import(haven) import(rlang) +importFrom(checkmate,assert) +importFrom(checkmate,assert_character) +importFrom(checkmate,assert_choice) +importFrom(checkmate,assert_data_frame) +importFrom(checkmate,assert_integer) +importFrom(checkmate,assert_logical) +importFrom(checkmate,assert_string) +importFrom(checkmate,check_data_frame) +importFrom(checkmate,check_r6) +importFrom(checkmate,makeAssertion) +importFrom(checkmate,test_data_frame) +importFrom(checkmate,test_string) +importFrom(checkmate,vname) importFrom(cli,cli_alert_danger) importFrom(cli,cli_alert_info) importFrom(cli,cli_alert_success) @@ -49,13 +62,13 @@ importFrom(janitor,make_clean_names) importFrom(lifecycle,deprecated) importFrom(magrittr,"%>%") importFrom(magrittr,extract2) +importFrom(purrr,iwalk) importFrom(purrr,map) importFrom(purrr,map2_chr) importFrom(purrr,map_chr) importFrom(purrr,map_dbl) importFrom(purrr,pluck) importFrom(purrr,walk) -importFrom(purrr,walk2) importFrom(readr,parse_number) importFrom(stringr,str_detect) importFrom(stringr,str_extract) diff --git a/NEWS.md b/NEWS.md index abea5cfc..dabb29bb 100644 --- a/NEWS.md +++ b/NEWS.md @@ -7,13 +7,13 @@ * Added a check for character variable lengths up to 200 bytes in `xpt_validate()`(#91, #189). * File name check is moved to strict_checks condition to allow underscores in the file name. Underscores are allowed in xpt but not per FDA requirements. (#126) * It is now possible to get and set the xportr options using the helper function `xportr_options()` (#130) +* Adds argument assertions to public functions using `{checkmate}` (#175) ## Deprecation and Breaking Changes * The `domain` argument for xportr functions will no longer be dynamically determined by the name of the data frame passed as the .df argument. This was done to make the use of xportr functions more explicit. (#182) - * The `label` argument from the `xportr_write()` function is deprecated in favor of the `metadata` argument. (#179) * The `metacore` argument, which was renamed to `metadata` in the following six xportr functions: (`xportr_df_label()`, `xportr_format()`, `xportr_label()`, `xportr_length()`, `xportr_order()`, and `xportr_type()`) in version `0.3.0` with a soft deprecation warning, has now been hard deprecated. Please update your code to use the new `metadata` argument in place of `metacore`. diff --git a/R/df_label.R b/R/df_label.R index b14d5ef4..81a115ec 100644 --- a/R/df_label.R +++ b/R/df_label.R @@ -50,24 +50,24 @@ xportr_df_label <- function(.df, with = "xportr_df_label(metadata = )" ) } - domain_name <- getOption("xportr.df_domain_name") - label_name <- getOption("xportr.df_label") - ## Common section to detect domain from argument or attribute + ## Common section to detect default arguments - domain <- get_domain(.df, domain) + domain <- domain %||% attr(.df, "_xportr.df_arg_") if (!is.null(domain)) attr(.df, "_xportr.df_arg_") <- domain + metadata <- metadata %||% attr(.df, "_xportr.df_metadata_") + ## End of common section - ## Pull out correct metadata - metadata <- metadata %||% - attr(.df, "_xportr.df_metadata_") %||% - rlang::abort("Metadata must be set with `metadata` or `xportr_metadata()`") + assert_data_frame(.df) + assert_string(domain, null.ok = TRUE) + assert_metadata(metadata) - if (inherits(metadata, "Metacore")) { - metadata <- metadata$ds_spec - } + domain_name <- getOption("xportr.df_domain_name") + label_name <- getOption("xportr.df_label") + + if (inherits(metadata, "Metacore")) metadata <- metadata$ds_spec label <- metadata %>% filter(!!sym(domain_name) == domain) %>% @@ -75,9 +75,7 @@ xportr_df_label <- function(.df, # If a dataframe is used this will also be a dataframe, change to character. as.character() - label_len <- nchar(label) - - if (label_len > 40) { + if (!test_string(label, max.chars = 40)) { abort("Length of dataset label must be 40 characters or less.") } diff --git a/R/format.R b/R/format.R index 4e4c37c8..775e0e60 100644 --- a/R/format.R +++ b/R/format.R @@ -52,24 +52,25 @@ xportr_format <- function(.df, with = "xportr_format(metadata = )" ) } - domain_name <- getOption("xportr.domain_name") - format_name <- getOption("xportr.format_name") - variable_name <- getOption("xportr.variable_name") - ## Common section to detect domain from argument or attribute + ## Common section to detect default arguments - domain <- get_domain(.df, domain) + domain <- domain %||% attr(.df, "_xportr.df_arg_") if (!is.null(domain)) attr(.df, "_xportr.df_arg_") <- domain + metadata <- metadata %||% attr(.df, "_xportr.df_metadata_") + ## End of common section - metadata <- metadata %||% - attr(.df, "_xportr.df_metadata_") %||% - rlang::abort("Metadata must be set with `metadata` or `xportr_metadata()`") + assert_data_frame(.df) + assert_string(domain, null.ok = TRUE) + assert_metadata(metadata) - if (inherits(metadata, "Metacore")) { - metadata <- metadata$var_spec - } + domain_name <- getOption("xportr.domain_name") + format_name <- getOption("xportr.format_name") + variable_name <- getOption("xportr.variable_name") + + if (inherits(metadata, "Metacore")) metadata <- metadata$var_spec if (domain_name %in% names(metadata) && !is.null(domain)) { metadata <- metadata %>% diff --git a/R/label.R b/R/label.R index 6724e53d..f570bc56 100644 --- a/R/label.R +++ b/R/label.R @@ -68,24 +68,26 @@ xportr_label <- function(.df, with = "xportr_label(metadata = )" ) } - domain_name <- getOption("xportr.domain_name") - variable_name <- getOption("xportr.variable_name") - variable_label <- getOption("xportr.label") - ## Common section to detect domain from argument or attribute + ## Common section to detect default arguments - domain <- get_domain(.df, domain) + domain <- domain %||% attr(.df, "_xportr.df_arg_") if (!is.null(domain)) attr(.df, "_xportr.df_arg_") <- domain + metadata <- metadata %||% attr(.df, "_xportr.df_metadata_") + ## End of common section - metadata <- metadata %||% - attr(.df, "_xportr.df_metadata_") %||% - rlang::abort("Metadata must be set with `metadata` or `xportr_metadata()`") + assert_data_frame(.df) + assert_string(domain, null.ok = TRUE) + assert_metadata(metadata) + assert_choice(verbose, choices = .internal_verbose_choices) - if (inherits(metadata, "Metacore")) { - metadata <- metadata$var_spec - } + domain_name <- getOption("xportr.domain_name") + variable_name <- getOption("xportr.variable_name") + variable_label <- getOption("xportr.label") + + if (inherits(metadata, "Metacore")) metadata <- metadata$var_spec if (domain_name %in% names(metadata) && !is.null(domain)) { metadata <- metadata %>% @@ -117,10 +119,10 @@ xportr_label <- function(.df, } for (i in names(.df)) { - if (i %in% miss_vars) { - attr(.df[[i]], "label") <- "" + attr(.df[[i]], "label") <- if (i %in% miss_vars) { + "" } else { - attr(.df[[i]], "label") <- label[[i]] + label[[i]] } } diff --git a/R/length.R b/R/length.R index 21ea95d4..fa5ae278 100644 --- a/R/length.R +++ b/R/length.R @@ -75,24 +75,26 @@ xportr_length <- function(.df, with = "xportr_length(metadata = )" ) } - domain_name <- getOption("xportr.domain_name") - variable_length <- getOption("xportr.length") - variable_name <- getOption("xportr.variable_name") - ## Common section to detect domain from argument or attribute + ## Common section to detect default arguments - domain <- get_domain(.df, domain) + domain <- domain %||% attr(.df, "_xportr.df_arg_") if (!is.null(domain)) attr(.df, "_xportr.df_arg_") <- domain + metadata <- metadata %||% attr(.df, "_xportr.df_metadata_") + ## End of common section - metadata <- metadata %||% - attr(.df, "_xportr.df_metadata_") %||% - rlang::abort("Metadata must be set with `metadata` or `xportr_metadata()`") + assert_data_frame(.df) + assert_string(domain, null.ok = TRUE) + assert_metadata(metadata) + assert_choice(verbose, choices = .internal_verbose_choices) - if (inherits(metadata, "Metacore")) { - metadata <- metadata$var_spec - } + domain_name <- getOption("xportr.domain_name") + variable_length <- getOption("xportr.length") + variable_name <- getOption("xportr.variable_name") + + if (inherits(metadata, "Metacore")) metadata <- metadata$var_spec if (domain_name %in% names(metadata) && !is.null(domain)) { metadata <- metadata %>% @@ -102,7 +104,6 @@ xportr_length <- function(.df, check_multiple_var_specs(metadata, variable_name) } - # Check any variables missed in metadata but present in input data --- miss_vars <- setdiff(names(.df), metadata[[variable_name]]) diff --git a/R/messages.R b/R/messages.R index 6c4e21c0..50b4df7c 100644 --- a/R/messages.R +++ b/R/messages.R @@ -10,6 +10,9 @@ #' @return Output to Console #' @export xportr_logger <- function(message, type = "none", ...) { + assert_character(message) + assert_choice(type, choices = .internal_verbose_choices) + log_fun <- switch(type, stop = abort, warn = warn, @@ -28,6 +31,9 @@ xportr_logger <- function(message, type = "none", ...) { #' @return Output to Console #' @export var_names_log <- function(tidy_names_df, verbose) { + assert_data_frame(tidy_names_df) + assert_choice(verbose, choices = .internal_verbose_choices) + only_renames <- tidy_names_df %>% filter(original_varname != renamed_var) %>% mutate( @@ -76,6 +82,10 @@ var_names_log <- function(tidy_names_df, verbose) { #' @return Output to Console #' @export type_log <- function(meta_ordered, type_mismatch_ind, verbose) { + assert_data_frame(meta_ordered) + assert_integer(type_mismatch_ind) + assert_choice(verbose, choices = .internal_verbose_choices) + if (length(type_mismatch_ind) > 0) { cli_h2("Variable type mismatches found.") cli_alert_success("{ length(type_mismatch_ind) } variables coerced") @@ -97,6 +107,9 @@ type_log <- function(meta_ordered, type_mismatch_ind, verbose) { #' @return Output to Console #' @export length_log <- function(miss_vars, verbose) { + assert_character(miss_vars) + assert_choice(verbose, choices = .internal_verbose_choices) + if (length(miss_vars) > 0) { cli_h2("Variable lengths missing from metadata.") cli_alert_success("{ length(miss_vars) } lengths resolved") @@ -119,6 +132,9 @@ length_log <- function(miss_vars, verbose) { #' @return Output to Console #' @export label_log <- function(miss_vars, verbose) { + assert_character(miss_vars) + assert_choice(verbose, choices = .internal_verbose_choices) + if (length(miss_vars) > 0) { cli_h2("Variable labels missing from metadata.") cli_alert_success("{ length(miss_vars) } labels skipped") @@ -141,6 +157,10 @@ label_log <- function(miss_vars, verbose) { #' @return Output to Console #' @export var_ord_msg <- function(reordered_vars, moved_vars, verbose) { + assert_character(reordered_vars) + assert_character(moved_vars) + assert_choice(verbose, choices = .internal_verbose_choices) + if (length(moved_vars) > 0) { cli_h2("{ length(moved_vars) } variables not in spec and moved to end") message <- glue( diff --git a/R/metadata.R b/R/metadata.R index df206ef2..9211cca6 100644 --- a/R/metadata.R +++ b/R/metadata.R @@ -42,14 +42,19 @@ #' } xportr_metadata <- function(.df, metadata = NULL, domain = NULL) { if (is.null(metadata) && is.null(domain)) { - stop("Must provide either metadata or domain argument") + stop("Assertion failed on `metadata` and `domain`: Must provide either `metadata` or `domain` argument") } - ## Common section to detect domain from argument or attribute - domain <- get_domain(.df, domain) + ## Common section to detect default arguments + + domain <- domain %||% attr(.df, "_xportr.df_arg_") if (!is.null(domain)) attr(.df, "_xportr.df_arg_") <- domain ## End of common section + assert_data_frame(.df) + assert_metadata(metadata, include_fun_message = FALSE, null.ok = TRUE) + assert_string(domain, null.ok = TRUE) + structure(.df, `_xportr.df_metadata_` = metadata) } diff --git a/R/order.R b/R/order.R index 3f1842c1..84903466 100644 --- a/R/order.R +++ b/R/order.R @@ -71,24 +71,26 @@ xportr_order <- function(.df, with = "xportr_order(metadata = )" ) } - domain_name <- getOption("xportr.domain_name") - order_name <- getOption("xportr.order_name") - variable_name <- getOption("xportr.variable_name") - ## Common section to detect domain from argument or attribute + ## Common section to detect default arguments - domain <- get_domain(.df, domain) + domain <- domain %||% attr(.df, "_xportr.df_arg_") if (!is.null(domain)) attr(.df, "_xportr.df_arg_") <- domain + metadata <- metadata %||% attr(.df, "_xportr.df_metadata_") + ## End of common section - metadata <- metadata %||% - attr(.df, "_xportr.df_metadata_") %||% - rlang::abort("Metadata must be set with `metadata` or `xportr_metadata()`") + assert_data_frame(.df) + assert_string(domain, null.ok = TRUE) + assert_metadata(metadata) + assert_choice(verbose, choices = .internal_verbose_choices) - if (inherits(metadata, "Metacore")) { - metadata <- metadata$ds_vars - } + domain_name <- getOption("xportr.domain_name") + order_name <- getOption("xportr.order_name") + variable_name <- getOption("xportr.variable_name") + + if (inherits(metadata, "Metacore")) metadata <- metadata$ds_vars if (domain_name %in% names(metadata) && !is.null(domain)) { metadata <- metadata %>% diff --git a/R/type.R b/R/type.R index c0198e20..919b30a2 100644 --- a/R/type.R +++ b/R/type.R @@ -89,6 +89,21 @@ xportr_type <- function(.df, with = "xportr_type(metadata = )" ) } + + ## Common section to detect default arguments + + domain <- domain %||% attr(.df, "_xportr.df_arg_") + if (!is.null(domain)) attr(.df, "_xportr.df_arg_") <- domain + + metadata <- metadata %||% attr(.df, "_xportr.df_metadata_") + + ## End of common section + + assert_data_frame(.df) + assert_string(domain, null.ok = TRUE) + assert_metadata(metadata) + assert_choice(verbose, choices = .internal_verbose_choices) + # Name of the columns for working with metadata domain_name <- getOption("xportr.domain_name") variable_name <- getOption("xportr.variable_name") @@ -97,21 +112,7 @@ xportr_type <- function(.df, numericTypes <- c(getOption("xportr.numeric_types"), "_numeric") format_name <- getOption("xportr.format_name") - ## Common section to detect domain from argument or attribute - - domain <- get_domain(.df, domain) - if (!is.null(domain)) attr(.df, "_xportr.df_arg_") <- domain - - ## End of common section - - ## Pull out correct metadata - metadata <- metadata %||% - attr(.df, "_xportr.df_metadata_") %||% - rlang::abort("Metadata must be set with `metadata` or `xportr_metadata()`") - - if (inherits(metadata, "Metacore")) { - metadata <- metadata$var_spec - } + if (inherits(metadata, "Metacore")) metadata <- metadata$var_spec if (domain_name %in% names(metadata) && !is.null(domain)) { metadata <- metadata %>% @@ -155,14 +156,14 @@ xportr_type <- function(.df, type_log(meta_ordered, type_mismatch_ind, verbose) # Check if variable types match - is_correct <- sapply(meta_ordered[["type.x"]] == meta_ordered[["type.y"]], isTRUE) + is_correct <- vapply(meta_ordered[["type.x"]] == meta_ordered[["type.y"]], isTRUE, logical(1)) # Use the original variable iff metadata is missing that variable correct_type <- ifelse(is.na(meta_ordered[["type.y"]]), meta_ordered[["type.x"]], meta_ordered[["type.y"]]) # Walk along the columns and coerce the variables. Modifying the columns # Directly instead of something like map_dfc to preserve any attributes. - walk2( - correct_type, seq_along(correct_type), + iwalk( + correct_type, function(x, i, is_correct) { if (!is_correct[i]) { orig_attributes <- attributes(.df[[i]]) diff --git a/R/utils-xportr.R b/R/utils-xportr.R index 38a29dd3..19086b4c 100644 --- a/R/utils-xportr.R +++ b/R/utils-xportr.R @@ -184,6 +184,8 @@ xpt_validate_var_names <- function(varnames, #' #' @export xpt_validate <- function(data) { + assert_data_frame(data) + err_cnd <- character() # 1.0 VARIABLES ---- @@ -317,21 +319,6 @@ xpt_validate <- function(data) { return(err_cnd) } -#' Get the domain from argument or from the existing domain attr -#' -#' @return A string representing the domain -#' @noRd -get_domain <- function(.df, domain) { - if (!is.null(domain) && !is.character(domain)) { - abort(c("`domain` must be a vector with type .", - x = glue("Instead, it has type <{typeof(domain)}>.") - )) - } - - result <- domain %||% attr(.df, "_xportr.df_arg_") - result -} - #' Get Origin Object of a Series of Pipes #' #' @return The R Object at the top of a pipe stack @@ -384,3 +371,53 @@ check_multiple_var_specs <- function(metadata, ) } } + +#' Custom check for metadata object +#' +#' Improvement on the message clarity over the default assert(...) messages. +#' @noRd +#' @param metadata A data frame or `Metacore` object containing variable level +#' @inheritParams checkmate::check_logical +#' metadata. +check_metadata <- function(metadata, include_fun_message, null.ok = FALSE) { + if (is.null(metadata) && null.ok) { + return(TRUE) + } + + extra_string <- ", 'Metacore' or set via 'xportr_metadata()'" + if (!include_fun_message) { + extra_string <- " or 'Metacore'" + } + + if (!inherits(metadata, "Metacore") && !test_data_frame(metadata)) { + return( + glue( + "Must be of type 'data.frame'{extra_string},", + " not `{paste(class(metadata), collapse = '/')}" + ) + ) + } + TRUE +} + +#' Custom assertion for metadata object +#' @noRd +#' @param metadata A data frame or `Metacore` object containing variable level +#' @inheritParams checkmate::check_logical +#' metadata. +assert_metadata <- function(metadata, + include_fun_message = TRUE, + null.ok = FALSE, + add = NULL, + .var.name = vname(metadata)) { + makeAssertion( + metadata, + check_metadata(metadata, include_fun_message, null.ok), + var.name = .var.name, + collection = add + ) +} + +#' Internal choices for verbose option +#' @noRd +.internal_verbose_choices <- c("none", "warn", "message", "stop") diff --git a/R/write.R b/R/write.R index ae38b8e3..ec201acb 100644 --- a/R/write.R +++ b/R/write.R @@ -52,31 +52,40 @@ xportr_write <- function(.df, domain = NULL, strict_checks = FALSE, label = deprecated()) { - path <- normalizePath(path, mustWork = FALSE) - - name <- tools::file_path_sans_ext(basename(path)) - - ## Common section to detect domain from argument or attribute - - domain <- get_domain(.df, domain) - if (!is.null(domain)) attr(.df, "_xportr.df_arg_") <- domain - - ## End of common section - if (!missing(label)) { lifecycle::deprecate_warn( when = "0.3.2", what = "xportr_write(label = )", with = "xportr_write(metadata = )" ) + assert_string(label, null.ok = TRUE, max.chars = 40) metadata <- data.frame(dataset = domain, label = label) } + + ## Common section to detect default arguments + + domain <- domain %||% attr(.df, "_xportr.df_arg_") + if (!is.null(domain)) attr(.df, "_xportr.df_arg_") <- domain + + metadata <- metadata %||% attr(.df, "_xportr.df_metadata_") + + ## End of common section + + assert_data_frame(.df) + assert_string(path) + assert_metadata(metadata, null.ok = TRUE) + assert_logical(strict_checks) + + path <- normalizePath(path, mustWork = FALSE) + + name <- tools::file_path_sans_ext(basename(path)) + if (!is.null(metadata)) { .df <- xportr_df_label(.df, metadata = metadata, domain = domain) } if (nchar(name) > 8) { - abort("`.df` file name must be 8 characters or less.") + assert(".df file name must be 8 characters or less.", .var.name = "path") } checks <- xpt_validate(.df) diff --git a/R/xportr-package.R b/R/xportr-package.R index 0cfdd46d..7ffeafcb 100644 --- a/R/xportr-package.R +++ b/R/xportr-package.R @@ -103,12 +103,14 @@ #' @importFrom utils capture.output str tail packageVersion #' @importFrom stringr str_detect str_extract str_replace str_replace_all #' @importFrom readr parse_number -#' @importFrom purrr map_chr map2_chr walk walk2 map map_dbl pluck +#' @importFrom purrr map_chr map2_chr walk iwalk map map_dbl pluck #' @importFrom janitor make_clean_names #' @importFrom tm stemDocument #' @importFrom graphics stem #' @importFrom magrittr %>% extract2 -#' +#' @importFrom checkmate assert assert_character assert_choice assert_data_frame +#' assert_integer assert_logical assert_string makeAssertion check_data_frame +#' check_r6 test_data_frame test_string vname "_PACKAGE" globalVariables(c( diff --git a/tests/testthat/test-df_label.R b/tests/testthat/test-df_label.R index eae3969d..2cbe1736 100644 --- a/tests/testthat/test-df_label.R +++ b/tests/testthat/test-df_label.R @@ -9,6 +9,6 @@ test_that("xportr_df_label: error when metadata is not set", { expect_error( xportr_df_label(adsl), - regexp = "Metadata must be set with `metadata` or `xportr_metadata\\(\\)`" + regexp = "Must be of type 'data.frame', 'Metacore' or set via 'xportr_metadata\\(\\)'" ) }) diff --git a/tests/testthat/test-format.R b/tests/testthat/test-format.R index a311a8c4..63b4ff92 100644 --- a/tests/testthat/test-format.R +++ b/tests/testthat/test-format.R @@ -6,7 +6,7 @@ test_that("xportr_format: error when metadata is not set", { expect_error( xportr_format(adsl), - regexp = "Metadata must be set with `metadata` or `xportr_metadata\\(\\)`" + regexp = "Must be of type 'data.frame', 'Metacore' or set via 'xportr_metadata\\(\\)'" ) }) diff --git a/tests/testthat/test-label.R b/tests/testthat/test-label.R index cd0fc30b..bb0a9e3b 100644 --- a/tests/testthat/test-label.R +++ b/tests/testthat/test-label.R @@ -8,7 +8,7 @@ test_that("xportr_label: error when metadata is not set", { expect_error( xportr_label(df), - regexp = "Metadata must be set with `metadata` or `xportr_metadata\\(\\)`" + regexp = "Must be of type 'data.frame', 'Metacore' or set via 'xportr_metadata\\(\\)'" ) }) diff --git a/tests/testthat/test-length.R b/tests/testthat/test-length.R index e3adce3f..481b145a 100644 --- a/tests/testthat/test-length.R +++ b/tests/testthat/test-length.R @@ -179,7 +179,7 @@ test_that("xportr_length: error when metadata is not set", { expect_error( xportr_length(adsl), - regexp = "Metadata must be set with `metadata` or `xportr_metadata\\(\\)`" + regexp = "Must be of type 'data.frame', 'Metacore' or set via 'xportr_metadata\\(\\)'" ) }) diff --git a/tests/testthat/test-metadata.R b/tests/testthat/test-metadata.R index e50a0741..1ebf4e97 100644 --- a/tests/testthat/test-metadata.R +++ b/tests/testthat/test-metadata.R @@ -146,11 +146,11 @@ test_that("xportr_label: Expect error if domain is not a character", { expect_error( xportr_label(df, df_meta, domain = 1), - "`domain` must be a vector with type ." + "Assertion on 'domain' failed: Must be of type 'string' \\(or 'NULL'\\), not '.*'\\." ) expect_error( xportr_label(df, df_meta, domain = NA), - "`domain` must be a vector with type ." + "Assertion on 'domain' failed: May not be NA\\." ) }) @@ -258,11 +258,11 @@ test_that("xportr_df_label: Expect error if domain is not a character", { expect_error( xportr_df_label(df, df_meta, domain = 1), - "`domain` must be a vector with type ." + "Assertion on 'domain' failed: Must be of type 'string' \\(or 'NULL'\\), not '.*'\\." ) expect_error( xportr_df_label(df, df_meta, domain = NA), - "`domain` must be a vector with type ." + "Assertion on 'domain' failed: May not be NA\\." ) }) @@ -386,11 +386,11 @@ test_that("xportr_format: Expect error if domain is not a character", { expect_error( xportr_format(df, df_meta, 1), - "`domain` must be a vector with type ." + "Assertion on 'domain' failed: Must be of type 'string' \\(or 'NULL'\\), not '.*'\\." ) expect_error( xportr_format(df, df_meta, NA), - "`domain` must be a vector with type ." + "Assertion on 'domain' failed: May not be NA\\." ) }) @@ -536,11 +536,11 @@ test_that("xportr_length: Expect error if domain is not a character", { expect_error( xportr_length(df, df_meta, 1), - "`domain` must be a vector with type ." + "Assertion on 'domain' failed: Must be of type 'string' \\(or 'NULL'\\), not '.*'\\." ) expect_error( xportr_length(df, df_meta, NA), - "`domain` must be a vector with type ." + "Assertion on 'domain' failed: May not be NA\\." ) }) @@ -610,7 +610,7 @@ test_that("xportr_metadata: Check metadata interaction with other functions", { test_that("xportr_metadata: must throw error if both metadata and domain are null", { expect_error( xportr_metadata(data.frame(), metadata = NULL, domain = NULL), - "Must provide either metadata or domain argument" + "Must provide either `metadata` or `domain` argument" ) }) diff --git a/tests/testthat/test-order.R b/tests/testthat/test-order.R index 1c68feef..9f7a08f6 100644 --- a/tests/testthat/test-order.R +++ b/tests/testthat/test-order.R @@ -106,7 +106,7 @@ test_that("xportr_order: error when metadata is not set", { expect_error( xportr_order(df), - regexp = "Metadata must be set with `metadata` or `xportr_metadata\\(\\)`" + regexp = "Must be of type 'data.frame', 'Metacore' or set via 'xportr_metadata\\(\\)'" ) }) diff --git a/tests/testthat/test-type.R b/tests/testthat/test-type.R index aa31baf1..9d9580b3 100644 --- a/tests/testthat/test-type.R +++ b/tests/testthat/test-type.R @@ -210,7 +210,7 @@ test_that("xportr_type: works fine from metacore spec", { test_that("xportr_type: error when metadata is not set", { expect_error( xportr_type(df), - regexp = "Metadata must be set with `metadata` or `xportr_metadata\\(\\)`" + regexp = "Must be of type 'data.frame', 'Metacore' or set via 'xportr_metadata\\(\\)'" ) }) diff --git a/tests/testthat/test-write.R b/tests/testthat/test-write.R index d53c7eb0..31837977 100644 --- a/tests/testthat/test-write.R +++ b/tests/testthat/test-write.R @@ -96,7 +96,7 @@ test_that("xportr_write: expect error when file name contains non-ASCII symbols on.exit(unlink(tmpdir)) - expect_error(xportr_write(data_to_save, tmp)) + expect_error(xportr_write(data_to_save, tmp, strict_checks = TRUE)) }) test_that("xportr_write: expect warning when file name contains underscore and strict_checks = FALSE", {