Respect local closures in fill detection

Author: t-kalinowski

R/r2f-constructors.R

@@ -8,10 +8,14 @@
 # double(k), numeric(k). These lower to a single scalar literal carrying
 # array dims, so splicing contexts must spread them explicitly.
 # Used by: c(), array()
-is_fill_constructor_call <- function(e) {
-  is.call(e) &&
-    is.symbol(e[[1L]]) &&
-    as.character(e[[1L]]) %in% c("logical", "integer", "double", "numeric")
+is_fill_constructor_call <- function(e, scope) {
+  if (!is.call(e) || !is.symbol(e[[1L]])) {
+    return(FALSE)
+  }
+  name <- as.character(e[[1L]])
+  name %in%
+    c("logical", "integer", "double", "numeric") &&
+    (is.null(scope) || !inherits(scope[[name]], LocalClosure))
 }
 
 # Name of the call one frame above the current handler ("" at top level).
@@ -44,7 +48,7 @@ r2f_handlers[["c"]] <- function(args, scope = NULL, ...) {
   mode <- promoted$mode
   # Fill constructors are one scalar literal claiming length k; spread them
   # as implied-dos so the emitted element count matches the claimed length.
-  fill_idx <- which(map_lgl(args, is_fill_constructor_call))
+  fill_idx <- which(map_lgl(args, is_fill_constructor_call, scope = scope))
   if (length(fill_idx)) {
     spread_var <- NULL
     for (j in fill_idx) {
@@ -390,7 +394,7 @@ r2f_handlers[["array"]] <- function(args, scope = NULL, ..., hoist = NULL) {
       }
       shape <- glue("int([{dims_f}])")
 
-      is_fill_constructor <- is_fill_constructor_call(args$data)
+      is_fill_constructor <- is_fill_constructor_call(args$data, scope)
 
       axis_terms <- vapply(
         target_dims,

tests/testthat/test-recycling.R

@@ -252,6 +252,40 @@ test_that("symbolic fill spreading preserves pointer-sized lengths", {
   expect_quick_identical(fn, list(c(2, 4, 6)))
 })
 
+test_that("local closures can shadow fill constructors in c() and array()", {
+  numeric_shadow <- function() {
+    numeric <- function() c(1, 2)
+    combined <- c(numeric(), 3)
+    reshaped <- array(numeric(), dim = c(1L, 2L))
+    list(combined = combined, reshaped = reshaped)
+  }
+  expect_quick_identical(numeric_shadow, list())
+
+  integer_shadow <- function() {
+    integer <- function() c(1L, 2L)
+    combined <- c(integer(), 3L)
+    reshaped <- array(integer(), dim = c(1L, 2L))
+    list(combined = combined, reshaped = reshaped)
+  }
+  expect_quick_identical(integer_shadow, list())
+
+  double_shadow <- function() {
+    double <- function() c(1, 2)
+    combined <- c(double(), 3)
+    reshaped <- array(double(), dim = c(1L, 2L))
+    list(combined = combined, reshaped = reshaped)
+  }
+  expect_quick_identical(double_shadow, list())
+
+  logical_shadow <- function() {
+    logical <- function() c(1L, 2L)
+    combined <- c(logical(), 3L)
+    reshaped <- array(logical(), dim = c(1L, 2L))
+    list(combined = combined, reshaped = reshaped)
+  }
+  expect_quick_identical(logical_shadow, list())
+})
+
 test_that("fill constructors materialize where an array is required", {
   # A fill reaching c() through an expression is a real array, not a
   # scalar literal with claimed dims (which emitted one element where the