diff --git a/DESCRIPTION b/DESCRIPTION index abec80d86..8aac216e5 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -14,7 +14,9 @@ Authors@R: c( person("Richard", "Iannone", , "rich@posit.co", c("aut", "cre"), comment = c(ORCID = "0000-0003-3925-190X")), person("Mauricio", "Vargas", , "mavargas11@uc.cl", c("aut"), - comment = c(ORCID = "0000-0003-1017-7574")) + comment = c(ORCID = "0000-0003-1017-7574")), + person("June", "Choe", , "jchoe001@gmail.com", c("aut"), + comment = c(ORCID = "0000-0002-0701-921X")) ) License: MIT + file LICENSE URL: https://rstudio.github.io/pointblank/, https://github.com/rstudio/pointblank diff --git a/R/col_exists.R b/R/col_exists.R index 4ef95ab1e..fe214ef5a 100644 --- a/R/col_exists.R +++ b/R/col_exists.R @@ -234,24 +234,25 @@ col_exists <- function( rlang::as_label(rlang::quo(!!enquo(columns))) %>% gsub("^\"|\"$", "", .) - # Normalize the `columns` expression - if (inherits(columns, "quosures")) { - - columns <- - vapply( - columns, - FUN.VALUE = character(1), - USE.NAMES = FALSE, - FUN = function(x) as.character(rlang::get_expr(x)) - ) + # Capture the `columns` expression + columns <- rlang::enquo(columns) + if (rlang::quo_is_null(columns)) { + columns <- rlang::quo(tidyselect::everything()) } + + # Resolve the columns based on the expression + ## Only for `col_exists()`: error gracefully if column not found + columns <- tryCatch( + expr = resolve_columns(x = x, var_expr = columns, preconditions = NULL), + error = function(cnd) cnd$i %||% NA_character_ + ) if (is_a_table_object(x)) { secret_agent <- create_agent(x, label = "::QUIET::") %>% col_exists( - columns = columns, + columns = tidyselect::all_of(columns), actions = prime_actions(actions), label = label, brief = brief, diff --git a/R/col_is_character.R b/R/col_is_character.R index 633f5b72d..e3bae6a00 100644 --- a/R/col_is_character.R +++ b/R/col_is_character.R @@ -242,7 +242,7 @@ col_is_character <- function( secret_agent <- create_agent(x, label = "::QUIET::") %>% col_is_character( - columns = columns, + columns = tidyselect::all_of(columns), label = label, brief = brief, actions = prime_actions(actions), diff --git a/R/col_is_date.R b/R/col_is_date.R index 1666077ba..3d51e7961 100644 --- a/R/col_is_date.R +++ b/R/col_is_date.R @@ -234,7 +234,7 @@ col_is_date <- function( secret_agent <- create_agent(x, label = "::QUIET::") %>% col_is_date( - columns = columns, + columns = tidyselect::all_of(columns), label = label, brief = brief, actions = prime_actions(actions), diff --git a/R/col_is_factor.R b/R/col_is_factor.R index 849b566b0..1ad7ca584 100644 --- a/R/col_is_factor.R +++ b/R/col_is_factor.R @@ -240,7 +240,7 @@ col_is_factor <- function( secret_agent <- create_agent(x, label = "::QUIET::") %>% col_is_factor( - columns = columns, + columns = tidyselect::all_of(columns), label = label, brief = brief, actions = prime_actions(actions), diff --git a/R/col_is_integer.R b/R/col_is_integer.R index be3a50b9b..240b4fed4 100644 --- a/R/col_is_integer.R +++ b/R/col_is_integer.R @@ -238,7 +238,7 @@ col_is_integer <- function( secret_agent <- create_agent(x, label = "::QUIET::") %>% col_is_integer( - columns = columns, + columns = tidyselect::all_of(columns), label = label, brief = brief, actions = prime_actions(actions), diff --git a/R/col_is_logical.R b/R/col_is_logical.R index 87098f42b..ccfe8631f 100644 --- a/R/col_is_logical.R +++ b/R/col_is_logical.R @@ -235,7 +235,7 @@ col_is_logical <- function( secret_agent <- create_agent(x, label = "::QUIET::") %>% col_is_logical( - columns = columns, + columns = tidyselect::all_of(columns), label = label, brief = brief, actions = prime_actions(actions), diff --git a/R/col_is_numeric.R b/R/col_is_numeric.R index 2d56ca554..c74fec3ea 100644 --- a/R/col_is_numeric.R +++ b/R/col_is_numeric.R @@ -235,7 +235,7 @@ col_is_numeric <- function( secret_agent <- create_agent(x, label = "::QUIET::") %>% col_is_numeric( - columns = columns, + columns = tidyselect::all_of(columns), label = label, brief = brief, actions = prime_actions(actions), diff --git a/R/col_is_posix.R b/R/col_is_posix.R index c0c232387..827922af2 100644 --- a/R/col_is_posix.R +++ b/R/col_is_posix.R @@ -235,7 +235,7 @@ col_is_posix <- function( secret_agent <- create_agent(x, label = "::QUIET::") %>% col_is_posix( - columns = columns, + columns = tidyselect::all_of(columns), label = label, brief = brief, actions = prime_actions(actions), diff --git a/R/col_vals_between.R b/R/col_vals_between.R index 2f6935473..62191977d 100644 --- a/R/col_vals_between.R +++ b/R/col_vals_between.R @@ -393,7 +393,7 @@ col_vals_between <- function( secret_agent <- create_agent(x, label = "::QUIET::") %>% col_vals_between( - columns = columns, + columns = tidyselect::all_of(columns), left = left, right = right, inclusive = inclusive, diff --git a/R/col_vals_decreasing.R b/R/col_vals_decreasing.R index 1faeff33a..4fee5e15f 100644 --- a/R/col_vals_decreasing.R +++ b/R/col_vals_decreasing.R @@ -379,7 +379,7 @@ col_vals_decreasing <- function( secret_agent <- create_agent(x, label = "::QUIET::") %>% col_vals_decreasing( - columns = columns, + columns = tidyselect::all_of(columns), allow_stationary = allow_stationary, increasing_tol = increasing_tol, na_pass = na_pass, diff --git a/R/col_vals_equal.R b/R/col_vals_equal.R index b5aac3770..2c30d19d7 100644 --- a/R/col_vals_equal.R +++ b/R/col_vals_equal.R @@ -332,7 +332,7 @@ col_vals_equal <- function( secret_agent <- create_agent(x, label = "::QUIET::") %>% col_vals_equal( - columns = columns, + columns = tidyselect::all_of(columns), value = value, na_pass = na_pass, preconditions = preconditions, diff --git a/R/col_vals_gt.R b/R/col_vals_gt.R index f41e404d4..0fe3c306f 100644 --- a/R/col_vals_gt.R +++ b/R/col_vals_gt.R @@ -452,7 +452,7 @@ col_vals_gt <- function( secret_agent <- create_agent(x, label = "::QUIET::") %>% col_vals_gt( - columns = columns, + columns = tidyselect::all_of(columns), value = value, na_pass = na_pass, preconditions = preconditions, diff --git a/R/col_vals_gte.R b/R/col_vals_gte.R index 308f07f95..78445b68b 100644 --- a/R/col_vals_gte.R +++ b/R/col_vals_gte.R @@ -331,7 +331,7 @@ col_vals_gte <- function( secret_agent <- create_agent(x, label = "::QUIET::") %>% col_vals_gte( - columns = columns, + columns = tidyselect::all_of(columns), value = value, na_pass = na_pass, preconditions = preconditions, diff --git a/R/col_vals_in_set.R b/R/col_vals_in_set.R index 1e175df3e..2abf8da8b 100644 --- a/R/col_vals_in_set.R +++ b/R/col_vals_in_set.R @@ -325,7 +325,7 @@ col_vals_in_set <- function( secret_agent <- create_agent(x, label = "::QUIET::") %>% col_vals_in_set( - columns = columns, + columns = tidyselect::all_of(columns), set = set, preconditions = preconditions, segments = segments, diff --git a/R/col_vals_increasing.R b/R/col_vals_increasing.R index eb12d06b1..40f23a96b 100644 --- a/R/col_vals_increasing.R +++ b/R/col_vals_increasing.R @@ -367,7 +367,7 @@ col_vals_increasing <- function( secret_agent <- create_agent(x, label = "::QUIET::") %>% col_vals_increasing( - columns = columns, + columns = tidyselect::all_of(columns), allow_stationary = allow_stationary, decreasing_tol = decreasing_tol, na_pass = na_pass, diff --git a/R/col_vals_lt.R b/R/col_vals_lt.R index 769752c3d..d4ffd9394 100644 --- a/R/col_vals_lt.R +++ b/R/col_vals_lt.R @@ -333,7 +333,7 @@ col_vals_lt <- function( secret_agent <- create_agent(x, label = "::QUIET::") %>% col_vals_lt( - columns = columns, + columns = tidyselect::all_of(columns), value = value, na_pass = na_pass, preconditions = preconditions, diff --git a/R/col_vals_lte.R b/R/col_vals_lte.R index d90627893..016741ca7 100644 --- a/R/col_vals_lte.R +++ b/R/col_vals_lte.R @@ -334,7 +334,7 @@ col_vals_lte <- function( secret_agent <- create_agent(x, label = "::QUIET::") %>% col_vals_lte( - columns = columns, + columns = tidyselect::all_of(columns), value = value, na_pass = na_pass, preconditions = preconditions, diff --git a/R/col_vals_make_set.R b/R/col_vals_make_set.R index 93c642ee5..66132201f 100644 --- a/R/col_vals_make_set.R +++ b/R/col_vals_make_set.R @@ -327,7 +327,7 @@ col_vals_make_set <- function( secret_agent <- create_agent(x, label = "::QUIET::") %>% col_vals_make_set( - columns = columns, + columns = tidyselect::all_of(columns), set = set, preconditions = preconditions, segments = segments, diff --git a/R/col_vals_make_subset.R b/R/col_vals_make_subset.R index b2ac3dae3..628548cc9 100644 --- a/R/col_vals_make_subset.R +++ b/R/col_vals_make_subset.R @@ -324,7 +324,7 @@ col_vals_make_subset <- function( secret_agent <- create_agent(x, label = "::QUIET::") %>% col_vals_make_subset( - columns = columns, + columns = tidyselect::all_of(columns), set = set, preconditions = preconditions, segments = segments, diff --git a/R/col_vals_not_between.R b/R/col_vals_not_between.R index e1614ddb9..8730e2da4 100644 --- a/R/col_vals_not_between.R +++ b/R/col_vals_not_between.R @@ -396,7 +396,7 @@ col_vals_not_between <- function( secret_agent <- create_agent(x, label = "::QUIET::") %>% col_vals_not_between( - columns = columns, + columns = tidyselect::all_of(columns), left = left, right = right, inclusive = inclusive, diff --git a/R/col_vals_not_equal.R b/R/col_vals_not_equal.R index 8aa151bbd..0ce95f453 100644 --- a/R/col_vals_not_equal.R +++ b/R/col_vals_not_equal.R @@ -331,7 +331,7 @@ col_vals_not_equal <- function( secret_agent <- create_agent(x, label = "::QUIET::") %>% col_vals_not_equal( - columns = columns, + columns = tidyselect::all_of(columns), value = value, na_pass = na_pass, preconditions = preconditions, diff --git a/R/col_vals_not_in_set.R b/R/col_vals_not_in_set.R index eaf136bf2..1911f80ff 100644 --- a/R/col_vals_not_in_set.R +++ b/R/col_vals_not_in_set.R @@ -321,7 +321,7 @@ col_vals_not_in_set <- function( secret_agent <- create_agent(x, label = "::QUIET::") %>% col_vals_not_in_set( - columns = columns, + columns = tidyselect::all_of(columns), set = set, preconditions = preconditions, segments = segments, diff --git a/R/col_vals_not_null.R b/R/col_vals_not_null.R index 008c1afd1..fcd0735bf 100644 --- a/R/col_vals_not_null.R +++ b/R/col_vals_not_null.R @@ -312,7 +312,7 @@ col_vals_not_null <- function( secret_agent <- create_agent(x, label = "::QUIET::") %>% col_vals_not_null( - columns = columns, + columns = tidyselect::all_of(columns), preconditions = preconditions, segments = segments, label = label, diff --git a/R/col_vals_null.R b/R/col_vals_null.R index 678df26b2..2b1731de1 100644 --- a/R/col_vals_null.R +++ b/R/col_vals_null.R @@ -311,7 +311,7 @@ col_vals_null <- function( secret_agent <- create_agent(x, label = "::QUIET::") %>% col_vals_null( - columns = columns, + columns = tidyselect::all_of(columns), preconditions = preconditions, segments = segments, label = label, diff --git a/R/col_vals_regex.R b/R/col_vals_regex.R index 0be8cd6c1..e107b2390 100644 --- a/R/col_vals_regex.R +++ b/R/col_vals_regex.R @@ -325,7 +325,7 @@ col_vals_regex <- function( secret_agent <- create_agent(x, label = "::QUIET::") %>% col_vals_regex( - columns = columns, + columns = tidyselect::all_of(columns), regex = regex, na_pass = na_pass, preconditions = preconditions, diff --git a/R/col_vals_within_spec.R b/R/col_vals_within_spec.R index f22ecd015..36fc472a9 100644 --- a/R/col_vals_within_spec.R +++ b/R/col_vals_within_spec.R @@ -390,7 +390,7 @@ col_vals_within_spec <- function( secret_agent <- create_agent(x, label = "::QUIET::") %>% col_vals_within_spec( - columns = columns, + columns = tidyselect::all_of(columns), spec = spec, na_pass = na_pass, preconditions = preconditions, diff --git a/R/rows_complete.R b/R/rows_complete.R index 1c2af27f3..160dc43cf 100644 --- a/R/rows_complete.R +++ b/R/rows_complete.R @@ -278,22 +278,13 @@ rows_complete <- function( # Capture the `columns` expression columns <- rlang::enquo(columns) - - if (uses_tidyselect(expr_text = columns_expr)) { - - # Resolve the columns based on the expression - columns <- resolve_columns(x = x, var_expr = columns, preconditions = NULL) - - } else { - - # Resolve the columns based on the expression - if (!is.null(rlang::eval_tidy(columns)) && !is.null(columns)) { - columns <- resolve_columns(x = x, var_expr = columns, preconditions) - } else { - columns <- NULL - } + if (rlang::quo_is_null(columns)) { + columns <- rlang::quo(tidyselect::everything()) } + # Resolve the columns based on the expression + columns <- resolve_columns(x = x, var_expr = columns, preconditions = NULL) + # Resolve segments into list segments_list <- resolve_segments( @@ -307,7 +298,7 @@ rows_complete <- function( secret_agent <- create_agent(x, label = "::QUIET::") %>% rows_complete( - columns = columns, + columns = tidyselect::all_of(columns), preconditions = preconditions, segments = segments, label = label, diff --git a/R/rows_distinct.R b/R/rows_distinct.R index 9c847b834..f4492a824 100644 --- a/R/rows_distinct.R +++ b/R/rows_distinct.R @@ -279,22 +279,13 @@ rows_distinct <- function( # Capture the `columns` expression columns <- rlang::enquo(columns) - - if (uses_tidyselect(expr_text = columns_expr)) { - - # Resolve the columns based on the expression - columns <- resolve_columns(x = x, var_expr = columns, preconditions = NULL) - - } else { - - # Resolve the columns based on the expression - if (!is.null(rlang::eval_tidy(columns)) && !is.null(columns)) { - columns <- resolve_columns(x = x, var_expr = columns, preconditions) - } else { - columns <- NULL - } + if (rlang::quo_is_null(columns)) { + columns <- rlang::quo(tidyselect::everything()) } + # Resolve the columns based on the expression + columns <- resolve_columns(x = x, var_expr = columns, preconditions = NULL) + # Resolve segments into list segments_list <- resolve_segments( @@ -308,7 +299,7 @@ rows_distinct <- function( secret_agent <- create_agent(x, label = "::QUIET::") %>% rows_distinct( - columns = columns, + columns = tidyselect::all_of(columns), preconditions = preconditions, segments = segments, label = label, diff --git a/R/scan_data.R b/R/scan_data.R index db2cb3a32..08ba919ca 100644 --- a/R/scan_data.R +++ b/R/scan_data.R @@ -1041,7 +1041,7 @@ probe_columns_numeric <- function( locale ) { - data_column <- dplyr::select(data, {{ column }}) + data_column <- dplyr::select(data, tidyselect::any_of(column)) column_description_gt <- get_column_description_gt( @@ -1133,7 +1133,7 @@ probe_columns_character <- function( locale ) { - data_column <- data %>% dplyr::select({{ column }}) + data_column <- data %>% dplyr::select(tidyselect::any_of(column)) column_description_gt <- get_column_description_gt( @@ -1184,7 +1184,7 @@ probe_columns_logical <- function( locale ) { - data_column <- data %>% dplyr::select({{ column }}) + data_column <- data %>% dplyr::select(tidyselect::any_of(column)) column_description_gt <- get_column_description_gt( @@ -1211,7 +1211,7 @@ probe_columns_factor <- function( locale ) { - data_column <- data %>% dplyr::select({{ column }}) + data_column <- data %>% dplyr::select(tidyselect::any_of(column)) column_description_gt <- get_column_description_gt( @@ -1238,7 +1238,7 @@ probe_columns_date <- function( locale ) { - data_column <- data %>% dplyr::select({{ column }}) + data_column <- data %>% dplyr::select(tidyselect::any_of(column)) column_description_gt <- get_column_description_gt( @@ -1265,7 +1265,7 @@ probe_columns_posix <- function( locale ) { - data_column <- data %>% dplyr::select({{ column }}) + data_column <- data %>% dplyr::select(tidyselect::any_of(column)) column_description_gt <- get_column_description_gt( @@ -1290,7 +1290,7 @@ probe_columns_other <- function( n_rows ) { - data_column <- data %>% dplyr::select({{ column }}) + data_column <- data %>% dplyr::select(tidyselect::any_of(column)) column_classes <- paste(class(data_column), collapse = ", ") diff --git a/R/table_transformers.R b/R/table_transformers.R index 66cd2dce7..3e8f5684e 100644 --- a/R/table_transformers.R +++ b/R/table_transformers.R @@ -161,7 +161,7 @@ tt_summary_stats <- function(tbl) { if (r_col_types[i] %in% c("integer", "numeric")) { - data_col <- dplyr::select(tbl, col_names[i]) + data_col <- dplyr::select(tbl, tidyselect::all_of(col_names[i])) # nocov start @@ -286,7 +286,7 @@ tt_string_info <- function(tbl) { if (r_col_types[i] == "character") { - data_col <- dplyr::select(tbl, col_names[i]) + data_col <- dplyr::select(tbl, tidyselect::all_of(col_names[i])) suppressWarnings({ info_list <- get_table_column_nchar_stats(data_column = data_col) @@ -585,7 +585,7 @@ tt_time_shift <- function( tbl %>% dplyr::mutate( dplyr::across( - .cols = time_columns, + .cols = tidyselect::all_of(time_columns), .fns = ~ lubridate::days(n_days) + . ) ) @@ -596,7 +596,7 @@ tt_time_shift <- function( tbl %>% dplyr::mutate( dplyr::across( - .cols = time_columns, + .cols = tidyselect::all_of(time_columns), .fns = ~ time_shift + . ) ) @@ -645,7 +645,7 @@ tt_time_shift <- function( tbl %>% dplyr::mutate( dplyr::across( - .cols = time_columns, + .cols = tidyselect::all_of(time_columns), .fns = ~ fn_time(time_value * direction_val) + .) ) } @@ -1058,9 +1058,9 @@ get_tt_param <- function( # Obtain the value from the `tbl` through a `select()`, `filter()`, `pull()` param_value <- tbl %>% - dplyr::select(.param., .env$column) %>% + dplyr::select(.param., tidyselect::all_of(column)) %>% dplyr::filter(.param. == .env$param) %>% - dplyr::pull(.env$column) + dplyr::pull(tidyselect::all_of(column)) } else if (tt_type == "tbl_dims") { diff --git a/R/utils.R b/R/utils.R index c5a8c9d2e..70361ff64 100644 --- a/R/utils.R +++ b/R/utils.R @@ -218,68 +218,69 @@ materialize_table <- function(tbl, check = TRUE) { tbl } -resolve_expr_to_cols <- function(tbl, var_expr) { +is_secret_agent <- function(x) { + is_ptblank_agent(x) && (x$label == "::QUIET::") +} + +resolve_columns <- function(x, var_expr, preconditions) { - var_expr <- enquo(var_expr) + force(x) # To avoid `restarting interrupted promise evaluation` warnings - if ((var_expr %>% rlang::get_expr() %>% as.character())[1] == "vars") { - - cols <- (var_expr %>% rlang::get_expr() %>% as.character())[-1] - return(cols) + out <- tryCatch( + expr = resolve_columns_internal(x, var_expr, preconditions), + error = function(cnd) cnd + ) + + if (rlang::is_error(out)) { + # If not in validation-planning context (assert/expect/test) + if (is_a_table_object(x) || is_secret_agent(x)) { + rlang::cnd_signal(out) + } else { + # Else (mid-planning): return columns attempted to subset or NA if empty + out$i %||% NA_character_ + } + } else { + out } - tidyselect::vars_select(.vars = colnames(tbl), {{ var_expr }}) %>% unname() } -resolve_columns <- function(x, var_expr, preconditions) { +resolve_columns_internal <- function(x, var_expr, preconditions) { - # If getting a character vector as `var_expr`, simply return the vector - # since this should already be a vector of column names and it's not necessary - # to resolve this against the target table - if (is.character(var_expr)) { - return(var_expr) + # Return NA if the expr is NULL + if (rlang::quo_is_null(var_expr)) { + return(NA_character_) } - # nocov start - - # Return an empty character vector if the expr is NULL - if (inherits(var_expr, "quosure") && - var_expr %>% rlang::as_label() == "NULL") { - - return(character(NA_character_)) + # Extract tbl + tbl <- if (is_ptblank_agent(x)) { + get_tbl_object(x) + } else if (is_a_table_object(x)) { + x + } + # Apply preconditions + if (!is.null(preconditions)) { + tbl <- apply_preconditions(tbl = tbl, preconditions = preconditions) } - # nocov end - - # Get the column names from a non-NULL, non-character expression - if (is.null(preconditions)) { - - if (inherits(x, c("data.frame", "tbl_df", "tbl_dbi"))) { - - column <- resolve_expr_to_cols(tbl = x, var_expr = !!var_expr) - - } else if (inherits(x, ("ptblank_agent"))) { - - tbl <- get_tbl_object(agent = x) - column <- resolve_expr_to_cols(tbl = tbl, var_expr = !!var_expr) + # Revised column selection logic + ## Special case `vars()`-expression for backwards compatibility + if (rlang::quo_is_call(var_expr, "vars")) { + cols <- rlang::call_args(var_expr) + if (rlang::is_empty(tbl)) { + # Special-case `serially()` - just deparse elements and bypass tidyselect + column <- vapply(cols, rlang::as_name, character(1), + USE.NAMES = FALSE) + } else { + # Convert to the idiomatic `c()`-expr + col_c_expr <- rlang::call2("c", !!!cols) + column <- tidyselect::eval_select(col_c_expr, tbl) + column <- names(column) } - } else { - - if (inherits(x, c("data.frame", "tbl_df", "tbl_dbi"))) { - - tbl <- apply_preconditions(tbl = x, preconditions = preconditions) - - column <- resolve_expr_to_cols(tbl = tbl, var_expr = !!var_expr) - - } else if (inherits(x, ("ptblank_agent"))) { - - tbl <- get_tbl_object(agent = x) - - tbl <- apply_preconditions(tbl = tbl, preconditions = preconditions) - - column <- resolve_expr_to_cols(tbl = tbl, var_expr = !!var_expr) - } + ## Else, assume that the user supplied a valid tidyselect expression + column <- tidyselect::eval_select(var_expr, tbl) + column <- names(column) } if (length(column) < 1) { @@ -372,7 +373,7 @@ resolve_segments <- function(x, seg_expr, preconditions) { col_seg_vals <- tbl %>% - dplyr::select(.env$column_name) %>% + dplyr::select(tidyselect::all_of(column_name)) %>% dplyr::distinct() %>% dplyr::pull() @@ -955,7 +956,7 @@ get_tbl_information_dbi <- function(tbl) { DBI::dbDataType( tbl_connection, tbl %>% - dplyr::select(x) %>% + dplyr::select(tidyselect::all_of(x)) %>% utils::head(1) %>% dplyr::collect() %>% dplyr::pull(x) diff --git a/tests/testthat/test-create_validation_steps.R b/tests/testthat/test-create_validation_steps.R index d0e0777ce..3a4318de6 100644 --- a/tests/testthat/test-create_validation_steps.R +++ b/tests/testthat/test-create_validation_steps.R @@ -1036,7 +1036,7 @@ test_that("Creating a `rows_distinct()` step is possible", { expect_equivalent(validation$tbl_name, "small_table") expect_equivalent(validation$col_names, c("date_time", "date", "a", "b", "c", "d", "e", "f")) expect_equivalent(validation$validation_set$assertion_type, "rows_distinct") - expect_true(is.na(validation$validation_set$column %>% .[[1]] %>% .[[1]])) + expect_equivalent(validation$validation_set$column %>% unlist(), "date_time, date, a, b, c, d, e, f") expect_true(is.null(validation$validation_set[["values"]][[1]])) expect_true(is.na(validation$validation_set$all_passed)) expect_true(is.na(validation$validation_set$n)) diff --git a/tests/testthat/test-expectation_fns.R b/tests/testthat/test-expectation_fns.R index 0b0fa6017..c0a340d9f 100644 --- a/tests/testthat/test-expectation_fns.R +++ b/tests/testthat/test-expectation_fns.R @@ -1624,7 +1624,8 @@ test_that("pointblank expectation function produce the correct results", { test_that("expect errors to be expressed by pointblank under some conditions", { - no_col_msg <- "The value for `column` doesn't correspond to a column name." + # no_col_msg <- "The value for `column` doesn't correspond to a column name." + no_col_msg <- "column" # Errors caught and expressed when a column doesn't exist expect_error(expect_col_vals_lt(tbl, columns = vars(z), value = 0), regexp = no_col_msg) diff --git a/tests/testthat/test-interrogate_with_agent.R b/tests/testthat/test-interrogate_with_agent.R index eee9c0bfa..ab34fa732 100644 --- a/tests/testthat/test-interrogate_with_agent.R +++ b/tests/testthat/test-interrogate_with_agent.R @@ -784,7 +784,7 @@ test_that("Interrogating for valid row values", { # Expect certain values in `validation$validation_set` expect_equivalent(validation$tbl_name, "small_table") expect_equivalent(validation$validation_set$assertion_type, "rows_distinct") - expect_true(is.na(validation$validation_set$column %>% unlist())) + expect_equivalent(validation$validation_set$column %>% unlist(), "date_time, date, a, b, c, d, e, f") expect_true(is.null(validation$validation_set[["values"]][[1]])) expect_false(validation$validation_set$all_passed) expect_equivalent(validation$validation_set$n, 13) @@ -807,7 +807,7 @@ test_that("Interrogating for valid row values", { # Expect certain values in `validation$validation_set` expect_equivalent(validation$tbl_name, "small_table") expect_equivalent(validation$validation_set$assertion_type, "rows_distinct") - expect_true(is.na(validation$validation_set$column %>% unlist())) + expect_equivalent(validation$validation_set$column %>% unlist(), "date_time, date, a, b, c, d, e, f") expect_true(is.null(validation$validation_set[["values"]][[1]])) expect_true(validation$validation_set$all_passed) expect_equivalent(validation$validation_set$n, 11) @@ -873,7 +873,7 @@ test_that("Interrogating for valid row values", { # Expect certain values in `validation$validation_set` expect_equivalent(validation$tbl_name, "small_table") expect_equivalent(validation$validation_set$assertion_type, "rows_complete") - expect_true(is.na(validation$validation_set$column %>% unlist())) + expect_equivalent(validation$validation_set$column %>% unlist(), "date_time, date, a, b, c, d, e, f") expect_true(is.null(validation$validation_set[["values"]][[1]])) expect_false(validation$validation_set$all_passed) expect_equivalent(validation$validation_set$n, 13) @@ -896,7 +896,7 @@ test_that("Interrogating for valid row values", { # Expect certain values in `validation$validation_set` expect_equivalent(validation$tbl_name, "small_table") expect_equivalent(validation$validation_set$assertion_type, "rows_complete") - expect_true(is.na(validation$validation_set$column %>% unlist())) + expect_equivalent(validation$validation_set$column %>% unlist(), "date_time, date, a, b, c, d, e, f") expect_true(is.null(validation$validation_set[["values"]][[1]])) expect_true(validation$validation_set$all_passed) expect_equivalent(validation$validation_set$n, 3) diff --git a/tests/testthat/test-interrogate_with_agent_db.R b/tests/testthat/test-interrogate_with_agent_db.R index 8d8d24750..cf8b57ee5 100644 --- a/tests/testthat/test-interrogate_with_agent_db.R +++ b/tests/testthat/test-interrogate_with_agent_db.R @@ -485,7 +485,7 @@ test_that("Interrogating for valid row values", { # Expect certain values in `validation$validation_set` expect_equivalent(validation$tbl_name, "small_table") expect_equivalent(validation$validation_set$assertion_type, "rows_distinct") - expect_true(is.na(validation$validation_set$column %>% unlist())) + expect_equivalent(validation$validation_set$column %>% unlist(), "date_time, date, a, b, c, d, e, f") expect_true(is.null(validation$validation_set[["values"]][[1]])) expect_false(validation$validation_set$all_passed) expect_equivalent(validation$validation_set$n, 13) @@ -510,7 +510,7 @@ test_that("Interrogating for valid row values", { # Expect certain values in `validation$validation_set` expect_equivalent(validation$tbl_name, "small_table") expect_equivalent(validation$validation_set$assertion_type, "rows_distinct") - expect_true(is.na(validation$validation_set$column %>% unlist())) + expect_equivalent(validation$validation_set$column %>% unlist(), "date_time, date, a, b, c, d, e, f") expect_true(is.null(validation$validation_set[["values"]][[1]])) expect_true(validation$validation_set$all_passed) expect_equivalent(validation$validation_set$n, 11) diff --git a/tests/testthat/test-test_fns.R b/tests/testthat/test-test_fns.R index ef2d9fd19..b54d36578 100644 --- a/tests/testthat/test-test_fns.R +++ b/tests/testthat/test-test_fns.R @@ -787,7 +787,8 @@ test_that("pointblank expectation functions produce the correct results", { test_that("expect errors to be expressed by pointblank under some conditions", { - no_col_msg <- "The value for `column` doesn't correspond to a column name." + # no_col_msg <- "The value for `column` doesn't correspond to a column name." + no_col_msg <- "column" # Errors caught and expressed when a column doesn't exist expect_error(test_col_vals_lt(tbl, columns = vars(z), value = 0), regexp = no_col_msg) diff --git a/tests/testthat/test-tidyselect_fails_safely.R b/tests/testthat/test-tidyselect_fails_safely.R new file mode 100644 index 000000000..4ad1c6ee3 --- /dev/null +++ b/tests/testthat/test-tidyselect_fails_safely.R @@ -0,0 +1,137 @@ +agent <- create_agent(small_table) +nonexistent_col <- "z" + +test_that("tidyselect errors signaled at report, not during development of validation plan", { + + # No immediate error for all patterns + expect_s3_class(a1 <- agent %>% col_vals_not_null(z), "ptblank_agent") + expect_s3_class(a2 <- agent %>% col_vals_not_null("z"), "ptblank_agent") + expect_s3_class(a3 <- agent %>% col_vals_not_null(all_of("z")), "ptblank_agent") + expect_s3_class(a4 <- agent %>% col_vals_not_null(all_of(nonexistent_col)), "ptblank_agent") + + # Failure signaled via report + expect_false(a1 %>% interrogate() %>% all_passed()) + expect_false(a2 %>% interrogate() %>% all_passed()) + expect_false(a3 %>% interrogate() %>% all_passed()) + expect_false(a4 %>% interrogate() %>% all_passed()) + + # Stress testing + expect_no_error(agent %>% col_vals_not_null(stop())) + expect_no_error(agent %>% col_vals_not_null(c(stop()))) + expect_no_error(agent %>% col_vals_not_null(all_of(stop()))) + +}) + +test_that("fail state correctly registered in the report for tidyselect errors", { + + # Adopted from test-get_agent_report.R ------------------------- + + # The following agent will perform an interrogation that results + # in all test units passing in the second validation step, but + # the first experiences an evaluation error (since column + # `z` doesn't exist in `small_table`) + agent <- + create_agent(tbl = small_table) %>% + col_vals_not_null(all_of("z")) %>% # swapped for `vars("z")` + col_vals_gt(vars(c), 1, na_pass = TRUE) %>% + interrogate() + + # Expect that the interrogation *does not* have + # a completely 'all passed' state (returning FALSE) + agent %>% all_passed() %>% expect_false() + + # If narrowing the `all_passed()` evaluation to only + # the second validation step, then we should expect TRUE + agent %>% all_passed(i = 2) %>% expect_true() + + # If narrowing the `all_passed()` evaluation to only + # the first validation step, then we should expect FALSE + agent %>% all_passed(i = 1) %>% expect_false() + +}) + +test_that("(tidy-)selecting 0 columns = skip the validation step at interrogation", { + + eval_inactive <- function(x) !x$validation_set$eval_active + + # Old behavior for vars()/NULL/ preserved: + ## 1) No immediate error for zero columns selected + expect_s3_class(a5 <- agent %>% col_vals_not_null(vars()), "ptblank_agent") + expect_s3_class(a6 <- agent %>% col_vals_not_null(NULL), "ptblank_agent") + expect_s3_class(a7 <- agent %>% col_vals_not_null(), "ptblank_agent") + ## 2) # Treated as inactive in the report + expect_true(a5 %>% interrogate() %>% eval_inactive()) + expect_true(a6 %>% interrogate() %>% eval_inactive()) + expect_true(a7 %>% interrogate() %>% eval_inactive()) + + # Same behavior of 0-column selection replicated in tidyselect patterns + expect_length(small_table %>% dplyr::select(any_of("z")), 0) + expect_length(small_table %>% dplyr::select(c()), 0) + expect_s3_class(a8 <- agent %>% col_vals_not_null(any_of("z")), "ptblank_agent") + expect_s3_class(a9 <- agent %>% col_vals_not_null(c()), "ptblank_agent") + expect_true(a8 %>% interrogate() %>% eval_inactive()) + expect_true(a9 %>% interrogate() %>% eval_inactive()) + +}) + +test_that("tidyselecting 0 columns for rows_* functions = error at interrogation", { + + expect_no_error(a_rows_distinct <- agent %>% rows_distinct(starts_with("z")) %>% interrogate()) + expect_no_error(a_rows_complete <- agent %>% rows_distinct(starts_with("z")) %>% interrogate()) + expect_true(a_rows_distinct$validation_set$eval_error) + expect_true(a_rows_complete$validation_set$eval_error) + + # TODO: 0-column selection from tidyselect helpers *not* caught by `uses_tidyselect()` + # will still have same behavior but show different eval error message + # (errors from `select()` and not from `column_validity_has_columns()` as above) + expect_no_error(a_rows_distinct2 <- agent %>% rows_distinct(any_of("z")) %>% interrogate()) + expect_no_error(a_rows_complete2 <- agent %>% rows_distinct(any_of("z")) %>% interrogate()) + expect_true(a_rows_distinct2$validation_set$eval_error) + expect_true(a_rows_complete2$validation_set$eval_error) + +}) + +test_that("tidyselect errors *are* immediate for assertion/expectation/test", { + + mismatch_msg <- "Can't subset columns that don't exist." + + # For validation steps are used on table + expect_error(small_table %>% col_vals_not_null(z), mismatch_msg) + expect_error(small_table %>% col_vals_not_null("z"), mismatch_msg) + expect_error(small_table %>% col_vals_not_null(all_of("z")), mismatch_msg) + expect_error(small_table %>% col_vals_not_null(all_of(nonexistent_col)), mismatch_msg) + + # For expectations + expect_error(small_table %>% expect_col_vals_not_null(z), mismatch_msg) + expect_error(small_table %>% expect_col_vals_not_null("z"), mismatch_msg) + expect_error(small_table %>% expect_col_vals_not_null(all_of("z")), mismatch_msg) + expect_error(small_table %>% expect_col_vals_not_null(all_of(nonexistent_col)), mismatch_msg) + + # For tests + expect_error(small_table %>% test_col_vals_not_null(z), mismatch_msg) + expect_error(small_table %>% test_col_vals_not_null("z"), mismatch_msg) + expect_error(small_table %>% test_col_vals_not_null(all_of("z")), mismatch_msg) + expect_error(small_table %>% test_col_vals_not_null(all_of(nonexistent_col)), mismatch_msg) + +}) + +test_that("tidyselect errors cannot be downgraded in assertion/expectation on table", { + + # This replicates old behavior + expect_error({ + small_table %>% + col_vals_not_null(a) %>% + col_vals_not_null(z, actions = warn_on_fail()) %>% + col_vals_not_null(b) + }, "Can't subset columns that don't exist.") + +}) + +# test_that("Other things that may need to get ironed out", { +# # Empty `vars()` in rows_* functions resolve to `list(NA)` instead of `NA` +# agent %>% rows_distinct(vars()) +# agent %>% rows_complete(vars()) +# # Attempting to select using a non-existent variable silently fails +# agent %>% col_vals_not_null(all_of(nonexistent_var)) %>% interrogate() +# # Current heuristic for re-throwing the error relies on whether agent is "::QUIET::" ... +# }) diff --git a/tests/testthat/test-tidyselect_integration.R b/tests/testthat/test-tidyselect_integration.R new file mode 100644 index 000000000..2e24f7ac4 --- /dev/null +++ b/tests/testthat/test-tidyselect_integration.R @@ -0,0 +1,148 @@ +tbl <- data.frame(x = 1:2, y = 1:2, nonunique = "A") +exist_col <- "y" +nonunique_col <- "nonunique" +nonexist_col <- "z" + +test_that("Backwards compatibility with `vars()`", { + + # Bare symbol selects column(s) + expect_success(expect_rows_distinct(tbl, vars(x))) + expect_success(expect_rows_distinct(tbl, vars(x, nonunique))) + expect_failure(expect_rows_distinct(tbl, vars(nonunique))) + + # Bare character selects column(s) + expect_success(expect_rows_distinct(tbl, vars("x"))) + expect_success(expect_rows_distinct(tbl, vars("x", "nonunique"))) + expect_failure(expect_rows_distinct(tbl, vars("nonunique"))) + + # Bang-bang in-lines value + expect_success(expect_rows_distinct(tbl, vars(!!exist_col))) + expect_failure(expect_rows_distinct(tbl, vars(!!nonunique_col))) + + # `vars()` wrapping tidyselect expressions is redundant but continues to work + expect_success(expect_rows_distinct(tbl, vars(all_of("x")))) + + # `vars()` selection of 0-columns errors *only* in non-validation-planning contexts + expect_error(rows_distinct(tbl, vars("z"))) + expect_error(expect_rows_distinct(tbl, vars("z"))) + expect_error(test_rows_distinct(tbl, vars("z"))) + expect_no_error(tbl %>% create_agent() %>% rows_distinct(vars("z"))) + expect_no_error(tbl %>% create_agent() %>% rows_distinct(vars("z")) %>% interrogate()) + +}) + +test_that("Full range of tidyselect features available in column selection", { + + # Single symbol + expect_success(expect_rows_distinct(tbl, x)) + expect_failure(expect_rows_distinct(tbl, nonunique)) + + # Preferred {tidyselect}-style `c()` syntax + expect_success(expect_rows_distinct(tbl, c(x))) + expect_success(expect_rows_distinct(tbl, c(x, nonunique))) + expect_failure(expect_rows_distinct(tbl, c(nonunique))) + + # {tidyselect} functions + expect_success(expect_rows_distinct(tbl, tidyselect::all_of("x"))) + expect_success(expect_rows_distinct(tbl, tidyselect::all_of(c("x", "nonunique")))) + expect_failure(expect_rows_distinct(tbl, tidyselect::all_of("nonunique"))) + + # NEW: {tidyselect} integer indexing + expect_success(expect_rows_distinct(tbl, 1)) + expect_success(expect_rows_distinct(tbl, c(1, 3))) + expect_failure(expect_rows_distinct(tbl, 3)) + + # NEW: {tidyselect} negative indexing + expect_success(expect_rows_distinct(tbl, -(2:3))) + expect_success(expect_rows_distinct(tbl, -2)) + expect_failure(expect_rows_distinct(tbl, -(1:2))) + + # NEW: {tidyselect} `where()` predicate: + expect_success(expect_rows_distinct(tbl, !tidyselect::where(is.character))) + expect_success(expect_rows_distinct(tbl, tidyselect::where(is.numeric))) + expect_failure(expect_rows_distinct(tbl, tidyselect::where(is.character))) + + # NEW: {tidyselect} functions in complex expressions + expect_success(expect_rows_distinct(tbl, c(x, tidyselect::all_of(exist_col)))) + expect_error(expect_rows_distinct(tbl, c(x, tidyselect::all_of(nonexist_col)))) + expect_success(expect_rows_distinct(tbl, c(x, tidyselect::any_of(nonexist_col)))) + + # Supplying a character vector variable still works, but signals deprecation: + rlang::local_options(lifecycle_verbosity = "warning") + expect_success(expect_warning( + expect_rows_distinct(tbl, exist_col), + "Using an external vector in selections was deprecated in tidyselect 1.1.0." + )) + +}) + +test_that("'NULL = select everything' behavior in rows_*() validation functions", { + + # For `rows_*()` functions specifically, empty/NULL = "select everything" behavior: + expect_success(expect_rows_distinct(data.frame(x = 1, y = 2))) + expect_success(expect_rows_complete(data.frame(x = 1, y = 2))) + expect_failure(expect_rows_distinct(data.frame(x = c(1, 1)))) + expect_failure(expect_rows_complete(data.frame(x = c(1, NA)))) + expect_success(expect_rows_distinct(data.frame(x = 1, y = 2), columns = NULL)) + expect_success(expect_rows_complete(data.frame(x = 1, y = 2), columns = NULL)) + expect_failure(expect_rows_distinct(data.frame(x = c(1, 1)), columns = NULL)) + expect_failure(expect_rows_complete(data.frame(x = c(1, NA)), columns = NULL)) + + # Report shows all column names with empty `columns` argument + expect_equal({ + small_table %>% + create_agent() %>% + rows_distinct() %>% + rows_complete() %>% + interrogate() %>% + {.$validation_set$column} %>% + unlist() %>% + unique() + }, toString(colnames(small_table))) + + # Report shows all column names with explicit NULL `columns` argument + expect_equal({ + small_table %>% + create_agent() %>% + rows_distinct(columns = NULL) %>% + rows_complete(columns = NULL) %>% + interrogate() %>% + {.$validation_set$column} %>% + unlist() %>% + unique() + }, toString(colnames(small_table))) + +}) + +# tidyselect coverage for `col_exists()` +test_that("'NULL = select everything' behavior in rows_*() validation functions", { + + # Reprex from (#433) + df <- tibble::tibble( + id.x = 1:3, + id.y = 1:3, + stuff = 1:3 + ) + expect_success({ + df %>% + expect_col_exists( + columns = vars(ends_with(".x")) + ) + }) + expect_equal({ + df %>% + col_exists( + columns = vars(ends_with(".x")) + ) + }, df) + + # Multiple column selection produces multiple steps + expect_no_error({ + df_interrogated <- df %>% + create_agent() %>% + col_exists(starts_with("id")) %>% + interrogate() + }) + expect_equal(nrow(df_interrogated$validation_set), 2L) + +}) diff --git a/tests/testthat/test-yaml.R b/tests/testthat/test-yaml.R index 7c0447f9b..02279b826 100644 --- a/tests/testthat/test-yaml.R +++ b/tests/testthat/test-yaml.R @@ -800,7 +800,7 @@ test_that("Individual validation steps make the YAML round-trip successfully", { expect_equal( get_oneline_expr_str(agent %>% rows_distinct()), - "rows_distinct()" + "rows_distinct(columns = vars(date_time, date, a, b, c, d, e, f))" ) expect_equal( get_oneline_expr_str(agent %>% rows_distinct(columns = vars(a, b))),