fix(input): centralize bounded interactive choices

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) {

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))
+    )
+  }
+})