diff --git a/R/aFIPC.R b/R/aFIPC.R index 62546519..7c98b7d8 100644 --- a/R/aFIPC.R +++ b/R/aFIPC.R @@ -1,3 +1,21 @@ +#' Read a bounded binary menu choice +#' +#' @param prompt Prompt passed to the input reader. +#' @param error_message Error raised after three invalid responses. +#' @param read Input reader compatible with [readline()]. +#' @return Integer 1 or 2. +#' @keywords internal +#' @noRd +.read_binary_choice <- function(prompt, error_message, read = readline) { + for (attempt in seq_len(3)) { + value <- read(prompt = prompt) + if (value %in% c("1", "2")) { + return(as.integer(value)) + } + } + stop(error_message, call. = FALSE) +} + #' automated fixed item parameter linking #' #' @import mirt @@ -139,13 +157,10 @@ autoFIPC <- 'set confirmCommonItems = TRUE to accept the supplied pairs.' ) } - for (attempt in seq_len(3)) { - n <- readline(prompt = "Is it correct? (1: Yes 2: No) : ") - if (grepl("^[0-9]+$", n)) { - return(as.integer(n)) - } - } - stop("Too many invalid common item confirmation attempts") + .read_binary_choice( + prompt = "Is it correct? (1: Yes 2: No) : ", + error_message = "Too many invalid common item confirmation attempts" + ) } confirm <- checkCorrect() if (confirm != 1) { @@ -166,16 +181,10 @@ autoFIPC <- if (itemtype == '3PL' && length(oldformBILOGprior) == 0) { checkoldformBILOGprior <- function() { if (!interactive()) stop("Interactive session required for oldform BILOG prior") - for (attempt in seq_len(3)) { - n <- - readline( - prompt = "Do you want to use default BILOG-MG priors for oldform Data? (1: Yes 2: No) : " - ) - if (grepl("^[0-9]+$", n)) { - return(as.integer(n)) - } - } - stop("Too many invalid oldform BILOG prior attempts") + .read_binary_choice( + prompt = "Do you want to use default BILOG-MG priors for oldform Data? (1: Yes 2: No) : ", + error_message = "Too many invalid oldform BILOG prior attempts" + ) } oldformBILOGprior <- checkoldformBILOGprior() if (oldformBILOGprior == 1) { @@ -385,16 +394,10 @@ autoFIPC <- if (itemtype == '3PL' && length(newformBILOGprior) == 0) { checknewformBILOGprior <- function() { if (!interactive()) stop("Interactive session required for newform BILOG prior") - for (attempt in seq_len(3)) { - n <- - readline( - prompt = "Do you want to use default BILOG-MG priors for newform Data? (1: Yes 2: No) : " - ) - if (grepl("^[0-9]+$", n)) { - return(as.integer(n)) - } - } - stop("Too many invalid newform BILOG prior attempts") + .read_binary_choice( + prompt = "Do you want to use default BILOG-MG priors for newform Data? (1: Yes 2: No) : ", + error_message = "Too many invalid newform BILOG prior attempts" + ) } newformBILOGprior <- checknewformBILOGprior() if (newformBILOGprior == 1) { diff --git a/tests/testthat/test-sentinel-validation.R b/tests/testthat/test-sentinel-validation.R index 900f0ee3..afe72ceb 100644 --- a/tests/testthat/test-sentinel-validation.R +++ b/tests/testthat/test-sentinel-validation.R @@ -35,3 +35,54 @@ test_that("autoFIPC validates boolean flags for newformBILOGprior, oldformBILOGp "Security Error: confirmCommonItems must be a single non-NA logical value or NULL" ) }) + + +test_that("binary menu choice accepts only exact documented values", { + make_reader <- function(values) { + force(values) + function(prompt) { + value <- values[[1]] + values <<- values[-1] + value + } + } + + expect_identical( + aFIPC:::.read_binary_choice("prompt", "invalid", make_reader("1")), + 1L + ) + expect_identical( + aFIPC:::.read_binary_choice("prompt", "invalid", make_reader("2")), + 2L + ) + expect_identical( + aFIPC:::.read_binary_choice( + "prompt", + "invalid", + make_reader(c("0", "3", "1")) + ), + 1L + ) + expect_error( + aFIPC:::.read_binary_choice( + "prompt", + "invalid", + make_reader(c("12", "2147483648", " 1")) + ), + "invalid", + fixed = TRUE + ) + + for (value in c("3", "10", "2147483648", "invalid", "")) { + expect_error( + aFIPC:::.read_binary_choice( + "prompt", + "invalid", + make_reader(rep(value, 3)) + ), + "invalid", + fixed = TRUE, + info = paste("unexpectedly accepted binary menu value", dQuote(value)) + ) + } +})