Validate assignment subscripts and literal bounds against known extents

Two gaps in subscript validation (both compile-and-return-garbage, found
in external review):

- The write side never validated at all: x[-1L] <- 9 and x[0L] <- 1
  compiled into silent out-of-bounds Fortran writes, bypassing the
  exclusion/zero rejection the read-side `[` handler already had.
  compile_subset_designator() now runs the same checks, covering [<-,
  [<<-, and closure host writes.

- Literal subscripts were never checked against a statically-known
  extent: x[4L] and x[2:4] on a declared double(3) compiled and read
  garbage, where R pads with NA (and grows the vector on writes) --
  neither representable in quickr's static-shape model. When the base's
  extent along an axis is a literal, out-of-range literal values, `:`
  endpoints, and c() elements are now compile errors. A single subscript
  on a rank>1 base (R's linear indexing) checks against the product of
  the dims. Symbolic subscripts and symbolic extents are untouched, per
  the documented bounds contract.

Range lower-bound validation (>= 1, including the runtime guard for
symbolic endpoints) stays in check_subscript_range_bounds(); the new
extent check only adds the upper side for literals.

Author: mns-nordicals

R/r2f-closures.R

@@ -1389,6 +1389,16 @@ compile_subset_designator <- function(
     is_bool(allow_logical_vector_subscripts)
   )
 
+  # Same validation as the read-side `[` handler: assignment subscripts
+  # would otherwise lower R's exclusion/zero/out-of-range subscripts into
+  # silent out-of-bounds Fortran writes.
+  extents <- subscript_axis_extents(base_var, length(idx_args))
+  for (i in seq_along(idx_args)) {
+    if (!is_missing(idx_args[[i]])) {
+      check_subscript_expr(idx_args[[i]], extent = extents[[i]])
+    }
+  }
+
   idxs <- whole_doubles_to_ints(idx_args)
   idxs <- imap(idxs, function(idx, i) {
     if (is_missing(idx)) {

R/r2f-subscript.R

@@ -23,9 +23,10 @@ r2f_handlers[["["]] <- function(
   drop <- idx_args$drop %||% TRUE
   idx_args$drop <- NULL
 
-  for (idx in idx_args) {
-    if (!is_missing(idx)) {
-      check_subscript_expr(idx)
+  extents <- subscript_axis_extents(var@value, length(idx_args))
+  for (i in seq_along(idx_args)) {
+    if (!is_missing(idx_args[[i]])) {
+      check_subscript_expr(idx_args[[i]], extent = extents[[i]])
     }
   }
 
@@ -239,15 +240,40 @@ r2f_handlers[["["]] <- function(
 # Fortran would silently read out of bounds. Unary minus on a subscript is
 # unambiguously exclusion syntax in R, so the form is rejected, not just
 # statically-known values. Binary minus (x[n - 1]) is untouched.
-check_subscript_expr <- function(e) {
+#
+# When the base's extent along the subscript's axis is statically known,
+# literal values beyond it are also compile errors: R pads out-of-range
+# reads with NA and grows the vector on out-of-range writes -- neither
+# representable in quickr's static-shape model -- while the generated
+# Fortran would silently read or write out of bounds. Literal `:` range
+# endpoints are checked against the extent here too; their >= 1 lower-bound
+# validation (including the runtime guard for symbolic endpoints) stays in
+# check_subscript_range_bounds().
+check_subscript_expr <- function(e, extent = NULL) {
   e <- unwrap_parens(e)
-  if (is.numeric(e) && length(e) >= 1L && !anyNA(e) && any(e <= 0)) {
-    stop(
-      "subscripts must be positive; R's negative (exclusion) and zero ",
-      "subscripts are not supported: ",
-      deparse1(e),
-      call. = FALSE
-    )
+  if (!is_wholenumber(extent)) {
+    extent <- NULL
+  }
+  if (is.numeric(e) && length(e) >= 1L && !anyNA(e)) {
+    if (any(e <= 0)) {
+      stop(
+        "subscripts must be positive; R's negative (exclusion) and zero ",
+        "subscripts are not supported: ",
+        deparse1(e),
+        call. = FALSE
+      )
+    }
+    if (!is.null(extent) && any(e > extent)) {
+      stop(
+        "subscript exceeds its dimension's extent (",
+        as.integer(extent),
+        "): ",
+        deparse1(e),
+        "; R's out-of-range subscripts (NA padding, vector growing) ",
+        "are not supported",
+        call. = FALSE
+      )
+    }
   }
   if (is_call(e, quote(`-`)) && length(e) == 2L) {
     stop(
@@ -256,10 +282,48 @@ check_subscript_expr <- function(e) {
       call. = FALSE
     )
   }
+  if (is_call(e, quote(`:`)) && length(e) == 3L && !is.null(extent)) {
+    for (endpoint in as.list(e)[-1L]) {
+      endpoint <- unwrap_parens(endpoint)
+      if (is_wholenumber(endpoint) && endpoint > extent) {
+        stop(
+          "index range in x[a:b] exceeds its dimension's extent (",
+          as.integer(extent),
+          "): ",
+          deparse1(e),
+          "; R's out-of-range subscripts (NA padding, vector growing) ",
+          "are not supported",
+          call. = FALSE
+        )
+      }
+    }
+  }
   if (is_call(e, quote(c))) {
     for (arg in as.list(e)[-1L]) {
-      check_subscript_expr(arg)
+      check_subscript_expr(arg, extent = extent)
     }
   }
   invisible(NULL)
 }
+
+# Statically-known extent per subscript axis; NULL where symbolic/unknown.
+# A single subscript on a rank>1 base is R's linear indexing -- its extent
+# is the product of the dims when all of them are known.
+# Used by: the `[` handler (above) and compile_subset_designator()
+# (r2f-closures.R), so read and write subscripts validate identically.
+subscript_axis_extents <- function(var, n_idx) {
+  dims <- var@dims
+  if (n_idx == length(dims)) {
+    return(lapply(dims, function(d) {
+      if (is_wholenumber(d)) as.integer(d) else NULL
+    }))
+  }
+  if (
+    n_idx == 1L &&
+      length(dims) > 1L &&
+      all(vapply(dims, is_wholenumber, logical(1)))
+  ) {
+    return(list(prod(unlist(dims))))
+  }
+  rep(list(NULL), n_idx)
+}

tests/testthat/test-subscript-validation.R

@@ -41,6 +41,110 @@ test_that("negative and zero subscripts are rejected at compile time", {
   expect_error(quick(fnm), "negative subscripts|subscripts must be positive")
 })
 
+test_that("literal subscripts beyond a known extent are compile errors", {
+  # R pads out-of-range reads with NA; quickr refuses at compile time
+  fn <- function(x) {
+    declare(type(x = double(3)))
+    x[4L]
+  }
+  expect_error(quick(fn), "exceeds its dimension's extent \\(3\\)")
+
+  frange <- function(x) {
+    declare(type(x = double(3)))
+    x[2:4]
+  }
+  expect_error(quick(frange), "exceeds its dimension's extent \\(3\\)")
+
+  fc <- function(x) {
+    declare(type(x = double(3)))
+    x[c(1L, 4L)]
+  }
+  expect_error(quick(fc), "exceeds its dimension's extent \\(3\\)")
+
+  fmat <- function(m) {
+    declare(type(m = double(2, 3)))
+    m[1L, 5L]
+  }
+  expect_error(quick(fmat), "exceeds its dimension's extent \\(3\\)")
+
+  # linear indexing on a matrix checks against the total size
+  flin <- function(m) {
+    declare(type(m = double(2, 3)))
+    m[7L]
+  }
+  expect_error(quick(flin), "exceeds its dimension's extent \\(6\\)")
+
+  # in-range literals and symbolic subscripts/extents are untouched
+  fok <- function(x) {
+    declare(type(x = double(3)))
+    x[3L] + x[1:3][1L]
+  }
+  expect_quick_identical(fok, list(as.double(1:3)))
+
+  fsym <- function(x, i) {
+    declare(type(x = double(3)), type(i = integer(1)))
+    x[i]
+  }
+  expect_no_error(quick(fsym))
+
+  fna <- function(x) {
+    declare(type(x = double(NA)))
+    x[5L]
+  }
+  expect_no_error(quick(fna))
+})
+
+test_that("assignment subscripts get the same validation as reads", {
+  # x[-1L] <- 9 compiled into a silent out-of-bounds Fortran write
+  fneg <- function(x) {
+    declare(type(x = double(3)))
+    x[-1L] <- 9
+    x
+  }
+  expect_error(quick(fneg), "subscripts must be positive")
+
+  fzero <- function(x) {
+    declare(type(x = double(3)))
+    x[0L] <- 1
+    x
+  }
+  expect_error(quick(fzero), "subscripts must be positive")
+
+  foob <- function(x) {
+    declare(type(x = double(3)))
+    x[4L] <- 1
+    x
+  }
+  expect_error(quick(foob), "exceeds its dimension's extent \\(3\\)")
+
+  fmat <- function(m) {
+    declare(type(m = double(2, 3)))
+    m[3L, 1L] <- 1
+    m
+  }
+  expect_error(quick(fmat), "exceeds its dimension's extent \\(2\\)")
+
+  # superassignment from a local closure shares the path
+  fsuper <- function(x) {
+    declare(type(x = double(3)))
+    bump <- function() {
+      x[4L] <<- 1
+    }
+    bump()
+    x
+  }
+  expect_error(quick(fsuper), "exceeds its dimension's extent \\(3\\)")
+
+  # valid writes still compile and match R
+  fok <- function(m) {
+    declare(type(m = double(2, 3)))
+    m[2L, 3L] <- 1
+    m[, 2L] <- 0
+    m
+  }
+  expect_quick_identical(fok, list(matrix(as.double(1:6), 2, 3)))
+})
+
 test_that("x[a:b] guards against non-positive bounds at runtime", {
   fn <- function(x, n) {
     declare(type(x = double(NA)), type(n = integer(1)))