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) diff --git a/R/icci.R b/R/icci.R index 618c50a..1462034 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) 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) 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 + ) + } +})