From d735706f967d2ef0f819aa7c647e960e2fdc3fcf Mon Sep 17 00:00:00 2001 From: Seongho Bae Date: Tue, 8 Sep 2026 01:09:56 +0900 Subject: [PATCH 1/5] test(api): cover callback contracts at exported boundary --- .../testthat/test_exported_input_validation.R | 48 +++++++++++++++++++ 1 file changed, 48 insertions(+) diff --git a/tests/testthat/test_exported_input_validation.R b/tests/testthat/test_exported_input_validation.R index 08fceb6..a340cc1 100644 --- a/tests/testthat/test_exported_input_validation.R +++ b/tests/testthat/test_exported_input_validation.R @@ -32,3 +32,51 @@ test_that("icci validates confidence levels at the exported boundary", { ) } }) + +test_that("exported likelihood callbacks must be functions", { + callback_message <- "Arguments 'll1' and 'll2' must be functions." + for (value in list(NULL, "llcont", 1, TRUE, list())) { + expect_exported_boundary_error( + vuongtest(NULL, NULL, ll1 = value), + callback_message + ) + expect_exported_boundary_error( + vuongtest(NULL, NULL, ll2 = value), + callback_message + ) + expect_exported_boundary_error( + icci(NULL, NULL, ll1 = value), + callback_message + ) + expect_exported_boundary_error( + icci(NULL, NULL, ll2 = value), + callback_message + ) + } +}) + +test_that("vuongtest validates optional score and covariance callbacks", { + score_message <- "Arguments 'score1' and 'score2' must be functions or NULL." + for (value in list("score", 1, TRUE, list())) { + expect_exported_boundary_error( + vuongtest(NULL, NULL, score1 = value), + score_message + ) + expect_exported_boundary_error( + vuongtest(NULL, NULL, score2 = value), + score_message + ) + } + + vc_message <- "Arguments 'vc1' and 'vc2' must be functions." + for (value in list(NULL, "vcov", 1, TRUE, list())) { + expect_exported_boundary_error( + vuongtest(NULL, NULL, vc1 = value), + vc_message + ) + expect_exported_boundary_error( + vuongtest(NULL, NULL, vc2 = value), + vc_message + ) + } +}) From 4c469c25c51d57be5654ad5e2b94eb0e87007e49 Mon Sep 17 00:00:00 2001 From: Seongho Bae Date: Tue, 8 Sep 2026 01:10:52 +0900 Subject: [PATCH 2/5] fix(api): validate likelihood callbacks in icci --- R/icci.R | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/R/icci.R b/R/icci.R index 618c50a..0d968c0 100644 --- a/R/icci.R +++ b/R/icci.R @@ -65,10 +65,13 @@ #' @export icci <- function(object1, object2, conf.level=.95, ll1=llcont, ll2=llcont) { - ## Security validation for inputs + ## Public argument validation if (length(conf.level) != 1 || !is.numeric(conf.level) || 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) } + if (!is.function(ll1) || !is.function(ll2)) { + stop("Arguments 'll1' and 'll2' must be functions.", call. = FALSE) + } ## check objects, issue warnings/errors, get classes/calls obinfo <- check.obj(object1, object2) @@ -139,8 +142,8 @@ print.icci <- function(x, ...) { ## a char vector with each element of length 'width.cutoff' model2call <- deparse(x$call$call2) cat(" Call: ", model2call[1], if (length(model2call) > 1) "...\n" else "\n", sep="") - cat(" AIC:", formatC(x$AIC$AIC2, digits=3L, format="f"), "\n") - cat(" BIC:", formatC(x$BIC$BIC2, digits=3L, format="f"), "\n\n") + cat(" AIC:", formatC(x$AIC$AIC1, digits=3L, format="f"), "\n") + cat(" BIC:", formatC(x$BIC$BIC1, digits=3L, format="f"), "\n\n") cat(x$confLevel * 100, "% Confidence Interval of AIC difference (AICdiff = AIC1 - AIC2) \n", sep="") From 38f9ee2c569430b91534208660940b59537967d4 Mon Sep 17 00:00:00 2001 From: Seongho Bae Date: Tue, 8 Sep 2026 01:12:04 +0900 Subject: [PATCH 3/5] fix(icci): preserve model-2 print contract --- R/icci.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/icci.R b/R/icci.R index 0d968c0..1462034 100644 --- a/R/icci.R +++ b/R/icci.R @@ -142,8 +142,8 @@ print.icci <- function(x, ...) { ## a char vector with each element of length 'width.cutoff' model2call <- deparse(x$call$call2) cat(" Call: ", model2call[1], if (length(model2call) > 1) "...\n" else "\n", sep="") - cat(" AIC:", formatC(x$AIC$AIC1, digits=3L, format="f"), "\n") - cat(" BIC:", formatC(x$BIC$BIC1, digits=3L, format="f"), "\n\n") + cat(" AIC:", formatC(x$AIC$AIC2, digits=3L, format="f"), "\n") + cat(" BIC:", formatC(x$BIC$BIC2, digits=3L, format="f"), "\n\n") cat(x$confLevel * 100, "% Confidence Interval of AIC difference (AICdiff = AIC1 - AIC2) \n", sep="") From f9c33be0956a0ab8a13e7d28daab906a254cf8d8 Mon Sep 17 00:00:00 2001 From: Seongho Bae Date: Tue, 8 Sep 2026 01:13:26 +0900 Subject: [PATCH 4/5] fix(api): validate vuong callback contracts --- R/vuongtest.R | 12 +++++++++++- 1 file changed, 11 insertions(+), 1 deletion(-) diff --git a/R/vuongtest.R b/R/vuongtest.R index f061505..dd61479 100644 --- a/R/vuongtest.R +++ b/R/vuongtest.R @@ -98,13 +98,22 @@ #' @export vuongtest <- function(object1, object2, nested=FALSE, adj="none", ll1=llcont, ll2=llcont, score1=NULL, score2=NULL, vc1=vcov, vc2=vcov) { - ## Security validation for inputs + ## Public argument validation if (length(nested) != 1 || !is.logical(nested) || is.na(nested)) { stop("Argument 'nested' must be a single logical value (TRUE/FALSE).", call. = FALSE) } if (length(adj) != 1 || !is.character(adj) || is.na(adj) || !(adj %in% c("none", "aic", "bic"))) { stop("Argument 'adj' must be a single character string ('none', 'aic', or 'bic').", call. = FALSE) } + if (!is.function(ll1) || !is.function(ll2)) { + stop("Arguments 'll1' and 'll2' must be functions.", call. = FALSE) + } + if ((!is.null(score1) && !is.function(score1)) || (!is.null(score2) && !is.function(score2))) { + stop("Arguments 'score1' and 'score2' must be functions or NULL.", call. = FALSE) + } + if (!is.function(vc1) || !is.function(vc2)) { + stop("Arguments 'vc1' and 'vc2' must be functions.", call. = FALSE) + } ## check objects, issue warnings/errors, get classes/calls obinfo <- check.obj(object1, object2) @@ -285,6 +294,7 @@ calcAB <- function(object, n, scfun, vc){ sc <- estfun(object) } sc.cp <- crossprod(sc)/n + B <- matrix(sc.cp, nrow(A), nrow(A)) list(A=A, B=B, sc=sc) From 39d3cad1f4774f5a61bdc31427a90ca6da691bc2 Mon Sep 17 00:00:00 2001 From: Seongho Bae Date: Tue, 8 Sep 2026 01:13:54 +0900 Subject: [PATCH 5/5] docs(release): record exported callback validation contract --- NEWS | 3 +++ 1 file changed, 3 insertions(+) diff --git a/NEWS b/NEWS index f387a71..c794ff5 100644 --- a/NEWS +++ b/NEWS @@ -2,6 +2,9 @@ Changes in Version 0.5-9 o bug fixes: lavaan parameter counts with equality constraints, mirt DiscreteClass (credit to Seongho Bae) + o validate public vuongtest() and icci() option and callback arguments before + model evaluation, with stable errors for malformed inputs + Changes in Version 0.5-8 o add support for objects of DiscreteClass from mirt package (credit to Phil Chalmers)