🛡️ Sentinel: [MEDIUM] Fix error handling leaking call stacks via unvalidated inputs

.jules/sentinel.md

@@ -12,3 +12,21 @@
 **Vulnerability:** Raw `stop()` and `warning()` calls without `call. = FALSE` in `llcont.R` and `vuongtest.R` exposed execution stack/call details when raised.
 **Learning:** While some instances of `stop()` inside `tryCatch()` were previously fixed to hide the call stack, other standalone exceptions and warnings still leaked call context. Security must be consistently applied across the entire codebase.
 **Prevention:** Always set `call. = FALSE` when using `stop()` or `warning()` to enforce a secure-by-default boundary and prevent internal execution paths from being disclosed to the end user.
+## 2026-08-11 - Enforce secure error boundaries by validating input types early
+
+**Vulnerability:**
+Exported functions like `vuongtest` and `icci` expect scalar, non-missing control values. Zero-length, non-scalar, missing, non-finite, or out-of-domain values could bypass incomplete guards and fail later inside model dispatch or control flow. Those raw failures exposed internal calls instead of the public validation contract.
+
+**Learning:**
+In R, checking only `length(x) > 1` does not reject zero-length values, and numeric type checks do not reject `NA`, `NaN`, or infinities. `match.arg()` also owns its error condition, so it cannot guarantee this package's call-free public error contract.
+
+**Prevention:**
+Validate exact scalar length, type, missingness, finiteness, bounds, and enum membership before model dispatch. Raise package-owned messages with `stop(..., call. = FALSE)`, and cover zero-length, non-scalar, missing, non-finite, wrong-type, and out-of-domain inputs in `testthat`.
+```R
+if (length(nested) != 1L || !is.logical(nested) || is.na(nested)) {
+    stop(
+        "Argument 'nested' must be a single non-missing logical value.",
+        call. = FALSE
+    )
+}
+```

R/icci.R

@@ -65,6 +65,17 @@
 #' @export
 icci <- function(object1, object2, conf.level=.95, ll1=llcont, ll2=llcont) {
 
+  if (length(conf.level) != 1L || !is.numeric(conf.level) ||
+      !is.finite(conf.level) || conf.level <= 0 || conf.level >= 1) {
+    stop(
+      paste(
+        "Argument 'conf.level' must be a single finite numeric value",
+        "strictly between 0 and 1."
+      ),
+      call. = FALSE
+    )
+  }
+
   ## check objects, issue warnings/errors, get classes/calls
   obinfo <- check.obj(object1, object2)
   callA <- obinfo$callA; classA <- obinfo$classA

R/vuongtest.R

@@ -98,6 +98,20 @@
 #' @export
 vuongtest <- function(object1, object2, nested=FALSE, adj="none", ll1=llcont, ll2=llcont, score1=NULL, score2=NULL, vc1=vcov, vc2=vcov) {
 
+  if (length(nested) != 1L || !is.logical(nested) || is.na(nested)) {
+    stop(
+      "Argument 'nested' must be a single non-missing logical value.",
+      call. = FALSE
+    )
+  }
+  if (length(adj) != 1L || !is.character(adj) || is.na(adj) ||
+      !(adj %in% c("none", "aic", "bic"))) {
+    stop(
+      'Argument \'adj\' must be one of "none", "aic", or "bic".',
+      call. = FALSE
+    )
+  }
+
   ## check objects, issue warnings/errors, get classes/calls
   obinfo <- check.obj(object1, object2)
   callA <- obinfo$callA; classA <- obinfo$classA

tests/testthat/test-input-validation.R

@@ -0,0 +1,58 @@
+capture_input_error <- function(expression) {
+  tryCatch(force(expression), error = identity)
+}
+
+expect_fail_closed_input <- function(error, expected_message) {
+  expect_s3_class(error, "error")
+  expect_identical(conditionMessage(error), expected_message)
+  expect_null(conditionCall(error))
+}
+
+test_that("vuongtest rejects invalid nested values without exposing calls", {
+  invalid_values <- list(logical(), c(TRUE, FALSE), NA, "yes")
+
+  for (value in invalid_values) {
+    error <- capture_input_error(vuongtest(NULL, NULL, nested = value))
+    expect_fail_closed_input(
+      error,
+      "Argument 'nested' must be a single non-missing logical value."
+    )
+  }
+})
+
+test_that("vuongtest rejects invalid adjustment values without exposing calls", {
+  invalid_values <- list(character(), c("aic", "bic"), NA_character_, "other", 1)
+
+  for (value in invalid_values) {
+    error <- capture_input_error(vuongtest(NULL, NULL, adj = value))
+    expect_fail_closed_input(
+      error,
+      "Argument 'adj' must be one of \"none\", \"aic\", or \"bic\"."
+    )
+  }
+})
+
+test_that("icci rejects invalid confidence levels without exposing calls", {
+  invalid_values <- list(
+    numeric(),
+    c(0.90, 0.95),
+    NA_real_,
+    NaN,
+    Inf,
+    -Inf,
+    0,
+    1,
+    "0.95"
+  )
+
+  for (value in invalid_values) {
+    error <- capture_input_error(icci(NULL, NULL, conf.level = value))
+    expect_fail_closed_input(
+      error,
+      paste(
+        "Argument 'conf.level' must be a single finite numeric value",
+        "strictly between 0 and 1."
+      )
+    )
+  }
+})