From 81c4fce188eaf38951e406d80039a6921989d233 Mon Sep 17 00:00:00 2001 From: Jenny Bryan Date: Tue, 12 May 2020 10:04:02 -0700 Subject: [PATCH 1/3] Refactor encoding test helpers and use withr::local_locale() --- tests/testthat/helper-encoding.R | 54 +++++++++++--------- tests/testthat/test-colwise-mutate.R | 74 ++++++++++++++-------------- tests/testthat/test-group-by.r | 38 +++++++------- tests/testthat/test-mutate.r | 12 ++--- 4 files changed, 94 insertions(+), 84 deletions(-) diff --git a/tests/testthat/helper-encoding.R b/tests/testthat/helper-encoding.R index 30226d259c..c3a8710698 100644 --- a/tests/testthat/helper-encoding.R +++ b/tests/testthat/helper-encoding.R @@ -28,31 +28,41 @@ get_alien_lang_string <- function() { lang_strings$different[[1L]] } -with_non_utf8_encoding <- function(code) { - old_encoding <- set_non_utf8_encoding() - on.exit(set_encoding(old_encoding), add = TRUE) - code +try_encoding <- function(enc) { + orig_encoding <- Sys.getlocale("LC_CTYPE") + on.exit(Sys.setlocale("LC_CTYPE", orig_encoding), add = TRUE) + tryCatch({ + Sys.setlocale("LC_CTYPE", enc) + TRUE + }, + warning = function(w) FALSE, + error = function(e) FALSE + ) } -set_non_utf8_encoding <- function() { - if (.Platform$OS.type == "windows") return(NULL) - tryCatch( - locale <- set_encoding("en_US.ISO88591"), - warning = function(e) { - tryCatch( - locale <<- set_encoding("fr_CH.ISO8859-15"), - warning = function(w) { - testthat::skip("Cannot set latin-1 encoding") - } - ) - } +non_utf8_encoding <- function(enc = NULL) { + if (!l10n_info()$`UTF-8`) { + return(Sys.getlocale("LC_CTYPE")) + } + enc <- enc %||% c( + "en_US.ISO8859-1", + "en_US.ISO8859-15", + "fr_CH.ISO8859-1", + "fr_CH.ISO8859-15" ) - locale + available <- vapply(enc, try_encoding, logical(1)) + if (any(available)) { + enc[available][1] + } else { + NULL + } } -set_encoding <- function(encoding) { - if (is.null(encoding)) return(NULL) - locale <- Sys.getlocale("LC_CTYPE") - Sys.setlocale("LC_CTYPE", encoding) - locale +local_non_utf8_encoding <- function(enc = NULL, env = parent.frame()) { + non_utf8 <- non_utf8_encoding(enc) + if (is.null(non_utf8)) { + skip("Can't set a non-UTF-8 encoding") + } else { + withr::local_locale(c(LC_CTYPE = non_utf8), .local_envir = env) + } } diff --git a/tests/testthat/test-colwise-mutate.R b/tests/testthat/test-colwise-mutate.R index 81e5368fb5..d05944dca6 100644 --- a/tests/testthat/test-colwise-mutate.R +++ b/tests/testthat/test-colwise-mutate.R @@ -134,48 +134,48 @@ test_that("summarise_at removes grouping variables (#3613)", { }) test_that("group_by_(at,all) handle utf-8 names (#3829)", { - with_non_utf8_encoding({ - name <- get_native_lang_string() - tbl <- tibble(a = 1) %>% - setNames(name) + local_non_utf8_encoding() - res <- group_by_all(tbl) %>% groups() - expect_equal(res[[1]], sym(name)) + name <- get_native_lang_string() + tbl <- tibble(a = 1) %>% + setNames(name) - res <- group_by_at(tbl, name) %>% groups() - expect_equal(res[[1]], sym(name)) - }) + res <- group_by_all(tbl) %>% groups() + expect_equal(res[[1]], sym(name)) + + res <- group_by_at(tbl, name) %>% groups() + expect_equal(res[[1]], sym(name)) }) test_that("*_(all,at) handle utf-8 names (#2967)", { - with_non_utf8_encoding({ - name <- get_native_lang_string() - tbl <- tibble(a = 1) %>% - setNames(name) - - res <- tbl %>% - mutate_all(list(as.character)) %>% - names() - expect_equal(res, name) - - res <- tbl %>% - mutate_at(name, list(as.character)) %>% - names() - expect_equal(res, name) - - res <- tbl %>% - summarise_all(list(as.character)) %>% - names() - expect_equal(res, name) - - res <- tbl %>% - summarise_at(name, list(as.character)) %>% - names() - expect_equal(res, name) - - res <- select_at(tbl, name) %>% names() - expect_equal(res, name) - }) + local_non_utf8_encoding() + + name <- get_native_lang_string() + tbl <- tibble(a = 1) %>% + setNames(name) + + res <- tbl %>% + mutate_all(list(as.character)) %>% + names() + expect_equal(res, name) + + res <- tbl %>% + mutate_at(name, list(as.character)) %>% + names() + expect_equal(res, name) + + res <- tbl %>% + summarise_all(list(as.character)) %>% + names() + expect_equal(res, name) + + res <- tbl %>% + summarise_at(name, list(as.character)) %>% + names() + expect_equal(res, name) + + res <- select_at(tbl, name) %>% names() + expect_equal(res, name) }) test_that("summarise_at with multiple columns AND unnamed functions works (#4119)", { diff --git a/tests/testthat/test-group-by.r b/tests/testthat/test-group-by.r index 265fee8f32..dfa94b1ba9 100644 --- a/tests/testthat/test-group-by.r +++ b/tests/testthat/test-group-by.r @@ -210,28 +210,28 @@ test_that("ungroup.rowwise_df gives a tbl_df (#936)", { }) test_that(paste0("group_by handles encodings for native strings (#1507)"), { - with_non_utf8_encoding({ - special <- get_native_lang_string() - - df <- data.frame(x = 1:3, Eng = 2:4) - - for (names_converter in c(enc2native, enc2utf8)) { - for (dots_converter in c(enc2native, enc2utf8)) { - names(df) <- names_converter(c(special, "Eng")) - res <- group_by(df, !!!syms(dots_converter(special))) - expect_equal(names(res), names(df)) - expect_equal(group_vars(res), special) - } - } + local_non_utf8_encoding() - for (names_converter in c(enc2native, enc2utf8)) { - names(df) <- names_converter(c(special, "Eng")) + special <- get_native_lang_string() + + df <- data.frame(x = 1:3, Eng = 2:4) - res <- group_by(df, !!!special) - expect_equal(names(res), c(names(df), deparse(special))) - expect_equal(groups(res), list(as.name(enc2native(deparse(special))))) + for (names_converter in c(enc2native, enc2utf8)) { + for (dots_converter in c(enc2native, enc2utf8)) { + names(df) <- names_converter(c(special, "Eng")) + res <- group_by(df, !!!syms(dots_converter(special))) + expect_equal(names(res), names(df)) + expect_equal(group_vars(res), special) } - }) + } + + for (names_converter in c(enc2native, enc2utf8)) { + names(df) <- names_converter(c(special, "Eng")) + + res <- group_by(df, !!!special) + expect_equal(names(res), c(names(df), deparse(special))) + expect_equal(groups(res), list(as.name(enc2native(deparse(special))))) + } }) test_that("group_by handles raw columns (#1803)", { diff --git a/tests/testthat/test-mutate.r b/tests/testthat/test-mutate.r index 3a92799987..39c560742e 100644 --- a/tests/testthat/test-mutate.r +++ b/tests/testthat/test-mutate.r @@ -236,13 +236,13 @@ test_that("mutate() to UTF-8 column names", { }) test_that("Non-ascii column names in version 0.3 are not duplicated (#636)", { - with_non_utf8_encoding({ - df <- tibble(a = "1", b = "2") - names(df) <- c("a", enc2native("\u4e2d")) + local_non_utf8_encoding() - res <- df %>% mutate_all(as.numeric) - expect_equal(names(res), as_utf8_character(names(df))) - }) + df <- tibble(a = "1", b = "2") + names(df) <- c("a", enc2native("\u4e2d")) + + res <- df %>% mutate_all(as.numeric) + expect_equal(names(res), as_utf8_character(names(df))) }) test_that("mutate coerces results from one group with all NA values (#1463) ", { From 104abd5b2e598705d6ce57ca0008bd2bdd365a7c Mon Sep 17 00:00:00 2001 From: Jenny Bryan Date: Tue, 12 May 2020 13:49:58 -0700 Subject: [PATCH 2/3] Bring r-devel fix over from #5237 --- .github/workflows/R-CMD-check.yaml | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/.github/workflows/R-CMD-check.yaml b/.github/workflows/R-CMD-check.yaml index ccf23ec108..c1435bed12 100644 --- a/.github/workflows/R-CMD-check.yaml +++ b/.github/workflows/R-CMD-check.yaml @@ -63,6 +63,11 @@ jobs: sysreqs=$(Rscript -e "cat(sysreqs::sysreq_commands('DESCRIPTION'))") sudo -s eval "$sysreqs" + - name: Install macOS dependencies + if: matrix.config.os == 'macOS-latest' && matrix.config.r == 'devel' + run: | + brew install mariadb-connector-c + - name: Install dependencies run: | remotes::install_deps(dependencies = TRUE) From 5acb4becfb5b106e9670fbd11e98625a6f21859c Mon Sep 17 00:00:00 2001 From: Romain Francois Date: Tue, 12 May 2020 10:56:36 +0200 Subject: [PATCH 3/3] suppressWarnings(env_bind_lazy()) closes #5220 --- R/data-mask.R | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/R/data-mask.R b/R/data-mask.R index 34180bcbb4..1189120a4c 100644 --- a/R/data-mask.R +++ b/R/data-mask.R @@ -53,7 +53,9 @@ DataMask <- R6Class("DataMask", promises <- map(seq_len(ncol(data)), function(.x) expr(promise_fn(!!.x))) - env_bind_lazy(private$bindings, !!!set_names(promises, names_bindings)) + suppressWarnings( + env_bind_lazy(private$bindings, !!!set_names(promises, names_bindings)) + ) private$mask <- new_data_mask(private$bindings) private$mask$.data <- as_data_pronoun(private$mask)