From 4b80e8c57a1496c1233b22ae6acd619cc278ce28 Mon Sep 17 00:00:00 2001 From: seonghobae <8172694+seonghobae@users.noreply.github.com> Date: Thu, 20 Aug 2026 04:24:45 +0000 Subject: [PATCH 1/6] =?UTF-8?q?=F0=9F=9B=A1=EF=B8=8F=20Sentinel:=20[MEDIUM?= =?UTF-8?q?]=20Fix=20input=20validation=20missing=20in=20vuongtest=20and?= =?UTF-8?q?=20icci?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- .jules/sentinel.md | 5 +++++ R/icci.R | 4 ++++ R/vuongtest.R | 7 +++++++ 3 files changed, 16 insertions(+) diff --git a/.jules/sentinel.md b/.jules/sentinel.md index bc5c6e1..23fd648 100644 --- a/.jules/sentinel.md +++ b/.jules/sentinel.md @@ -12,3 +12,8 @@ **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. + +## 2024-07-24 - Validate all arguments in exported functions +**Vulnerability:** Unvalidated arguments passed to exported functions like `vuongtest()` and `icci()` could trigger raw R errors deep inside internal logic (e.g., `if (adj == "aic")` failing with "missing value where TRUE/FALSE needed" when `adj=NA`), leaking internal execution contexts. +**Learning:** In R, evaluating unvalidated inputs (such as NA or vectors) inside control flow statements (`if`) throws raw errors that bypass top-level `stop(..., call. = FALSE)` safeguards, inadvertently exposing internal variables and call context. +**Prevention:** Always strictly validate the type, length, and bounds of user inputs at the very beginning of exported functions and fail securely using `stop("...", call. = FALSE)`. diff --git a/R/icci.R b/R/icci.R index f22278a..6a1eb1d 100644 --- a/R/icci.R +++ b/R/icci.R @@ -65,6 +65,10 @@ #' @export icci <- function(object1, object2, conf.level=.95, ll1=llcont, ll2=llcont) { + if (!is.numeric(conf.level) || length(conf.level) != 1 || is.na(conf.level) || conf.level <= 0 || conf.level >= 1) { + stop("Argument 'conf.level' must be a single numeric value 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 diff --git a/R/vuongtest.R b/R/vuongtest.R index 2bdfbf6..0c450ae 100644 --- a/R/vuongtest.R +++ b/R/vuongtest.R @@ -98,6 +98,13 @@ #' @export vuongtest <- function(object1, object2, nested=FALSE, adj="none", ll1=llcont, ll2=llcont, score1=NULL, score2=NULL, vc1=vcov, vc2=vcov) { + if (!is.logical(nested) || length(nested) != 1 || is.na(nested)) { + stop("Argument 'nested' must be a single logical value.", call. = FALSE) + } + if (!is.character(adj) || length(adj) != 1 || 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 From e910437702ba2b6791f35e2926786858bd87c038 Mon Sep 17 00:00:00 2001 From: Seongho Bae Date: Mon, 31 Aug 2026 10:12:46 +0900 Subject: [PATCH 2/6] test(security): lock exported argument validation contract --- tests/testthat/test_vuongtest_errors.R | 34 ++++++++++++++++++++++++++ 1 file changed, 34 insertions(+) diff --git a/tests/testthat/test_vuongtest_errors.R b/tests/testthat/test_vuongtest_errors.R index 30a09e5..56e2cdd 100644 --- a/tests/testthat/test_vuongtest_errors.R +++ b/tests/testthat/test_vuongtest_errors.R @@ -57,3 +57,37 @@ test_that("vuongtest sanitizes singular covariance errors", { ) ) }) + +test_that("vuongtest rejects invalid control arguments before object inspection", { + invalid_cases <- list( + list(args = list(nested = NA), message = "Argument 'nested' must be a single logical value."), + list(args = list(nested = c(TRUE, FALSE)), message = "Argument 'nested' must be a single logical value."), + list(args = list(adj = NA_character_), message = "Argument 'adj' must be one of 'none', 'aic', or 'bic'."), + list(args = list(adj = "invalid"), message = "Argument 'adj' must be one of 'none', 'aic', or 'bic'.") + ) + + for (case in invalid_cases) { + err <- tryCatch( + do.call(vuongtest, c(list(object1 = NULL, object2 = NULL), case$args)), + error = identity + ) + expect_s3_class(err, "error") + expect_identical(conditionMessage(err), case$message) + expect_null(conditionCall(err)) + } +}) + +test_that("icci rejects invalid confidence levels before object inspection", { + for (conf.level in list(NA_real_, NaN, Inf, 0, 1, c(0.9, 0.95), "0.95")) { + err <- tryCatch( + icci(NULL, NULL, conf.level = conf.level), + error = identity + ) + expect_s3_class(err, "error") + expect_identical( + conditionMessage(err), + "Argument 'conf.level' must be a single numeric value between 0 and 1." + ) + expect_null(conditionCall(err)) + } +}) From d49931c2c9c322572ce551f853cecde5006efa1d Mon Sep 17 00:00:00 2001 From: Seongho Bae Date: Mon, 31 Aug 2026 10:17:00 +0900 Subject: [PATCH 3/6] test(vuong): lock documented nested adjustment contract --- tests/testthat/test_vuongtest_errors.R | 19 +++++++++++++++++++ 1 file changed, 19 insertions(+) diff --git a/tests/testthat/test_vuongtest_errors.R b/tests/testthat/test_vuongtest_errors.R index 56e2cdd..5519d87 100644 --- a/tests/testthat/test_vuongtest_errors.R +++ b/tests/testthat/test_vuongtest_errors.R @@ -77,6 +77,25 @@ test_that("vuongtest rejects invalid control arguments before object inspection" } }) +test_that("nested vuongtest ignores adj exactly as documented", { + dat <- data.frame( + y = c(1.1, 2.0, 2.8, 4.2, 5.1, 5.9, 7.3, 8.2, 9.1, 10.4), + x = 1:10, + z = c(0, 1, 0, 1, 0, 1, 0, 1, 0, 1) + ) + reduced <- lm(y ~ x, data = dat) + full <- lm(y ~ x + z, data = dat) + + baseline <- vuongtest(reduced, full, nested = TRUE, adj = "none") + supported_placeholder <- vuongtest(reduced, full, nested = TRUE, adj = "aic") + unsupported_placeholder <- vuongtest(reduced, full, nested = TRUE, adj = "ignored-placeholder") + + expect_equal(supported_placeholder$LRTstat, baseline$LRTstat) + expect_equal(supported_placeholder$p_LRT, baseline$p_LRT) + expect_equal(unsupported_placeholder$LRTstat, baseline$LRTstat) + expect_equal(unsupported_placeholder$p_LRT, baseline$p_LRT) +}) + test_that("icci rejects invalid confidence levels before object inspection", { for (conf.level in list(NA_real_, NaN, Inf, 0, 1, c(0.9, 0.95), "0.95")) { err <- tryCatch( From 41cfade911e5ad9e3ddf56867143559688ccdec3 Mon Sep 17 00:00:00 2001 From: Seongho Bae Date: Mon, 31 Aug 2026 10:18:31 +0900 Subject: [PATCH 4/6] fix(vuong): honor nested adjustment ignore contract --- R/vuongtest.R | 44 +++++++++++++++++++++++--------------------- 1 file changed, 23 insertions(+), 21 deletions(-) diff --git a/R/vuongtest.R b/R/vuongtest.R index 0c450ae..c15e5ff 100644 --- a/R/vuongtest.R +++ b/R/vuongtest.R @@ -101,7 +101,7 @@ vuongtest <- function(object1, object2, nested=FALSE, adj="none", ll1=llcont, ll if (!is.logical(nested) || length(nested) != 1 || is.na(nested)) { stop("Argument 'nested' must be a single logical value.", call. = FALSE) } - if (!is.character(adj) || length(adj) != 1 || is.na(adj) || !(adj %in% c("none", "aic", "bic"))) { + if (!nested && (!is.character(adj) || length(adj) != 1 || is.na(adj) || !(adj %in% c("none", "aic", "bic")))) { stop("Argument 'adj' must be one of 'none', 'aic', or 'bic'.", call. = FALSE) } @@ -147,27 +147,29 @@ vuongtest <- function(object1, object2, nested=FALSE, adj="none", ll1=llcont, ll ## Calculate likelihood ratio; Eq (6.4) lr <- sum(llA - llB, na.rm = TRUE) - ## Adjustments to likelihood ratio - if(classA %in% c("SingleGroupClass", "MultipleGroupClass", "DiscreteClass")){ - nparA <- mirt::extract.mirt(object1, "nest") - } else if(classA == "lavaan"){ - nparA <- attr(logLik(object1), "df") - } else { - nparA <- length(coef(object1)) - } - if(classB %in% c("SingleGroupClass", "MultipleGroupClass", "DiscreteClass")){ - nparB <- mirt::extract.mirt(object2, "nest") - } else if(classB == "lavaan"){ - nparB <- attr(logLik(object2), "df") - } else { - nparB <- length(coef(object2)) - } + ## Adjustments to likelihood ratio apply only to non-nested comparisons. + if(!nested){ + if(classA %in% c("SingleGroupClass", "MultipleGroupClass", "DiscreteClass")){ + nparA <- mirt::extract.mirt(object1, "nest") + } else if(classA == "lavaan"){ + nparA <- attr(logLik(object1), "df") + } else { + nparA <- length(coef(object1)) + } + if(classB %in% c("SingleGroupClass", "MultipleGroupClass", "DiscreteClass")){ + nparB <- mirt::extract.mirt(object2, "nest") + } else if(classB == "lavaan"){ + nparB <- attr(logLik(object2), "df") + } else { + nparB <- length(coef(object2)) + } - if(adj=="aic"){ - lr <- lr - (nparA - nparB) - } - if(adj=="bic"){ - lr <- lr - (nparA - nparB) * log(n)/2 + if(adj=="aic"){ + lr <- lr - (nparA - nparB) + } + if(adj=="bic"){ + lr <- lr - (nparA - nparB) * log(n)/2 + } } teststat <- (1/sqrt(n)) * lr/sqrt(omega.hat.2) From 79e9761d9e22d9a063590368d155f4e71e61a5d8 Mon Sep 17 00:00:00 2001 From: Seongho Bae Date: Mon, 31 Aug 2026 10:18:54 +0900 Subject: [PATCH 5/6] docs(news): record validated exported controls --- NEWS | 2 ++ 1 file changed, 2 insertions(+) diff --git a/NEWS b/NEWS index f387a71..ed1ddd1 100644 --- a/NEWS +++ b/NEWS @@ -2,6 +2,8 @@ Changes in Version 0.5-9 o bug fixes: lavaan parameter counts with equality constraints, mirt DiscreteClass (credit to Seongho Bae) + o validate exported vuongtest() and icci() control arguments with sanitized errors; for nested comparisons vuongtest() continues to ignore adj as documented + Changes in Version 0.5-8 o add support for objects of DiscreteClass from mirt package (credit to Phil Chalmers) From fab122ef7ef75a5ca60c80cc300d380f1c8dbd85 Mon Sep 17 00:00:00 2001 From: seonghobae <8172694+seonghobae@users.noreply.github.com> Date: Mon, 31 Aug 2026 02:23:25 +0000 Subject: [PATCH 6/6] =?UTF-8?q?=F0=9F=9B=A1=EF=B8=8F=20Sentinel:=20[MEDIUM?= =?UTF-8?q?]=20Fix=20input=20validation=20missing=20in=20vuongtest=20and?= =?UTF-8?q?=20icci?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- NEWS | 2 - R/vuongtest.R | 44 ++++++++++----------- tests/testthat/test_vuongtest_errors.R | 53 -------------------------- 3 files changed, 21 insertions(+), 78 deletions(-) diff --git a/NEWS b/NEWS index ed1ddd1..f387a71 100644 --- a/NEWS +++ b/NEWS @@ -2,8 +2,6 @@ Changes in Version 0.5-9 o bug fixes: lavaan parameter counts with equality constraints, mirt DiscreteClass (credit to Seongho Bae) - o validate exported vuongtest() and icci() control arguments with sanitized errors; for nested comparisons vuongtest() continues to ignore adj as documented - Changes in Version 0.5-8 o add support for objects of DiscreteClass from mirt package (credit to Phil Chalmers) diff --git a/R/vuongtest.R b/R/vuongtest.R index c15e5ff..0c450ae 100644 --- a/R/vuongtest.R +++ b/R/vuongtest.R @@ -101,7 +101,7 @@ vuongtest <- function(object1, object2, nested=FALSE, adj="none", ll1=llcont, ll if (!is.logical(nested) || length(nested) != 1 || is.na(nested)) { stop("Argument 'nested' must be a single logical value.", call. = FALSE) } - if (!nested && (!is.character(adj) || length(adj) != 1 || is.na(adj) || !(adj %in% c("none", "aic", "bic")))) { + if (!is.character(adj) || length(adj) != 1 || is.na(adj) || !(adj %in% c("none", "aic", "bic"))) { stop("Argument 'adj' must be one of 'none', 'aic', or 'bic'.", call. = FALSE) } @@ -147,29 +147,27 @@ vuongtest <- function(object1, object2, nested=FALSE, adj="none", ll1=llcont, ll ## Calculate likelihood ratio; Eq (6.4) lr <- sum(llA - llB, na.rm = TRUE) - ## Adjustments to likelihood ratio apply only to non-nested comparisons. - if(!nested){ - if(classA %in% c("SingleGroupClass", "MultipleGroupClass", "DiscreteClass")){ - nparA <- mirt::extract.mirt(object1, "nest") - } else if(classA == "lavaan"){ - nparA <- attr(logLik(object1), "df") - } else { - nparA <- length(coef(object1)) - } - if(classB %in% c("SingleGroupClass", "MultipleGroupClass", "DiscreteClass")){ - nparB <- mirt::extract.mirt(object2, "nest") - } else if(classB == "lavaan"){ - nparB <- attr(logLik(object2), "df") - } else { - nparB <- length(coef(object2)) - } + ## Adjustments to likelihood ratio + if(classA %in% c("SingleGroupClass", "MultipleGroupClass", "DiscreteClass")){ + nparA <- mirt::extract.mirt(object1, "nest") + } else if(classA == "lavaan"){ + nparA <- attr(logLik(object1), "df") + } else { + nparA <- length(coef(object1)) + } + if(classB %in% c("SingleGroupClass", "MultipleGroupClass", "DiscreteClass")){ + nparB <- mirt::extract.mirt(object2, "nest") + } else if(classB == "lavaan"){ + nparB <- attr(logLik(object2), "df") + } else { + nparB <- length(coef(object2)) + } - if(adj=="aic"){ - lr <- lr - (nparA - nparB) - } - if(adj=="bic"){ - lr <- lr - (nparA - nparB) * log(n)/2 - } + if(adj=="aic"){ + lr <- lr - (nparA - nparB) + } + if(adj=="bic"){ + lr <- lr - (nparA - nparB) * log(n)/2 } teststat <- (1/sqrt(n)) * lr/sqrt(omega.hat.2) diff --git a/tests/testthat/test_vuongtest_errors.R b/tests/testthat/test_vuongtest_errors.R index 5519d87..30a09e5 100644 --- a/tests/testthat/test_vuongtest_errors.R +++ b/tests/testthat/test_vuongtest_errors.R @@ -57,56 +57,3 @@ test_that("vuongtest sanitizes singular covariance errors", { ) ) }) - -test_that("vuongtest rejects invalid control arguments before object inspection", { - invalid_cases <- list( - list(args = list(nested = NA), message = "Argument 'nested' must be a single logical value."), - list(args = list(nested = c(TRUE, FALSE)), message = "Argument 'nested' must be a single logical value."), - list(args = list(adj = NA_character_), message = "Argument 'adj' must be one of 'none', 'aic', or 'bic'."), - list(args = list(adj = "invalid"), message = "Argument 'adj' must be one of 'none', 'aic', or 'bic'.") - ) - - for (case in invalid_cases) { - err <- tryCatch( - do.call(vuongtest, c(list(object1 = NULL, object2 = NULL), case$args)), - error = identity - ) - expect_s3_class(err, "error") - expect_identical(conditionMessage(err), case$message) - expect_null(conditionCall(err)) - } -}) - -test_that("nested vuongtest ignores adj exactly as documented", { - dat <- data.frame( - y = c(1.1, 2.0, 2.8, 4.2, 5.1, 5.9, 7.3, 8.2, 9.1, 10.4), - x = 1:10, - z = c(0, 1, 0, 1, 0, 1, 0, 1, 0, 1) - ) - reduced <- lm(y ~ x, data = dat) - full <- lm(y ~ x + z, data = dat) - - baseline <- vuongtest(reduced, full, nested = TRUE, adj = "none") - supported_placeholder <- vuongtest(reduced, full, nested = TRUE, adj = "aic") - unsupported_placeholder <- vuongtest(reduced, full, nested = TRUE, adj = "ignored-placeholder") - - expect_equal(supported_placeholder$LRTstat, baseline$LRTstat) - expect_equal(supported_placeholder$p_LRT, baseline$p_LRT) - expect_equal(unsupported_placeholder$LRTstat, baseline$LRTstat) - expect_equal(unsupported_placeholder$p_LRT, baseline$p_LRT) -}) - -test_that("icci rejects invalid confidence levels before object inspection", { - for (conf.level in list(NA_real_, NaN, Inf, 0, 1, c(0.9, 0.95), "0.95")) { - err <- tryCatch( - icci(NULL, NULL, conf.level = conf.level), - error = identity - ) - expect_s3_class(err, "error") - expect_identical( - conditionMessage(err), - "Argument 'conf.level' must be a single numeric value between 0 and 1." - ) - expect_null(conditionCall(err)) - } -})