From 98f9d53e6a6db7b5066a98ba89308d067fd5df67 Mon Sep 17 00:00:00 2001 From: Nic Crane Date: Tue, 18 Jul 2023 19:28:02 +0100 Subject: [PATCH 1/7] Add failing tests --- r/tests/testthat/test-dplyr-funcs-string.R | 30 ++++++++++++++++++++++ 1 file changed, 30 insertions(+) diff --git a/r/tests/testthat/test-dplyr-funcs-string.R b/r/tests/testthat/test-dplyr-funcs-string.R index 0dc834dbfea1..fc202bfb3a99 100644 --- a/r/tests/testthat/test-dplyr-funcs-string.R +++ b/r/tests/testthat/test-dplyr-funcs-string.R @@ -1466,3 +1466,33 @@ test_that("str_remove and str_remove_all", { df ) }) + +test_that("GH-36720: stringr modifier functions can be called with namespace prefix", { + df <- tibble(x = c("Foo", "bar")) + compare_dplyr_binding( + .input %>% + transmute(x = str_replace_all(x, stringr::regex("^f", ignore_case = TRUE), "baz")) %>% + collect(), + df + ) + + compare_dplyr_binding( + .input %>% + filter(str_detect(x, stringr::fixed("f", ignore_case = TRUE), negate = TRUE)) %>% + collect(), + df + ) + + x <- Expression$field_ref("x") + + expect_error( + call_binding("str_detect", x, stringr::boundary(type = "character")), + "Pattern modifier `boundary()` not supported in Arrow", + fixed = TRUE + ) + expect_error( + call_binding("str_replace_all", x, stringr::coll("o", locale = "en"), "รณ"), + "Pattern modifier `coll()` not supported in Arrow", + fixed = TRUE + ) +}) From a418272b9827b78de393f58f8dbc83a9c6c14075 Mon Sep 17 00:00:00 2001 From: Nic Crane Date: Tue, 18 Jul 2023 20:01:38 +0100 Subject: [PATCH 2/7] Add code to substitute out stringr:: in stringr::regex etc --- r/NAMESPACE | 2 ++ r/R/arrow-package.R | 2 +- r/R/dplyr-funcs-string.R | 12 ++++++++++++ 3 files changed, 15 insertions(+), 1 deletion(-) diff --git a/r/NAMESPACE b/r/NAMESPACE index aa7b30252bbc..f380810d3d9b 100644 --- a/r/NAMESPACE +++ b/r/NAMESPACE @@ -443,6 +443,8 @@ importFrom(rlang,as_label) importFrom(rlang,as_quosure) importFrom(rlang,call2) importFrom(rlang,call_args) +importFrom(rlang,call_name) +importFrom(rlang,call_ns) importFrom(rlang,caller_env) importFrom(rlang,check_dots_empty) importFrom(rlang,check_dots_empty0) diff --git a/r/R/arrow-package.R b/r/R/arrow-package.R index 79871d8735c9..969e427941dc 100644 --- a/r/R/arrow-package.R +++ b/r/R/arrow-package.R @@ -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 +#' @importFrom rlang is_bare_list call_ns call_name #' @importFrom tidyselect vars_pull eval_select eval_rename #' @importFrom glue glue #' @useDynLib arrow, .registration = TRUE diff --git a/r/R/dplyr-funcs-string.R b/r/R/dplyr-funcs-string.R index 436083d9de45..6b688ef2185b 100644 --- a/r/R/dplyr-funcs-string.R +++ b/r/R/dplyr-funcs-string.R @@ -56,15 +56,27 @@ get_stringr_pattern_options <- function(pattern) { ) } } + ensure_opts <- function(opts) { if (is.character(opts)) { opts <- list(pattern = opts, fixed = FALSE, ignore_case = FALSE) } opts } + + pattern <- clean_pattern_namespace(pattern) + ensure_opts(eval(pattern)) } +# Ensure that e.g. stringr::regex and regex both work within patterns +clean_pattern_namespace <- function(pattern) { + if (call_ns(pattern[1]) == "stringr" && call_name(pattern[1]) %in% c("fixed", "regex", "coll", "boundary")) { + pattern[1] <- call2(rlang::call_name(pattern[1])) + } + pattern +} + #' Does this string contain regex metacharacters? #' #' @param string String to be tested From d03a748993d02f2e051791e9737e75b1d39e4ec8 Mon Sep 17 00:00:00 2001 From: Nic Crane Date: Tue, 18 Jul 2023 20:10:14 +0100 Subject: [PATCH 3/7] Refactor to fit on 1 line and reduce duplication --- r/R/dplyr-funcs-string.R | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/r/R/dplyr-funcs-string.R b/r/R/dplyr-funcs-string.R index 6b688ef2185b..ee45954c8a8a 100644 --- a/r/R/dplyr-funcs-string.R +++ b/r/R/dplyr-funcs-string.R @@ -71,8 +71,11 @@ get_stringr_pattern_options <- function(pattern) { # Ensure that e.g. stringr::regex and regex both work within patterns clean_pattern_namespace <- function(pattern) { - if (call_ns(pattern[1]) == "stringr" && call_name(pattern[1]) %in% c("fixed", "regex", "coll", "boundary")) { - pattern[1] <- call2(rlang::call_name(pattern[1])) + function_called <- pattern[1] + modifier_funcs <- c("fixed", "regex", "coll", "boundary") + + if (call_ns(function_called) == "stringr" && call_name(function_called) %in% modifier_funcs) { + pattern[1] <- call2(call_name(function_called)) } pattern } From 6710fc8ea47c1e73740f62debc1f047c8642886b Mon Sep 17 00:00:00 2001 From: Nic Crane Date: Wed, 19 Jul 2023 11:34:50 +0100 Subject: [PATCH 4/7] Add extra checks to catch non-namespaced calls and non-call patterns --- r/R/dplyr-funcs-string.R | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/r/R/dplyr-funcs-string.R b/r/R/dplyr-funcs-string.R index ee45954c8a8a..79998d84d150 100644 --- a/r/R/dplyr-funcs-string.R +++ b/r/R/dplyr-funcs-string.R @@ -71,12 +71,15 @@ get_stringr_pattern_options <- function(pattern) { # Ensure that e.g. stringr::regex and regex both work within patterns clean_pattern_namespace <- function(pattern) { - function_called <- pattern[1] - modifier_funcs <- c("fixed", "regex", "coll", "boundary") + if (is_call(pattern)) { + function_called <- pattern[1] + modifier_funcs <- c("fixed", "regex", "coll", "boundary") - if (call_ns(function_called) == "stringr" && call_name(function_called) %in% modifier_funcs) { - pattern[1] <- call2(call_name(function_called)) + if (isTRUE(call_ns(function_called) == "stringr") && call_name(function_called) %in% modifier_funcs) { + pattern[1] <- call2(call_name(function_called)) + } } + pattern } From 7eefce58d260d209841fd1d3c07f2226f4e45889 Mon Sep 17 00:00:00 2001 From: Nic Crane Date: Thu, 20 Jul 2023 09:08:10 +0100 Subject: [PATCH 5/7] Update r/R/dplyr-funcs-string.R Co-authored-by: Dewey Dunnington --- r/R/dplyr-funcs-string.R | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/r/R/dplyr-funcs-string.R b/r/R/dplyr-funcs-string.R index 79998d84d150..7008feaa4930 100644 --- a/r/R/dplyr-funcs-string.R +++ b/r/R/dplyr-funcs-string.R @@ -71,7 +71,8 @@ get_stringr_pattern_options <- function(pattern) { # Ensure that e.g. stringr::regex and regex both work within patterns clean_pattern_namespace <- function(pattern) { - if (is_call(pattern)) { + modifier_funcs <- c("fixed", "regex", "coll", "boundary") + if (is_call(pattern, modifier_funcs, ns = "stringr") { function_called <- pattern[1] modifier_funcs <- c("fixed", "regex", "coll", "boundary") From 84e3e872d9a8eb690c0a29c5262f1d514bd85bd1 Mon Sep 17 00:00:00 2001 From: Nic Crane Date: Thu, 20 Jul 2023 09:19:44 +0100 Subject: [PATCH 6/7] Remove code to simplify function --- r/R/dplyr-funcs-string.R | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/r/R/dplyr-funcs-string.R b/r/R/dplyr-funcs-string.R index 7008feaa4930..b4becb4081bc 100644 --- a/r/R/dplyr-funcs-string.R +++ b/r/R/dplyr-funcs-string.R @@ -72,12 +72,11 @@ get_stringr_pattern_options <- function(pattern) { # Ensure that e.g. stringr::regex and regex both work within patterns clean_pattern_namespace <- function(pattern) { modifier_funcs <- c("fixed", "regex", "coll", "boundary") - if (is_call(pattern, modifier_funcs, ns = "stringr") { - function_called <- pattern[1] - modifier_funcs <- c("fixed", "regex", "coll", "boundary") + if (is_call(pattern, modifier_funcs, ns = "stringr")) { + function_called <- call_name(pattern[1]) - if (isTRUE(call_ns(function_called) == "stringr") && call_name(function_called) %in% modifier_funcs) { - pattern[1] <- call2(call_name(function_called)) + if (function_called %in% modifier_funcs) { + pattern[1] <- call2(function_called) } } From 9e80fb865f35278bfd876bd87a06d7c704f8fefd Mon Sep 17 00:00:00 2001 From: Nic Crane Date: Thu, 20 Jul 2023 09:41:43 +0100 Subject: [PATCH 7/7] Remove unused import --- r/NAMESPACE | 1 - r/R/arrow-package.R | 2 +- 2 files changed, 1 insertion(+), 2 deletions(-) diff --git a/r/NAMESPACE b/r/NAMESPACE index f380810d3d9b..7eaa51bc5771 100644 --- a/r/NAMESPACE +++ b/r/NAMESPACE @@ -444,7 +444,6 @@ importFrom(rlang,as_quosure) importFrom(rlang,call2) importFrom(rlang,call_args) importFrom(rlang,call_name) -importFrom(rlang,call_ns) importFrom(rlang,caller_env) importFrom(rlang,check_dots_empty) importFrom(rlang,check_dots_empty0) diff --git a/r/R/arrow-package.R b/r/R/arrow-package.R index 969e427941dc..8f44f8936bdd 100644 --- a/r/R/arrow-package.R +++ b/r/R/arrow-package.R @@ -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_ns call_name +#' @importFrom rlang is_bare_list call_name #' @importFrom tidyselect vars_pull eval_select eval_rename #' @importFrom glue glue #' @useDynLib arrow, .registration = TRUE