diff --git a/R/icci.R b/R/icci.R index f22278a..618c50a 100644 --- a/R/icci.R +++ b/R/icci.R @@ -65,6 +65,11 @@ #' @export icci <- function(object1, object2, conf.level=.95, ll1=llcont, ll2=llcont) { + ## Security validation for inputs + 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) + } + ## 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..f061505 100644 --- a/R/vuongtest.R +++ b/R/vuongtest.R @@ -98,6 +98,14 @@ #' @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 + 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) + } + ## check objects, issue warnings/errors, get classes/calls obinfo <- check.obj(object1, object2) callA <- obinfo$callA; classA <- obinfo$classA diff --git a/tests/testthat/test_exported_input_validation.R b/tests/testthat/test_exported_input_validation.R new file mode 100644 index 0000000..08fceb6 --- /dev/null +++ b/tests/testthat/test_exported_input_validation.R @@ -0,0 +1,34 @@ +expect_exported_boundary_error <- function(expr, message) { + err <- tryCatch(expr, error = identity) + expect_s3_class(err, "error") + expect_identical(conditionMessage(err), message) + expect_null(conditionCall(err)) +} + +test_that("vuongtest validates option arguments at the exported boundary", { + nested_message <- "Argument 'nested' must be a single logical value (TRUE/FALSE)." + for (value in list(logical(), NA, c(TRUE, FALSE), 1, "yes", NULL)) { + expect_exported_boundary_error( + vuongtest(NULL, NULL, nested = value), + nested_message + ) + } + + adj_message <- "Argument 'adj' must be a single character string ('none', 'aic', or 'bic')." + for (value in list(character(), NA_character_, c("none", "aic"), "AIC", "", "aic ", "other", 1, NULL)) { + expect_exported_boundary_error( + vuongtest(NULL, NULL, adj = value), + adj_message + ) + } +}) + +test_that("icci validates confidence levels at the exported boundary", { + conf_message <- "Argument 'conf.level' must be a single numeric value between 0 and 1." + for (value in list(numeric(), NA_real_, NaN, Inf, -Inf, c(0.9, 0.95), 0, 1, -0.1, 1.1, "0.95", NULL)) { + expect_exported_boundary_error( + icci(NULL, NULL, conf.level = value), + conf_message + ) + } +})