apacheGH-36720: [R] stringr modifier functions cannot be called with …

…namespace prefix (apache#36758)

### Rationale for this change

Bug in implementation of string modified functions caused them to be swallowed when prefixed with stringr namespace

### What changes are included in this PR?

Strips out the `stringr::` prefix when expressions contain `stringr::fixed`, `stringr::coll`, `string::boundary` or `stringr::regex`

### Are these changes tested?

Yes

### Are there any user-facing changes?

Yes
* Closes: apache#36720

Lead-authored-by: Nic Crane <thisisnic@gmail.com>
Co-authored-by: Dewey Dunnington <dewey@dunnington.ca>
Signed-off-by: Nic Crane <thisisnic@gmail.com>

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)

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

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

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
+  )
+})