diff --git a/r/DESCRIPTION b/r/DESCRIPTION index f682de189e7..89de026d96c 100644 --- a/r/DESCRIPTION +++ b/r/DESCRIPTION @@ -39,7 +39,7 @@ Imports: methods, purrr, R6, - rlang (>= 1.0.0), + rlang (>= 1.2.0), stats, tidyselect (>= 1.0.0), utils, diff --git a/r/NAMESPACE b/r/NAMESPACE index 46c29b3e937..eb7581a5fac 100644 --- a/r/NAMESPACE +++ b/r/NAMESPACE @@ -429,7 +429,6 @@ export(write_to_raw) export(write_tsv_dataset) importFrom(R6,R6Class) importFrom(assertthat,assert_that) -importFrom(assertthat,is.string) importFrom(bit64,integer64) importFrom(glue,glue) importFrom(methods,as) @@ -461,8 +460,12 @@ importFrom(rlang,call2) importFrom(rlang,call_args) importFrom(rlang,call_name) importFrom(rlang,caller_env) +importFrom(rlang,check_bool) importFrom(rlang,check_dots_empty) importFrom(rlang,check_dots_empty0) +importFrom(rlang,check_number_decimal) +importFrom(rlang,check_number_whole) +importFrom(rlang,check_string) importFrom(rlang,dots_list) importFrom(rlang,dots_n) importFrom(rlang,enexpr) diff --git a/r/R/array.R b/r/R/array.R index f2b34fc03f8..4bfef5ec615 100644 --- a/r/R/array.R +++ b/r/R/array.R @@ -461,7 +461,7 @@ StructArray$create <- function(...) { #' @export `$.StructArray` <- function(x, name, ...) { - assert_that(is.string(name)) + check_string(name) if (name %in% ls(x)) { get(name, x) } else { diff --git a/r/R/arrow-datum.R b/r/R/arrow-datum.R index 5ac72bf3685..fa6918b7ed8 100644 --- a/r/R/arrow-datum.R +++ b/r/R/arrow-datum.R @@ -29,9 +29,7 @@ ArrowDatum <- R6Class( call_function("cast", self, options = opts) }, SortIndices = function(descending = FALSE) { - assert_that(is.logical(descending)) - assert_that(length(descending) == 1L) - assert_that(!is.na(descending)) + check_bool(descending, allow_na = FALSE) call_function( "sort_indices", self, @@ -285,8 +283,7 @@ filter_rows <- function(x, i, keep_na = TRUE, ...) { #' @importFrom utils head #' @export head.ArrowDatum <- function(x, n = 6L, ...) { - assert_is(n, c("numeric", "integer")) - assert_that(length(n) == 1) + check_number_decimal(n) len <- NROW(x) if (n < 0) { # head(x, negative) means all but the last n rows @@ -306,8 +303,7 @@ head.ArrowDatum <- function(x, n = 6L, ...) { #' @importFrom utils tail #' @export tail.ArrowDatum <- function(x, n = 6L, ...) { - assert_is(n, c("numeric", "integer")) - assert_that(length(n) == 1) + check_number_decimal(n) if (!is.integer(n)) { n <- floor(n) } diff --git a/r/R/arrow-package.R b/r/R/arrow-package.R index 2706faee5cb..32efc856429 100644 --- a/r/R/arrow-package.R +++ b/r/R/arrow-package.R @@ -6,7 +6,7 @@ # "License"); you may not use this file except in compliance # with the License. You may obtain a copy of the License at # -# http://www.apache.org/licenses/LICENSE-2.0 +# https://www.apache.org/licenses/LICENSE-2.0 # # Unless required by applicable law or agreed to in writing, # software distributed under the License is distributed on an @@ -19,7 +19,7 @@ #' @importFrom R6 R6Class #' @importFrom purrr as_mapper map map2 map_chr map2_chr map_dbl map_dfr map_int map_lgl keep imap imap_chr #' @importFrom purrr compact flatten reduce walk -#' @importFrom assertthat assert_that is.string +#' @importFrom assertthat assert_that #' @importFrom rlang list2 %||% is_false abort dots_n warn enquo quo_is_null enquos is_integerish quos quo #' @importFrom rlang eval_tidy new_data_mask syms env new_environment env_bind set_names exec #' @importFrom rlang is_bare_character quo_get_expr quo_get_env quo_set_expr .data seq2 is_interactive @@ -27,7 +27,7 @@ #' @importFrom rlang is_list call2 is_empty as_function as_label arg_match is_symbol is_call call_args #' @importFrom rlang quo_set_env quo_get_env is_formula quo_is_call f_rhs parse_expr f_env new_quosure #' @importFrom rlang new_quosures expr_text caller_env check_dots_empty check_dots_empty0 dots_list is_string inform -#' @importFrom rlang is_bare_list call_name +#' @importFrom rlang is_bare_list call_name check_string check_number_whole check_number_decimal check_bool #' @importFrom tidyselect vars_pull eval_select eval_rename #' @importFrom glue glue #' @importFrom bit64 integer64 diff --git a/r/R/arrow-tabular.R b/r/R/arrow-tabular.R index a83226a728c..15fd2a2c3f3 100644 --- a/r/R/arrow-tabular.R +++ b/r/R/arrow-tabular.R @@ -153,7 +153,7 @@ as.data.frame.ArrowTabular <- function(x, row.names = NULL, optional = FALSE, .. #' @export `$.ArrowTabular` <- function(x, name, ...) { - assert_that(is.string(name)) + check_string(name) if (name %in% ls(x)) { get(name, x) } else { @@ -166,7 +166,9 @@ as.data.frame.ArrowTabular <- function(x, row.names = NULL, optional = FALSE, .. if (!is.character(i) && !is.numeric(i)) { stop("'i' must be character or numeric, not ", class(i), call. = FALSE) } - assert_that(length(i) == 1, !is.na(i)) + if (length(i) != 1 || is.na(i)) { + stop("`i` must be length 1 and not NA", call. = FALSE) + } if (is.null(value)) { if (is.character(i)) { @@ -209,7 +211,7 @@ as.data.frame.ArrowTabular <- function(x, row.names = NULL, optional = FALSE, .. #' @export `$<-.ArrowTabular` <- function(x, i, value) { - assert_that(is.string(i)) + check_string(i) # We need to check if `i` is in names in case it is an active binding (e.g. # `metadata`, in which case we use assign to change the active binding instead # of the column in the table) diff --git a/r/R/compression.R b/r/R/compression.R index 4cd50d47a06..3477f9cbd84 100644 --- a/r/R/compression.R +++ b/r/R/compression.R @@ -47,7 +47,7 @@ Codec <- R6Class( ) ) Codec$create <- function(type = "gzip", compression_level = NA) { - if (is.string(type)) { + if (is_string(type)) { type <- util___Codec__Create( compression_from_name(type), compression_level @@ -104,7 +104,7 @@ compression_from_name <- function(name) { CompressedOutputStream <- R6Class("CompressedOutputStream", inherit = OutputStream) CompressedOutputStream$create <- function(stream, codec = "gzip", compression_level = NA) { codec <- Codec$create(codec, compression_level = compression_level) - if (is.string(stream)) { + if (is_string(stream)) { stream <- FileOutputStream$create(stream) } assert_is(stream, "OutputStream") @@ -118,7 +118,7 @@ CompressedOutputStream$create <- function(stream, codec = "gzip", compression_le CompressedInputStream <- R6Class("CompressedInputStream", inherit = InputStream) CompressedInputStream$create <- function(stream, codec = "gzip", compression_level = NA) { codec <- Codec$create(codec, compression_level = compression_level) - if (is.string(stream)) { + if (is_string(stream)) { stream <- ReadableFile$create(stream) } assert_is(stream, "InputStream") diff --git a/r/R/compute.R b/r/R/compute.R index d5da9024bf4..9de6d29c0b4 100644 --- a/r/R/compute.R +++ b/r/R/compute.R @@ -44,8 +44,10 @@ #' @include chunked-array.R #' @include scalar.R call_function <- function(function_name, ..., args = list(...), options = empty_named_list()) { - assert_that(is.string(function_name)) - assert_that(is.list(options), !is.null(names(options))) + check_string(function_name) + if (!is.list(options) || is.null(names(options))) { + stop("options must be a named list.", call. = FALSE) + } datum_classes <- c("Array", "ChunkedArray", "RecordBatch", "Table", "Scalar") valid_args <- map_lgl(args, ~ inherits(., datum_classes)) diff --git a/r/R/csv.R b/r/R/csv.R index a0ecd48677a..1e991ea4139 100644 --- a/r/R/csv.R +++ b/r/R/csv.R @@ -440,7 +440,7 @@ csv_read_options <- function( encoding = "UTF-8", skip_rows_after_names = 0L ) { - assert_that(is.string(encoding)) + check_string(encoding) options <- csv___ReadOptions__initialize( list( @@ -635,25 +635,23 @@ readr_to_csv_write_options <- function( #' write_csv_arrow(airquality, tf, write_options = csv_write_options(null_string = "-99")) #' @export csv_write_options <- function( - include_header = TRUE, - batch_size = 1024L, - null_string = "", - delimiter = ",", - eol = "\n", - quoting_style = c("Needed", "AllValid", "None") + include_header = TRUE, + batch_size = 1024L, + null_string = "", + delimiter = ",", + eol = "\n", + quoting_style = c("Needed", "AllValid", "None") ) { quoting_style <- match.arg(quoting_style) quoting_style_opts <- c("Needed", "AllValid", "None") quoting_style <- match(quoting_style, quoting_style_opts) - 1L - assert_that(is.logical(include_header)) - assert_that(is_integerish(batch_size, n = 1, finite = TRUE), batch_size > 0) - assert_that(is.character(delimiter)) - assert_that(is.character(null_string)) - assert_that(!is.na(null_string)) - assert_that(length(null_string) == 1) + check_bool(include_header) + check_number_whole(batch_size, min = 1, allow_infinite = FALSE) + check_string(delimiter) + check_string(null_string, allow_na = FALSE) assert_that(!grepl('"', null_string), msg = "na argument must not contain quote characters.") - assert_that(is.character(eol)) + check_string(eol) csv___WriteOptions__initialize( list( diff --git a/r/R/dataset-factory.R b/r/R/dataset-factory.R index 02b2b8553c1..ed93bc39cf4 100644 --- a/r/R/dataset-factory.R +++ b/r/R/dataset-factory.R @@ -285,15 +285,15 @@ fsf_options <- function(factory_options, partitioning) { if (!is.null(factory_options$partition_base_dir)) { if ( inherits(partitioning, "HivePartitioning") || - (inherits(partitioning, "PartitioningFactory") && - identical(partitioning$type_name, "hive")) + (inherits(partitioning, "PartitioningFactory") && + identical(partitioning$type_name, "hive")) ) { warning( "factory_options$partition_base_dir is not meaningful for Hive partitioning", call. = FALSE ) } else { - assert_that(is.string(factory_options$partition_base_dir)) + check_string(factory_options$partition_base_dir) } } diff --git a/r/R/dataset-scan.R b/r/R/dataset-scan.R index c4b651d419d..d56aa5c64e6 100644 --- a/r/R/dataset-scan.R +++ b/r/R/dataset-scan.R @@ -160,10 +160,8 @@ names.Scanner <- function(x) names(x$schema) #' @export head.Scanner <- function(x, n = 6L, ...) { - assert_is(n, c("numeric", "integer")) - assert_that(length(n) == 1) # Negative n requires knowing nrow(x), which requires a scan itself - assert_that(n >= 0) + check_number_decimal(n, min = 0) if (!is.integer(n)) { n <- floor(n) } @@ -176,10 +174,8 @@ tail.Scanner <- function(x, n = 6L, ...) { } tail_from_batches <- function(batches, n) { - assert_is(n, c("numeric", "integer")) - assert_that(length(n) == 1) # Negative n requires knowing nrow(x), which requires a scan itself - assert_that(n >= 0) + check_number_decimal(n, min = 0) if (!is.integer(n)) { n <- floor(n) } diff --git a/r/R/dplyr-funcs-string.R b/r/R/dplyr-funcs-string.R index 158bae2db87..627e15efc4f 100644 --- a/r/R/dplyr-funcs-string.R +++ b/r/R/dplyr-funcs-string.R @@ -292,7 +292,7 @@ register_bindings_string_regex <- function() { "stringr::str_count", function(string, pattern) { opts <- get_stringr_pattern_options(enquo(pattern)) - if (!is.string(pattern)) { + if (!is_string(pattern)) { arrow_not_supported("`pattern` must be a length 1 character vector; other values") } arrow_fun <- ifelse(opts$fixed, "count_substring", "count_substring_regex") @@ -422,7 +422,7 @@ register_bindings_string_regex <- function() { }) register_binding("base::strsplit", function(x, split, fixed = FALSE, perl = FALSE, useBytes = FALSE) { - assert_that(is.string(split)) + check_string(split) arrow_fun <- ifelse(fixed, "split_pattern", "split_pattern_regex") # warn when the user specifies both fixed = TRUE and perl = TRUE, for @@ -622,7 +622,7 @@ register_bindings_string_other <- function() { register_binding("stringr::str_pad", function(string, width, side = c("left", "right", "both"), pad = " ") { assert_that(is_integerish(width)) side <- match.arg(side) - assert_that(is.string(pad)) + check_string(pad) if (side == "left") { pad_func <- "utf8_lpad" diff --git a/r/R/dplyr-funcs-type.R b/r/R/dplyr-funcs-type.R index 0c8864ac6c7..cca58f44fd1 100644 --- a/r/R/dplyr-funcs-type.R +++ b/r/R/dplyr-funcs-type.R @@ -78,7 +78,7 @@ register_bindings_type_cast <- function() { }) register_binding("methods::is", function(object, class2) { - if (is.string(class2)) { + if (is_string(class2)) { switch( class2, # for R data types, pass off to is.*() functions diff --git a/r/R/dplyr-summarize.R b/r/R/dplyr-summarize.R index 7c2a44eec3d..2e63373ef5d 100644 --- a/r/R/dplyr-summarize.R +++ b/r/R/dplyr-summarize.R @@ -146,7 +146,7 @@ do_arrow_summarize <- function(.data, ..., .groups = NULL) { # But we don't support anything that returns multiple rows now .groups <- "drop_last" } else { - assert_that(is.string(.groups)) + check_string(.groups) } if (.groups == "drop_last") { out$group_by_vars <- head(.data$group_by_vars, -1) diff --git a/r/R/dplyr.R b/r/R/dplyr.R index 097a48489ab..2c68c7cca9d 100644 --- a/r/R/dplyr.R +++ b/r/R/dplyr.R @@ -230,8 +230,7 @@ as.data.frame.arrow_dplyr_query <- function(x, row.names = NULL, optional = FALS #' @export head.arrow_dplyr_query <- function(x, n = 6L, ...) { - assert_is(n, c("numeric", "integer")) - assert_that(length(n) == 1) + check_number_decimal(n) if (!is.integer(n)) { n <- floor(n) } @@ -241,8 +240,7 @@ head.arrow_dplyr_query <- function(x, n = 6L, ...) { #' @export tail.arrow_dplyr_query <- function(x, n = 6L, ...) { - assert_is(n, c("numeric", "integer")) - assert_that(length(n) == 1) + check_number_decimal(n) if (!is.integer(n)) { n <- floor(n) } diff --git a/r/R/expression.R b/r/R/expression.R index 78272323c70..66dd202f127 100644 --- a/r/R/expression.R +++ b/r/R/expression.R @@ -75,7 +75,7 @@ Expression <- R6Class( ) ) Expression$create <- function(function_name, ..., args = list(...), options = empty_named_list()) { - assert_that(is.string(function_name)) + check_string(function_name) # Make sure all inputs are Expressions args <- lapply(args, function(x) { if (!inherits(x, "Expression")) { @@ -99,7 +99,7 @@ Expression$create <- function(function_name, ..., args = list(...), options = em #' @export `$.Expression` <- function(x, name, ...) { - assert_that(is.string(name)) + check_string(name) if (name %in% ls(x)) { get(name, x) } else { @@ -111,7 +111,7 @@ get_nested_field <- function(expr, name) { if (expr$is_field_ref()) { # Make a nested field ref # TODO(#33756): integer (positional) field refs are supported in C++ - assert_that(is.string(name)) + check_string(name) out <- compute___expr__nested_field_ref(expr, name) } else { # Use the struct_field kernel if expr is a struct: @@ -149,7 +149,7 @@ get_nested_field <- function(expr, name) { Expression$field_ref <- function(name) { # TODO(#33756): allow construction of field ref from integer - assert_that(is.string(name)) + check_string(name) compute___expr__field_ref(name) } Expression$scalar <- function(x) { diff --git a/r/R/extension.R b/r/R/extension.R index 1fe073d7401..43065254641 100644 --- a/r/R/extension.R +++ b/r/R/extension.R @@ -227,11 +227,11 @@ ExtensionType$new <- function(xp) { } ExtensionType$create <- function(storage_type, extension_name, extension_metadata = raw(), type_class = ExtensionType) { - if (is.string(extension_metadata)) { + if (is_string(extension_metadata)) { extension_metadata <- charToRaw(enc2utf8(extension_metadata)) } - - assert_that(is.string(extension_name), is.raw(extension_metadata)) + check_string(extension_name) + assert_that(is.raw(extension_metadata)) assert_is(storage_type, "DataType") assert_is(type_class, "R6ClassGenerator") diff --git a/r/R/feather.R b/r/R/feather.R index 23d5e4ed20c..4c33c138fb1 100644 --- a/r/R/feather.R +++ b/r/R/feather.R @@ -76,7 +76,7 @@ write_feather <- function( ) { # Handle and validate options before touching data version <- as.integer(version) - assert_that(version %in% 1:2) + check_number_whole(version, min = 1, max = 2) if (isTRUE(compression)) { compression <- "default" @@ -88,7 +88,7 @@ write_feather <- function( # TODO(ARROW-17221): if (missing(compression)), we could detect_compression(sink) here compression <- match.arg(compression) chunk_size <- as.integer(chunk_size) - assert_that(chunk_size > 0) + check_number_whole(chunk_size, min = 1) if (compression == "default") { if (version == 2 && codec_is_available("lz4")) { compression <- "lz4" diff --git a/r/R/field.R b/r/R/field.R index f1a9c8a2eac..bd2b89c8aef 100644 --- a/r/R/field.R +++ b/r/R/field.R @@ -84,7 +84,7 @@ Field <- R6Class( ) ) Field$create <- function(name, type, metadata = NULL, nullable = TRUE) { - assert_that(inherits(name, "character"), length(name) == 1L) + check_string(name) type <- as_type(type, name) f <- Field__initialize(enc2utf8(name), type, nullable) if (!is.null(metadata)) { diff --git a/r/R/filesystem.R b/r/R/filesystem.R index abbc9cd6c5b..f7c80b092a7 100644 --- a/r/R/filesystem.R +++ b/r/R/filesystem.R @@ -367,7 +367,7 @@ FileSystem <- R6Class( ) ) FileSystem$from_uri <- function(uri) { - assert_that(is.string(uri)) + check_string(uri) fs___FileSystemFromUri(uri) } @@ -377,7 +377,9 @@ get_paths_and_filesystem <- function(x, filesystem = NULL) { if (inherits(x, "SubTreeFileSystem")) { return(list(fs = x$base_fs, path = x$base_path)) } - assert_that(is.character(x)) + if (!is.character(x)) { + stop("x must be a character vector.", call. = FALSE) + } are_urls <- are_urls(x) if (any(are_urls)) { if (!all(are_urls)) { @@ -412,12 +414,14 @@ get_paths_and_filesystem <- function(x, filesystem = NULL) { # variant of the above function that asserts that x is either a scalar string # or a SubTreeFileSystem get_path_and_filesystem <- function(x, filesystem = NULL) { - assert_that(is.string(x) || inherits(x, "SubTreeFileSystem")) + if (!is_string(x) && !inherits(x, "SubTreeFileSystem")) { + stop("x must be a string or SubTreeFileSystem.") + } get_paths_and_filesystem(x, filesystem) } -is_url <- function(x) is.string(x) && grepl("://", x) -is_http_url <- function(x) is_url(x) && grepl("^http", x) +is_url <- function(x) is_string(x) && grepl("://", x) +is_http_url <- function(x) is_url(x) && startsWith(x, "http") are_urls <- function(x) if (!is.character(x)) FALSE else grepl("://", x) #' @usage NULL @@ -538,7 +542,7 @@ default_s3_options <- list( #' #' @export s3_bucket <- function(bucket, ...) { - assert_that(is.string(bucket)) + check_string(bucket) args <- list2(...) # If user specifies args, they must specify region as arg, env var, or config @@ -573,7 +577,7 @@ s3_bucket <- function(bucket, ...) { #' bucket <- gs_bucket("arrow-datasets") #' @export gs_bucket <- function(bucket, ...) { - assert_that(is.string(bucket)) + check_string(bucket) args <- list2(...) fs <- exec(GcsFileSystem$create, !!!args) @@ -755,7 +759,7 @@ AzureFileSystem$create <- function(account_name, ...) { #' ) #' @export az_container <- function(container_path, ...) { - assert_that(is.string(container_path)) + check_string(container_path) args <- list2(...) fs <- exec(AzureFileSystem$create, !!!args) @@ -798,7 +802,7 @@ SubTreeFileSystem$create <- function(base_path, base_fs = NULL) { #' @export `$.SubTreeFileSystem` <- function(x, name, ...) { # This is to allow delegating methods/properties to the base_fs - assert_that(is.string(name)) + check_string(name) if (name %in% ls(envir = x)) { get(name, x) } else if (name %in% ls(envir = x$base_fs)) { diff --git a/r/R/io.R b/r/R/io.R index 06bd47c0a88..66919636abd 100644 --- a/r/R/io.R +++ b/r/R/io.R @@ -246,7 +246,7 @@ make_readable_file <- function(file, mmap = TRUE, random_access = TRUE) { # file names with trailing slashes, so we need to remove it here. path <- sub("/$", "", file$base_path) file <- filesystem$OpenInputFile(path) - } else if (is.string(file)) { + } else if (is_string(file)) { # if this is a HTTP URL, we need a local copy to pass to FileSystem$from_uri if (random_access && is_http_url(file)) { tf <- tempfile() @@ -303,7 +303,7 @@ make_output_stream <- function(x) { fs_and_path <- FileSystem$from_uri(x) fs_and_path$fs$OpenOutputStream(fs_and_path$path) } else { - assert_that(is.string(x)) + check_string(x) FileOutputStream$create(x) } } @@ -312,7 +312,7 @@ detect_compression <- function(path) { if (inherits(path, "SubTreeFileSystem")) { path <- path$base_path } - if (!is.string(path)) { + if (!is_string(path)) { return("uncompressed") } diff --git a/r/R/parquet.R b/r/R/parquet.R index 6415e36b03c..8a19e4d2335 100644 --- a/r/R/parquet.R +++ b/r/R/parquet.R @@ -251,7 +251,7 @@ make_valid_parquet_version <- function(version, valid_versions = valid_parquet_v version <- format(version, nsmall = 1) } - if (!is.string(version)) { + if (!is_string(version)) { stop( "`version` must be one of ", oxford_paste(names(valid_versions), "or"), diff --git a/r/R/query-engine.R b/r/R/query-engine.R index f1cbebb72a8..6c823879bd5 100644 --- a/r/R/query-engine.R +++ b/r/R/query-engine.R @@ -372,7 +372,7 @@ head.ExecPlanReader <- function(x, n = 6L, ...) { } do_exec_plan_substrait <- function(substrait_plan) { - if (is.string(substrait_plan)) { + if (is_string(substrait_plan)) { substrait_plan <- substrait__internal__SubstraitFromJSON(substrait_plan) } else if (is.raw(substrait_plan)) { substrait_plan <- buffer(substrait_plan) diff --git a/r/R/record-batch-reader.R b/r/R/record-batch-reader.R index d979a3f9fe9..87ab84f46af 100644 --- a/r/R/record-batch-reader.R +++ b/r/R/record-batch-reader.R @@ -134,10 +134,8 @@ as.data.frame.RecordBatchReader <- function(x, row.names = NULL, optional = FALS #' @export head.RecordBatchReader <- function(x, n = 6L, ...) { - assert_is(n, c("numeric", "integer")) - assert_that(length(n) == 1) # Negative n requires knowing nrow(x), which requires consuming the whole RBR - assert_that(n >= 0) + check_number_decimal(n, min = 0) if (!is.integer(n)) { n <- floor(n) } diff --git a/r/R/record-batch-writer.R b/r/R/record-batch-writer.R index eb96592a0f5..49766b7a600 100644 --- a/r/R/record-batch-writer.R +++ b/r/R/record-batch-writer.R @@ -118,7 +118,7 @@ RecordBatchWriter <- R6Class( #' @export RecordBatchStreamWriter <- R6Class("RecordBatchStreamWriter", inherit = RecordBatchWriter) RecordBatchStreamWriter$create <- function(sink, schema, use_legacy_format = NULL, metadata_version = NULL) { - if (is.string(sink)) { + if (is_string(sink)) { stop( "RecordBatchStreamWriter$create() requires an Arrow InputStream. ", "Try providing FileOutputStream$create(", @@ -144,7 +144,7 @@ RecordBatchStreamWriter$create <- function(sink, schema, use_legacy_format = NUL #' @export RecordBatchFileWriter <- R6Class("RecordBatchFileWriter", inherit = RecordBatchStreamWriter) RecordBatchFileWriter$create <- function(sink, schema, use_legacy_format = NULL, metadata_version = NULL) { - if (is.string(sink)) { + if (is_string(sink)) { stop( "RecordBatchFileWriter$create() requires an Arrow InputStream. ", "Try providing FileOutputStream$create(", diff --git a/r/R/record-batch.R b/r/R/record-batch.R index f175b70ac9d..5f8fc3f4ecf 100644 --- a/r/R/record-batch.R +++ b/r/R/record-batch.R @@ -91,7 +91,7 @@ RecordBatch <- R6Class( inherits(other, "RecordBatch") && RecordBatch__Equals(self, other, isTRUE(check_metadata)) }, GetColumnByName = function(name) { - assert_that(is.string(name)) + check_string(name) RecordBatch__GetColumnByName(self, name) }, SelectColumns = function(indices) RecordBatch__SelectColumns(self, indices), diff --git a/r/R/schema.R b/r/R/schema.R index a02753fac55..3eff2f14346 100644 --- a/r/R/schema.R +++ b/r/R/schema.R @@ -227,7 +227,7 @@ prepare_key_value_metadata <- function(metadata) { # Alternative to Schema__ToString that doesn't print metadata print_schema_fields <- function(s, truncate = FALSE, max_fields = 20L) { - assert_that(max_fields > 0) + check_number_whole(max_fields, min = 1) num_fields <- length(s$fields) if (truncate && num_fields > max_fields) { fields_out <- paste(map_chr(s$fields[seq_len(max_fields)], ~ .$ToString()), collapse = "\n") @@ -333,7 +333,7 @@ length.Schema <- function(x) x$num_fields # No match means we're adding to the end i <- match(i, field_names, nomatch = length(field_names) + 1L) } else { - assert_that(is.numeric(i), !is.na(i), i > 0) + check_number_whole(i, min = 1, allow_na = FALSE) # If i is numeric and we have a type, # we need to grab the existing field name for the new one if (!is.null(value) && !inherits(value, "Field")) { @@ -384,7 +384,7 @@ length.Schema <- function(x) x$num_fields #' @export `$.Schema` <- function(x, name, ...) { - assert_that(is.string(name)) + check_string(name) if (name %in% ls(x)) { get(name, x) } else { diff --git a/r/R/table.R b/r/R/table.R index 4e8662e6e71..ea2d44f4869 100644 --- a/r/R/table.R +++ b/r/R/table.R @@ -85,8 +85,7 @@ Table <- R6Class( nbytes = function() Table__ReferencedBufferSize(self), RenameColumns = function(value) Table__RenameColumns(self, value), GetColumnByName = function(name) { - assert_is(name, "character") - assert_that(length(name) == 1) + check_string(name) Table__GetColumnByName(self, name) }, RemoveColumn = function(i) Table__RemoveColumn(self, i), diff --git a/r/R/type.R b/r/R/type.R index 14a4c8f1d2b..042194db02f 100644 --- a/r/R/type.R +++ b/r/R/type.R @@ -608,7 +608,7 @@ timestamp <- function(unit = c("s", "ms", "us", "ns"), timezone = "") { unit <- match.arg(unit) } unit <- make_valid_time_unit(unit, c(valid_time64_units, valid_time32_units)) - assert_that(is.string(timezone)) + check_string(timezone) Timestamp__initialize(unit, timezone) } @@ -784,7 +784,7 @@ as_type <- function(type, name = "type") { canonical_type_str <- function(type_str) { # canonicalizes data type strings, converting data type function names and # aliases to match the strings returned by DataType$ToString() - assert_that(is.string(type_str)) + check_string(type_str) if (grepl("[([<]", type_str)) { stop("Cannot interpret string representations of data types that have parameters", call. = FALSE) } diff --git a/r/R/udf.R b/r/R/udf.R index ce7a911e0d9..8bed33a5368 100644 --- a/r/R/udf.R +++ b/r/R/udf.R @@ -72,7 +72,7 @@ #' head() #' register_scalar_function <- function(name, fun, in_type, out_type, auto_convert = FALSE) { - assert_that(is.string(name)) + check_string(name) scalar_function <- arrow_scalar_function( fun, diff --git a/r/tests/testthat/test-RecordBatch.R b/r/tests/testthat/test-RecordBatch.R index dbb21c06568..0bc8c783723 100644 --- a/r/tests/testthat/test-RecordBatch.R +++ b/r/tests/testthat/test-RecordBatch.R @@ -163,7 +163,7 @@ test_that("[[ and $ on RecordBatch", { expect_error(batch[[c(4, 3)]]) expect_error(batch[[NA]], "'i' must be character or numeric, not logical") expect_error(batch[[NULL]], "'i' must be character or numeric, not NULL") - expect_error(batch[[c("asdf", "jkl;")]], "name is not a string", fixed = TRUE) + expect_error(batch[[c("asdf", "jkl;")]], "`name` must be a single string", fixed = TRUE) }) test_that("[[<- assignment", { @@ -226,10 +226,10 @@ test_that("[[<- assignment", { # nonsense indexes expect_error(batch[[NA]] <- letters[10:1], "'i' must be character or numeric, not logical") expect_error(batch[[NULL]] <- letters[10:1], "'i' must be character or numeric, not NULL") - expect_error(batch[[NA_integer_]] <- letters[10:1], "!is.na(i) is not TRUE", fixed = TRUE) - expect_error(batch[[NA_real_]] <- letters[10:1], "!is.na(i) is not TRUE", fixed = TRUE) - expect_error(batch[[NA_character_]] <- letters[10:1], "!is.na(i) is not TRUE", fixed = TRUE) - expect_error(batch[[c(1, 4)]] <- letters[10:1], "length(i) not equal to 1", fixed = TRUE) + expect_error(batch[[NA_integer_]] <- letters[10:1], "`i` must be", fixed = TRUE) + expect_error(batch[[NA_real_]] <- letters[10:1], "`i` must be", fixed = TRUE) + expect_error(batch[[NA_character_]] <- letters[10:1], "`i` must be", fixed = TRUE) + expect_error(batch[[c(1, 4)]] <- letters[10:1], "`i` must be", fixed = TRUE) }) test_that("head and tail on RecordBatch", { diff --git a/r/tests/testthat/test-Table.R b/r/tests/testthat/test-Table.R index 12ef25975c7..ff1ce8cbb46 100644 --- a/r/tests/testthat/test-Table.R +++ b/r/tests/testthat/test-Table.R @@ -102,7 +102,7 @@ test_that("[, [[, $ for Table", { expect_error(tab[[c(4, 3)]]) expect_error(tab[[NA]], "'i' must be character or numeric, not logical") expect_error(tab[[NULL]], "'i' must be character or numeric, not NULL") - expect_error(tab[[c("asdf", "jkl;")]], "length(name) not equal to 1", fixed = TRUE) + expect_error(tab[[c("asdf", "jkl;")]], "`name` must be", fixed = TRUE) expect_error(tab[-3:3], "Invalid column index") expect_error(tab[1000], "Invalid column index") expect_error(tab[1:1000], "Invalid column index") diff --git a/r/tests/testthat/test-csv.R b/r/tests/testthat/test-csv.R index 8fb11c2a5e3..f9fb4d4911c 100644 --- a/r/tests/testthat/test-csv.R +++ b/r/tests/testthat/test-csv.R @@ -430,7 +430,7 @@ test_that("Write a CSV file with invalid input type", { test_that("Write a CSV file with invalid batch size", { expect_error( write_csv_arrow(tbl_no_dates, csv_file, batch_size = -1), - regexp = "batch_size not greater than 0" + regexp = "`batch_size` must be" ) }) @@ -440,7 +440,7 @@ test_that("Write a CSV with custom NA value", { expect_identical(tbl_out1, tbl_no_dates) csv_contents <- readLines(csv_file) - expect_true(any(grepl("NULL_VALUE", csv_contents))) + expect_match(csv_contents, "NULL_VALUE", all = FALSE) tbl_in1 <- read_csv_arrow(csv_file, na = "NULL_VALUE") expect_identical(tbl_in1, tbl_no_dates) @@ -448,7 +448,7 @@ test_that("Write a CSV with custom NA value", { # Also can use null_value in CsvWriteOptions tbl_out1 <- write_csv_arrow(tbl_no_dates, csv_file, write_options = csv_write_options(null_string = "another_null")) csv_contents <- readLines(csv_file) - expect_true(any(grepl("another_null", csv_contents))) + expect_match(csv_contents, "another_null", all = FALSE) tbl_in1 <- read_csv_arrow(csv_file, na = "another_null") expect_identical(tbl_in1, tbl_no_dates) diff --git a/r/tests/testthat/test-data-type.R b/r/tests/testthat/test-data-type.R index fa2e5bcd6e8..7a59d663c62 100644 --- a/r/tests/testthat/test-data-type.R +++ b/r/tests/testthat/test-data-type.R @@ -343,11 +343,11 @@ test_that("timestamp type input validation", { ) expect_error( timestamp(timezone = 1231231), - "timezone is not a string" + "`timezone` must be" ) expect_error( timestamp(timezone = c("not", "a", "timezone")), - "timezone is not a string" + "`timezone` must be" ) }) diff --git a/r/tests/testthat/test-dataset.R b/r/tests/testthat/test-dataset.R index a64ea4cc47f..1bdd2660719 100644 --- a/r/tests/testthat/test-dataset.R +++ b/r/tests/testthat/test-dataset.R @@ -1446,7 +1446,7 @@ test_that("FileSystemFactoryOptions input validation", { partitioning = "part", factory_options = list(partition_base_dir = 42) ), - "factory_options$partition_base_dir is not a string", + "`factory_options$partition_base_dir` must be a string", fixed = TRUE ) expect_error( diff --git a/r/tests/testthat/test-schema.R b/r/tests/testthat/test-schema.R index 93fb16c77fb..11c76de1d21 100644 --- a/r/tests/testthat/test-schema.R +++ b/r/tests/testthat/test-schema.R @@ -132,11 +132,11 @@ test_that("Schema modification", { # Error handling expect_error(schm$c <- 4, "value must be a DataType") - expect_error(schm[[-3]] <- int32(), "i not greater than 0") - expect_error(schm[[0]] <- int32(), "i not greater than 0") - expect_error(schm[[NA_integer_]] <- int32(), "!is.na(i) is not TRUE", fixed = TRUE) - expect_error(schm[[TRUE]] <- int32(), "i is not a numeric or integer vector") - expect_error(schm[[c(2, 4)]] <- int32(), "length(i) not equal to 1", fixed = TRUE) + expect_error(schm[[-3]] <- int32(), "`i` must be") + expect_error(schm[[0]] <- int32(), "`i` must be") + expect_error(schm[[NA_integer_]] <- int32(), "`i` must be", fixed = TRUE) + expect_error(schm[[TRUE]] <- int32(), "`i` must be") + expect_error(schm[[c(2, 4)]] <- int32(), "`i` must be", fixed = TRUE) }) test_that("Metadata can be reassigned as a whole", { @@ -326,6 +326,6 @@ test_that("schema print truncation", { expect_error( print_schema_fields(schema(tbl), truncate = TRUE, max_fields = 0), - regexp = "max_fields not greater than 0" + regexp = "must be a whole number larger than or equal to 1" ) })