From 68790b42bc30f64a2346f6fe023532a21d8bc716 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Kirill=20M=C3=BCller?= Date: Sat, 30 Mar 2024 15:17:57 +0100 Subject: [PATCH 1/2] chore: Prefer `map()` over `lapply()` --- R/expectations.R | 4 ++-- R/run.R | 4 ++-- R/spec-arrow-append-table-arrow.R | 8 ++++---- R/spec-arrow-write-table-arrow.R | 8 ++++---- R/spec-driver-data-type.R | 4 ++-- R/spec-meta-bind-.R | 2 +- R/spec-meta-bind-expr.R | 2 +- R/spec-result-roundtrip.R | 20 ++++++++++---------- R/spec-sql-append-table.R | 8 ++++---- R/spec-sql-list-objects.R | 2 +- R/spec-sql-quote-literal.R | 4 ++-- R/spec-sql-write-table.R | 8 ++++---- R/spec-stress-connection.R | 2 +- R/tweaks.R | 2 +- tests/testthat/test-consistency.R | 2 +- 15 files changed, 40 insertions(+), 40 deletions(-) diff --git a/R/expectations.R b/R/expectations.R index 70b18b1e4..c299c6c71 100644 --- a/R/expectations.R +++ b/R/expectations.R @@ -48,10 +48,10 @@ expect_invisible_true <- function(code) { expect_equal_df <- function(actual, expected) { factor_cols <- map_lgl(expected, is.factor) - expected[factor_cols] <- lapply(expected[factor_cols], as.character) + expected[factor_cols] <- map(expected[factor_cols], as.character) asis_cols <- map_lgl(expected, inherits, "AsIs") - expected[asis_cols] <- lapply(expected[asis_cols], unclass) + expected[asis_cols] <- map(expected[asis_cols], unclass) list_cols <- map_lgl(expected, is.list) diff --git a/R/run.R b/R/run.R index 8eeccf23b..a1a26f8d3 100644 --- a/R/run.R +++ b/R/run.R @@ -108,7 +108,7 @@ get_skip_names <- function(skip) { } names_all <- names(spec_all) names_all <- names_all[names_all != ""] - skip_flags_all <- lapply(paste0("(?:^(?:", skip, ")(?:|_[0-9]+)$)"), grepl, names_all, perl = TRUE) + skip_flags_all <- map(paste0("(?:^(?:", skip, ")(?:|_[0-9]+)$)"), grepl, names_all, perl = TRUE) skip_used <- map_lgl(skip_flags_all, any) if (!all(skip_used)) { warning("Unused skip expressions: ", paste(skip[!skip_used], collapse = ", "), @@ -129,7 +129,7 @@ get_run_only_tests <- function(tests, run_only) { return(tests) } - run_only_flags_all <- lapply(paste0("(?:^(?:", run_only, ")$)"), grepl, names_all, perl = TRUE) + run_only_flags_all <- map(paste0("(?:^(?:", run_only, ")$)"), grepl, names_all, perl = TRUE) run_only_flag_all <- Reduce(`|`, run_only_flags_all) run_only_tests <- names_all[run_only_flag_all] diff --git a/R/spec-arrow-append-table-arrow.R b/R/spec-arrow-append-table-arrow.R index 6ae90ddd2..aa0a8579d 100644 --- a/R/spec-arrow-append-table-arrow.R +++ b/R/spec-arrow-append-table-arrow.R @@ -465,16 +465,16 @@ spec_arrow_append_table_arrow <- list( arrow_append_table_arrow_roundtrip_mixed = function(con) { #' Mixing column types in the same table is supported. data <- list("a", 1L, 1.5) - data <- lapply(data, c, NA) + data <- map(data, c, NA) expanded <- expand.grid(a = data, b = data, c = data) - tbl_in_list <- lapply( + tbl_in_list <- map( seq_len(nrow(expanded)), function(i) { - data.frame(lapply(expanded[i, ], unlist, recursive = FALSE)) + data.frame(map(expanded[i, ], unlist, recursive = FALSE)) } ) - lapply(tbl_in_list, test_arrow_roundtrip, con = con) + map(tbl_in_list, test_arrow_roundtrip, con = con) }, arrow_append_table_arrow_name = function(ctx, con) { diff --git a/R/spec-arrow-write-table-arrow.R b/R/spec-arrow-write-table-arrow.R index f9417233f..2c3ac43d9 100644 --- a/R/spec-arrow-write-table-arrow.R +++ b/R/spec-arrow-write-table-arrow.R @@ -698,16 +698,16 @@ spec_arrow_write_table_arrow <- list( arrow_write_table_arrow_roundtrip_mixed = function(ctx, con) { #' Mixing column types in the same table is supported. data <- list("a", 1L, 1.5) - data <- lapply(data, c, NA) + data <- map(data, c, NA) expanded <- expand.grid(a = data, b = data, c = data) - tbl_in_list <- lapply( + tbl_in_list <- map( seq_len(nrow(expanded)), function(i) { - as.data.frame(lapply(expanded[i, ], unlist, recursive = FALSE)) + as.data.frame(map(expanded[i, ], unlist, recursive = FALSE)) } ) - lapply(tbl_in_list, test_arrow_roundtrip, con = con) + map(tbl_in_list, test_arrow_roundtrip, con = con) }, # diff --git a/R/spec-driver-data-type.R b/R/spec-driver-data-type.R index 1b03d26c2..a18654769 100644 --- a/R/spec-driver-data-type.R +++ b/R/spec-driver-data-type.R @@ -87,7 +87,7 @@ test_data_type <- function(ctx, dbObj) { } ) - lapply( + map( compact(expected_data_types), expect_has_data_type ) @@ -96,7 +96,7 @@ test_data_type <- function(ctx, dbObj) { #' As-is objects (i.e., wrapped by [I()]) must be #' supported and return the same results as their unwrapped counterparts. - lapply( + map( compact(expected_data_types), function(value) { if (!is.null(value)) { diff --git a/R/spec-meta-bind-.R b/R/spec-meta-bind-.R index e44ab6fc5..6b03f938e 100644 --- a/R/spec-meta-bind-.R +++ b/R/spec-meta-bind-.R @@ -77,7 +77,7 @@ test_select_bind_expr <- function( get_placeholder_funs <- function(ctx, requires_names = NULL) { placeholder_fun <- ctx$tweaks$placeholder_pattern if (is.character(placeholder_fun)) { - placeholder_funs <- lapply(placeholder_fun, make_placeholder_fun) + placeholder_funs <- map(placeholder_fun, make_placeholder_fun) } else if (is.function(placeholder_fun)) { placeholder_funs <- list(placeholder_fun) } else { diff --git a/R/spec-meta-bind-expr.R b/R/spec-meta-bind-expr.R index f9290c58e..6018993cf 100644 --- a/R/spec-meta-bind-expr.R +++ b/R/spec-meta-bind-expr.R @@ -361,7 +361,7 @@ spec_meta_bind_expr <- function( test_select_bind_expr( arrow = arrow, bind = bind, - lapply(c(get_texts(), NA_character_), factor), + map(c(get_texts(), NA_character_), factor), warn = if (bind == "df") TRUE, dbitest_version = if (arrow == "query" && bind == "df") "1.7.99.13" ) diff --git a/R/spec-result-roundtrip.R b/R/spec-result-roundtrip.R index 56edaf041..83d21da6d 100644 --- a/R/spec-result-roundtrip.R +++ b/R/spec-result-roundtrip.R @@ -60,7 +60,7 @@ spec_result_roundtrip <- list( data_date = function(ctx, con) { #' - coercible using [as.Date()] for dates, as_date_equals_to <- function(x) { - lapply(x, function(xx) { + map(x, function(xx) { function(value) as.Date(value) == xx }) } @@ -84,7 +84,7 @@ spec_result_roundtrip <- list( data_time = function(ctx, con) { #' - coercible using [hms::as_hms()] for times, as_hms_equals_to <- function(x) { - lapply(x, function(xx) { + map(x, function(xx) { function(value) hms::as_hms(value) == xx }) } @@ -145,7 +145,7 @@ spec_result_roundtrip <- list( } char_values <- paste0("2015-01-", sprintf("%.2d", 1:12)) - values <- lapply(char_values, as_numeric_date) + values <- map(char_values, as_numeric_date) sql_names <- ctx$tweaks$date_cast(char_values) test_select_with_null(.ctx = ctx, con, .dots = setNames(values, sql_names)) @@ -199,7 +199,7 @@ spec_result_roundtrip <- list( #' to the true value data_64_bit_numeric = function(ctx, con) { as_numeric_identical_to <- function(x) { - lapply(x, function(xx) { + map(x, function(xx) { function(value) as.numeric(value) == xx }) } @@ -213,7 +213,7 @@ spec_result_roundtrip <- list( #' - Loss of precision when converting to numeric gives a warning data_64_bit_numeric_warning = function(ctx, con) { as_numeric_equals_to <- function(x) { - lapply(x, function(xx) { + map(x, function(xx) { function(value) isTRUE(all.equal(as.numeric(value), xx)) }) } @@ -243,7 +243,7 @@ spec_result_roundtrip <- list( #' of the data data_64_bit_lossless = function(ctx, con) { as_character_equals_to <- function(x) { - lapply(x, function(xx) { + map(x, function(xx) { function(value) as.character(value) == xx }) } @@ -269,8 +269,8 @@ test_select <- function(con, ..., .dots = NULL, .add_null = "none", values <- c(list(...), .dots) value_is_formula <- map_lgl(values, is.call) - names(values)[value_is_formula] <- lapply(values[value_is_formula], "[[", 2L) - values[value_is_formula] <- lapply( + names(values)[value_is_formula] <- map(values[value_is_formula], "[[", 2L) + values[value_is_formula] <- map( values[value_is_formula], function(x) { eval(x[[3]], envir = .envir) @@ -278,7 +278,7 @@ test_select <- function(con, ..., .dots = NULL, .add_null = "none", ) if (is.null(names(values))) { - sql_values <- lapply(values, as.character) + sql_values <- map(values, as.character) } else { sql_values <- names(values) } @@ -383,7 +383,7 @@ coercible_to_time <- function(x) { } as_timestamp_equals_to <- function(x) { - lapply(x, function(xx) { + map(x, function(xx) { function(value) as.POSIXct(value) == xx }) } diff --git a/R/spec-sql-append-table.R b/R/spec-sql-append-table.R index 037410bdb..fb8abdb49 100644 --- a/R/spec-sql-append-table.R +++ b/R/spec-sql-append-table.R @@ -470,16 +470,16 @@ spec_sql_append_table <- list( append_roundtrip_mixed = function(con) { #' Mixing column types in the same table is supported. data <- list("a", 1L, 1.5) - data <- lapply(data, c, NA) + data <- map(data, c, NA) expanded <- expand.grid(a = data, b = data, c = data) - tbl_in_list <- lapply( + tbl_in_list <- map( seq_len(nrow(expanded)), function(i) { - as.data.frame(lapply(expanded[i, ], unlist, recursive = FALSE)) + as.data.frame(map(expanded[i, ], unlist, recursive = FALSE)) } ) - lapply(tbl_in_list, test_table_roundtrip, con = con) + map(tbl_in_list, test_table_roundtrip, con = con) }, append_table_name = function(ctx, con) { diff --git a/R/spec-sql-list-objects.R b/R/spec-sql-list-objects.R index aa4ce1c95..3783bc394 100644 --- a/R/spec-sql-list-objects.R +++ b/R/spec-sql-list-objects.R @@ -25,7 +25,7 @@ spec_sql_list_objects <- list( #' The `table` column is of type list. expect_equal(typeof(objects$table), "list") #' Each object in this list is suitable for use as argument in [dbQuoteIdentifier()]. - expect_error(lapply(objects$table, dbQuoteIdentifier, conn = con), NA) + expect_error(map(objects$table, dbQuoteIdentifier, conn = con), NA) #' The `is_prefix` column is a logical. expect_type(objects$is_prefix, "logical") diff --git a/R/spec-sql-quote-literal.R b/R/spec-sql-quote-literal.R index 7f1baf4d0..baf0c8128 100644 --- a/R/spec-sql-quote-literal.R +++ b/R/spec-sql-quote-literal.R @@ -84,9 +84,9 @@ spec_sql_quote_literal <- list( expect_equal(nrow(x_out), 1L) is_logical <- map_lgl(x, is.logical) - x_out[is_logical] <- lapply(x_out[is_logical], as.logical) + x_out[is_logical] <- map(x_out[is_logical], as.logical) is_numeric <- map_lgl(x, is.numeric) - x_out[is_numeric] <- lapply(x_out[is_numeric], as.numeric) + x_out[is_numeric] <- map(x_out[is_numeric], as.numeric) expect_equal(as.list(unname(x_out)), x) } diff --git a/R/spec-sql-write-table.R b/R/spec-sql-write-table.R index 9ac23c793..f96712279 100644 --- a/R/spec-sql-write-table.R +++ b/R/spec-sql-write-table.R @@ -676,16 +676,16 @@ spec_sql_write_table <- list( roundtrip_mixed = function(ctx, con) { #' Mixing column types in the same table is supported. data <- list("a", 1L, 1.5) - data <- lapply(data, c, NA) + data <- map(data, c, NA) expanded <- expand.grid(a = data, b = data, c = data) - tbl_in_list <- lapply( + tbl_in_list <- map( seq_len(nrow(expanded)), function(i) { - as.data.frame(lapply(expanded[i, ], unlist, recursive = FALSE)) + as.data.frame(map(expanded[i, ], unlist, recursive = FALSE)) } ) - lapply(tbl_in_list, test_table_roundtrip, con = con) + map(tbl_in_list, test_table_roundtrip, con = con) }, #' diff --git a/R/spec-stress-connection.R b/R/spec-stress-connection.R index b2a70ad6d..a94b12493 100644 --- a/R/spec-stress-connection.R +++ b/R/spec-stress-connection.R @@ -6,7 +6,7 @@ spec_stress_connection <- list( simultaneous_connections = function(ctx) { #' Open 50 simultaneous connections cons <- list() - on.exit(try_silent(lapply(cons, dbDisconnect)), add = TRUE) + on.exit(try_silent(map(cons, dbDisconnect)), add = TRUE) for (i in seq_len(50L)) { cons <- c(cons, connect(ctx)) } diff --git a/R/tweaks.R b/R/tweaks.R index e6aad6050..f45e8f963 100644 --- a/R/tweaks.R +++ b/R/tweaks.R @@ -128,7 +128,7 @@ make_tweaks <- function(envir = parent.frame()) { fmls <- tweak_names[-length(tweak_names)] - tweak_quoted <- lapply(setNames(nm = names(fmls)), as.name) + tweak_quoted <- map(setNames(nm = names(fmls)), as.name) tweak_quoted <- c(tweak_quoted) list_call <- as.call(c(quote(list), tweak_quoted[-1])) diff --git a/tests/testthat/test-consistency.R b/tests/testthat/test-consistency.R index c62c3e2f1..084791bc0 100644 --- a/tests/testthat/test-consistency.R +++ b/tests/testthat/test-consistency.R @@ -3,7 +3,7 @@ test_that("no unnamed specs", { vicinity <- NULL if (any(names(tests) == "")) { vicinity <- sort(unique(unlist( - lapply(which(names(tests) == ""), "+", -1:1) + map(which(names(tests) == ""), "+", -1:1) ))) vicinity <- vicinity[names(tests)[vicinity] != ""] } From 5c43686c7a79ffa7ed65d6ff2cd725c7eaada55e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Kirill=20M=C3=BCller?= Date: Sat, 30 Mar 2024 15:23:44 +0100 Subject: [PATCH 2/2] chore: Remove `.dots` argument to `test_select_with_null()` --- R/spec-result-roundtrip.R | 39 ++++++++++++++++++++++----------------- 1 file changed, 22 insertions(+), 17 deletions(-) diff --git a/R/spec-result-roundtrip.R b/R/spec-result-roundtrip.R index 83d21da6d..f94fbf552 100644 --- a/R/spec-result-roundtrip.R +++ b/R/spec-result-roundtrip.R @@ -26,7 +26,7 @@ spec_result_roundtrip <- list( sql_names <- paste0("CAST(", int_values, " AS ", dbDataType(con, logical()), ")") #' with NA for SQL `NULL` values - test_select_with_null(.ctx = ctx, con, .dots = setNames(values, sql_names)) + test_select_with_null(.ctx = ctx, con, !!!setNames(values, sql_names)) }, data_character = function(ctx, con) { @@ -36,8 +36,8 @@ spec_result_roundtrip <- list( sql_names <- as.character(dbQuoteString(con, values)) #' with NA for SQL `NULL` values - test_select_with_null(.ctx = ctx, con, .dots = setNames(values, sql_names)) - test_select_with_null(.ctx = ctx, con, .dots = setNames(test_funs, sql_names)) + test_select_with_null(.ctx = ctx, con, !!!setNames(values, sql_names)) + test_select_with_null(.ctx = ctx, con, !!!setNames(test_funs, sql_names)) }, data_raw = function(ctx, con) { @@ -54,7 +54,7 @@ spec_result_roundtrip <- list( sql_names <- ctx$tweaks$blob_cast(DBI::dbQuoteLiteral(con, list(raw(1)))) #' with [NULL] entries for SQL NULL values - test_select_with_null(.ctx = ctx, con, .dots = setNames(values, sql_names)) + test_select_with_null(.ctx = ctx, con, !!!setNames(values, sql_names)) }, data_date = function(ctx, con) { @@ -70,7 +70,7 @@ spec_result_roundtrip <- list( sql_names <- ctx$tweaks$date_cast(char_values) #' with NA for SQL `NULL` values - test_select_with_null(.ctx = ctx, con, .dots = setNames(values, sql_names)) + test_select_with_null(.ctx = ctx, con, !!!setNames(values, sql_names)) }, data_date_current = function(ctx, con) { @@ -94,7 +94,7 @@ spec_result_roundtrip <- list( sql_names <- ctx$tweaks$time_cast(char_values) #' with NA for SQL `NULL` values - test_select_with_null(.ctx = ctx, con, .dots = setNames(time_values, sql_names)) + test_select_with_null(.ctx = ctx, con, !!!setNames(time_values, sql_names)) }, data_time_current = function(ctx, con) { @@ -117,7 +117,7 @@ spec_result_roundtrip <- list( sql_names <- ctx$tweaks$timestamp_cast(char_values) #' with NA for SQL `NULL` values - test_select_with_null(.ctx = ctx, con, .dots = setNames(time_values, sql_names)) + test_select_with_null(.ctx = ctx, con, !!!setNames(time_values, sql_names)) }, data_timestamp_current = function(ctx, con) { @@ -148,7 +148,7 @@ spec_result_roundtrip <- list( values <- map(char_values, as_numeric_date) sql_names <- ctx$tweaks$date_cast(char_values) - test_select_with_null(.ctx = ctx, con, .dots = setNames(values, sql_names)) + test_select_with_null(.ctx = ctx, con, !!!setNames(values, sql_names)) }, data_date_current_typed = function(ctx, con) { @@ -173,7 +173,7 @@ spec_result_roundtrip <- list( timestamp_values <- rep(list(is_timestamp), 2L) sql_names <- ctx$tweaks$timestamp_cast(char_values) - test_select_with_null(.ctx = ctx, con, .dots = setNames(timestamp_values, sql_names)) + test_select_with_null(.ctx = ctx, con, !!!setNames(timestamp_values, sql_names)) }, data_timestamp_current_typed = function(ctx, con) { @@ -207,7 +207,7 @@ spec_result_roundtrip <- list( char_values <- c("10000000000", "-10000000000") test_values <- as_numeric_identical_to(as.numeric(char_values)) - test_select_with_null(.ctx = ctx, con, .dots = setNames(test_values, char_values)) + test_select_with_null(.ctx = ctx, con, !!!setNames(test_values, char_values)) }, #' - Loss of precision when converting to numeric gives a warning @@ -224,17 +224,17 @@ spec_result_roundtrip <- list( suppressWarnings( expect_warning( - test_select(.ctx = ctx, con, .dots = setNames(test_values, char_values), .add_null = "none") + test_select(.ctx = ctx, con, !!!setNames(test_values, char_values), .add_null = "none") ) ) suppressWarnings( expect_warning( - test_select(.ctx = ctx, con, .dots = setNames(test_values, char_values), .add_null = "above") + test_select(.ctx = ctx, con, !!!setNames(test_values, char_values), .add_null = "above") ) ) suppressWarnings( expect_warning( - test_select(.ctx = ctx, con, .dots = setNames(test_values, char_values), .add_null = "below") + test_select(.ctx = ctx, con, !!!setNames(test_values, char_values), .add_null = "below") ) ) }, @@ -251,7 +251,7 @@ spec_result_roundtrip <- list( char_values <- c("1234567890123456789", "-1234567890123456789") test_values <- as_character_equals_to(char_values) - test_select_with_null(.ctx = ctx, con, .dots = setNames(test_values, char_values)) + test_select_with_null(.ctx = ctx, con, !!!setNames(test_values, char_values)) }, # NULL @@ -264,9 +264,14 @@ test_select_with_null <- function(...) { test_select(..., .add_null = "below") } -test_select <- function(con, ..., .dots = NULL, .add_null = "none", - .ctx, .envir = parent.frame()) { - values <- c(list(...), .dots) +test_select <- function( + con, + ..., + .add_null = "none", + .ctx, + .envir = parent.frame()) { + + values <- list2(...) value_is_formula <- map_lgl(values, is.call) names(values)[value_is_formula] <- map(values[value_is_formula], "[[", 2L)