diff --git a/r/NAMESPACE b/r/NAMESPACE index aa7b30252bbc..7eaa51bc5771 100644 --- a/r/NAMESPACE +++ b/r/NAMESPACE @@ -443,6 +443,7 @@ importFrom(rlang,as_label) importFrom(rlang,as_quosure) importFrom(rlang,call2) importFrom(rlang,call_args) +importFrom(rlang,call_name) 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..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 +#' @importFrom rlang is_bare_list 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..b4becb4081bc 100644 --- a/r/R/dplyr-funcs-string.R +++ b/r/R/dplyr-funcs-string.R @@ -56,15 +56,33 @@ 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) { + modifier_funcs <- c("fixed", "regex", "coll", "boundary") + if (is_call(pattern, modifier_funcs, ns = "stringr")) { + function_called <- call_name(pattern[1]) + + if (function_called %in% modifier_funcs) { + pattern[1] <- call2(function_called) + } + } + + pattern +} + #' Does this string contain regex metacharacters? #' #' @param string String to be tested 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 + ) +})