tests/testthat/test-cli.R

In arl: Embedded Lisp Dialect

thin <- make_cran_thinner()

test_that("CLI parse defaults to repl", {
  thin()
  parsed <- arl:::CLI$new(character(0))$parse()
  expect_equal(parsed$action, "repl")
  expect_length(parsed$files, 0)
  expect_null(parsed$expr)
  expect_length(parsed$errors, 0)
})

test_that("CLI parse handles file and eval", {
  thin()
  parsed <- arl:::CLI$new(c("--file", "script.arl"))$parse()
  expect_equal(parsed$action, "file")
  expect_equal(parsed$files, "script.arl")
  expect_null(parsed$expr)

  parsed <- arl:::CLI$new(c("--eval", "(+ 1 2)"))$parse()
  expect_equal(parsed$action, "eval")
  expect_equal(parsed$expr, "(+ 1 2)")
  expect_length(parsed$files, 0)
})

test_that("CLI parse handles help and version", {
  thin()
  parsed <- arl:::CLI$new(c("--help"))$parse()
  expect_equal(parsed$action, "help")
  expect_length(parsed$errors, 0)

  parsed <- arl:::CLI$new(c("--version"))$parse()
  expect_equal(parsed$action, "version")
  expect_length(parsed$errors, 0)
})

test_that("CLI parse errors on invalid input", {
  thin()
  parsed <- arl:::CLI$new(c("--file", "a.arl", "--eval", "(+ 1 2)"))$parse()
  expect_true(any(grepl("Use only one of --file/files or --eval", parsed$errors)))

  parsed <- arl:::CLI$new(c("--unknown"))$parse()
  expect_true(length(parsed$errors) > 0)
})

test_that("CLI parse supports short options", {
  thin()
  parsed <- arl:::CLI$new(c("-f", "a.arl"))$parse()
  expect_equal(parsed$action, "file")
  expect_equal(parsed$files, "a.arl")

  parsed <- arl:::CLI$new(c("-e", "(+ 1 2)"))$parse()
  expect_equal(parsed$action, "eval")
  expect_equal(parsed$expr, "(+ 1 2)")

  parsed <- arl:::CLI$new(c("-h"))$parse()
  expect_equal(parsed$action, "help")

  parsed <- arl:::CLI$new(c("-v"))$parse()
  expect_equal(parsed$action, "version")
})

test_that("CLI parse treats positional args as files", {
  thin()
  parsed <- arl:::CLI$new(c("a.arl", "b.arl"))$parse()
  expect_equal(parsed$action, "file")
  expect_equal(parsed$files, c("a.arl", "b.arl"))
})

test_that("CLI parse ignores --args from wrappers", {
  thin()
  parsed <- arl:::CLI$new(c("--args", "--eval", "(+ 1 2)"))$parse()
  expect_equal(parsed$action, "eval")
  expect_equal(parsed$expr, "(+ 1 2)")
})

test_that("cli executes files in order", {
  thin()
  file_a <- tempfile(fileext = ".arl")
  file_b <- tempfile(fileext = ".arl")
  writeLines("(define x 2)", file_a)
  writeLines("(+ x 3)", file_b)

  output <- capture.output(
    arl:::cli(c("--file", file_a, file_b))
  )

  expect_true(any(grepl("5", output)))
})

test_that("cli reads from stdin when not a tty", {
  thin()
  withr::local_options(list(
    arl.cli_isatty_override = FALSE,
    arl.cli_read_stdin_override = function() "(+ 1 2)"
  ))

  output <- capture.output(arl:::cli(character(0)))

  expect_true(any(grepl("3", output)))
})

# Help and Version Functions ----

test_that("cli returns formatted help", {
  thin()
  output <- capture.output(arl:::cli(c("--help")))
  expect_true(any(grepl("Usage:", output)))
  expect_true(any(grepl("--file", output)))
  expect_true(any(grepl("--eval", output)))
  expect_true(any(grepl("--version", output)))
  expect_true(any(grepl("--help", output)))
  expect_true(any(grepl("Examples:", output)))
})

# install_cli ----

test_that("install_cli prints platform-appropriate instructions", {
  thin()
  messages <- character()
  withCallingHandlers(
    arl::install_cli(),
    message = function(m) {
      messages[[length(messages) + 1L]] <<- conditionMessage(m)
      invokeRestart("muffleMessage")
    }
  )
  all_msg <- paste(messages, collapse = " ")
  expect_true(grepl("CLI wrapper script:", all_msg))
  expect_true(grepl("PATH", all_msg))
  if (.Platform$OS.type == "windows") {
    expect_true(grepl("copy", all_msg))
  } else {
    expect_true(grepl("ln -s", all_msg))
  }
})

test_that("install_cli(quiet = TRUE) returns script path silently", {
  thin()
  messages <- character()
  result <- withCallingHandlers(
    arl::install_cli(quiet = TRUE),
    message = function(m) {
      messages[[length(messages) + 1L]] <<- conditionMessage(m)
      invokeRestart("muffleMessage")
    }
  )
  expect_length(messages, 0)
  expect_true(nzchar(result))
  expect_true(file.exists(result))
})

test_that("POSIX wrapper script runs --version", {
  thin()
  skip_on_os("windows")
  script <- system.file("bin", "posix", "arl", package = "arl")
  skip_if(!nzchar(script), "POSIX script not found (not installed)")
  skip_if(!file.exists(script))

  result <- system2(script, args = "--version", stdout = TRUE, stderr = TRUE)
  expect_true(any(grepl("^arl ", result)))
})

# Environment Loading ----

test_that("Engine initializes environment with stdlib", {
  thin()
  engine <- make_engine()
  env <- engine$get_env()
  expect_true(is.environment(env))
  expect_true(exists("map", envir = env))  # stdlib function
})

# Evaluation Functions ----

test_that("cli_eval_text prints non-NULL results", {
  thin()
  engine <- make_engine(load_prelude = FALSE)
  cli <- arl:::CLI$new()
  output <- capture.output(result <- cli$cli_eval_text("(+ 2 3)", engine))
  expect_equal(result, 5)
  expect_true(any(grepl("5", output)))
})

test_that("cli_eval_text does not print define results", {
  thin()
  engine <- make_engine(load_prelude = FALSE)
  cli <- arl:::CLI$new()
  output <- capture.output(result <- cli$cli_eval_text("(define y 10)", engine))
  expect_equal(result, 10)  # define returns the value (invisibly)
  expect_length(output, 0)  # but doesn't print
})

# I/O Helper Functions ----

test_that("CLI cli_isatty wraps isatty", {
  thin()
  result <- arl:::CLI$new()$cli_isatty()
  expect_type(result, "logical")
})

test_that("CLI cli_read_stdin reads from stdin", {
  thin()
  # Test that the method exists and returns a character vector
  # Actual stdin testing requires process redirection
  expect_true(is.function(arl:::CLI$new()$cli_read_stdin))
})

# Main CLI Function - Error Paths ----

test_that("cli shows help with --help flag", {
  thin()
  output <- capture.output(arl:::cli(c("--help")))
  expect_true(any(grepl("Usage:", output)))
})

test_that("cli shows help with -h flag", {
  thin()
  output <- capture.output(arl:::cli(c("-h")))
  expect_true(any(grepl("Usage:", output)))
})

test_that("cli shows version with --version flag", {
  thin()
  output <- capture.output(arl:::cli(c("--version")))
  expect_true(any(grepl("^arl", output)))
})

test_that("cli shows version with -v flag", {
  thin()
  output <- capture.output(arl:::cli(c("-v")))
  expect_true(any(grepl("^arl", output)))
})

test_that("cli errors on missing file", {
  thin()
  # Test that non-existent files are detected
  parsed <- arl:::CLI$new(c("--file", "nonexistent.arl"))$parse()
  expect_equal(parsed$action, "file")
  expect_equal(parsed$files, "nonexistent.arl")

  # The actual error handling (quit) is tested by verifying file.exists is checked
  expect_false(file.exists("nonexistent.arl"))
})

test_that("cli errors and shows help on invalid args", {
  thin()
  exit_fn_called <- FALSE
  withr::local_options(list(
    arl.cli_quiet = TRUE,
    arl.cli_exit_fn = function(message, show_help) {
      exit_fn_called <<- TRUE
    }
  ))
  suppressMessages(arl:::cli(c("--unknown-flag")))
  expect_true(exit_fn_called)
})

test_that("cli handles --eval flag", {
  thin()
  output <- capture.output(arl:::cli(c("--eval", "(+ 10 20)")))
  expect_true(any(grepl("30", output)))
})

test_that("cli handles -e flag", {
  thin()
  output <- capture.output(arl:::cli(c("-e", "(* 3 4)")))
  expect_true(any(grepl("12", output)))
})

test_that("cli starts interactive REPL when tty", {
  thin()
  withr::local_options(list(
    arl.cli_isatty_override = TRUE,
    arl.repl_read_form_override = function(...) NULL,
    arl.repl_can_use_history_override = FALSE
  ))

  output <- capture.output(arl:::cli(character(0)))

  expect_true(any(grepl("^Arl REPL", output)))
})

test_that("cli --quiet and -q set arl.repl_quiet and print no banner", {
  thin()
  withr::local_options(list(
    arl.cli_isatty_override = TRUE,
    arl.repl_read_form_override = function(...) NULL,
    arl.repl_can_use_history_override = FALSE
  ))
  output <- capture.output(arl:::cli(c("--quiet")))
  expect_length(output, 0)
  expect_true(isTRUE(getOption("arl.repl_quiet")))

  withr::local_options(list(arl.repl_quiet = FALSE))
  output_q <- capture.output(arl:::cli(c("-q")))
  expect_length(output_q, 0)
})

test_that("cli reads stdin when not tty with empty input", {
  thin()
  withr::local_options(list(
    arl.cli_isatty_override = FALSE,
    arl.cli_read_stdin_override = function() "   "
  ))

  output <- capture.output(arl:::cli(character(0)))

  expect_length(output, 0)
})

test_that("cli handles multiple files", {
  thin()
  file_a <- tempfile(fileext = ".arl")
  file_b <- tempfile(fileext = ".arl")
  file_c <- tempfile(fileext = ".arl")
  writeLines("(define x 1)", file_a)
  writeLines("(define y 2)", file_b)
  writeLines("(+ x y)", file_c)

  output <- capture.output(arl:::cli(c(file_a, file_b, file_c)))
  expect_true(any(grepl("3", output)))

  unlink(c(file_a, file_b, file_c))
})

test_that("CLI parse handles -- argument terminator", {
  thin()
  parsed <- arl:::CLI$new(c("--", "file1.arl", "-v"))$parse()
  expect_equal(parsed$files, c("file1.arl", "-v"))
  expect_equal(parsed$action, "file")
})

test_that("CLI parse errors on --file without path", {
  thin()
  parsed <- arl:::CLI$new(c("--file"))$parse()
  expect_true(length(parsed$errors) > 0)
})

test_that("CLI parse errors on --eval without expression", {
  thin()
  parsed <- arl:::CLI$new(c("--eval"))$parse()
  expect_true(length(parsed$errors) > 0)
})

test_that("CLI parse errors on multiple --eval flags", {
  thin()
  parsed <- arl:::CLI$new(c("--eval", "(+ 1 2)", "--eval", "(+ 3 4)"))$parse()
  expect_true(length(parsed$errors) > 0)
})

# Short option missing-value edge cases ----

test_that("CLI parse errors on -e without expression", {
  thin()
  parsed <- arl:::CLI$new(c("-e"))$parse()
  expect_true(length(parsed$errors) > 0)
})

test_that("CLI parse errors on -f without path", {
  thin()
  parsed <- arl:::CLI$new(c("-f"))$parse()
  expect_true(length(parsed$errors) > 0)
})

# Combined flag scenarios ----

test_that("CLI parse handles -q with -e", {
  thin()
  parsed <- arl:::CLI$new(c("-q", "-e", "(+ 1 2)"))$parse()
  expect_equal(parsed$action, "eval")
  expect_equal(parsed$expr, "(+ 1 2)")
  expect_length(parsed$errors, 0)
})

test_that("cli -q -e evaluates quietly", {
  thin()
  withr::local_options(list(arl.repl_quiet = FALSE))
  output <- capture.output(arl:::cli(c("-q", "-e", "(+ 5 6)")))
  expect_true(any(grepl("11", output)))
  expect_true(isTRUE(getOption("arl.repl_quiet")))
})

test_that("CLI parse handles -q with positional file", {
  thin()
  parsed <- arl:::CLI$new(c("-q", "script.arl"))$parse()
  expect_equal(parsed$action, "file")
  expect_equal(parsed$files, "script.arl")
  expect_length(parsed$errors, 0)
})

test_that("cli -q with file evaluates quietly", {
  thin()
  f <- tempfile(fileext = ".arl")
  writeLines("(+ 7 8)", f)
  withr::local_options(list(arl.repl_quiet = FALSE))
  output <- capture.output(arl:::cli(c("-q", f)))
  expect_true(any(grepl("15", output)))
  expect_true(isTRUE(getOption("arl.repl_quiet")))
  unlink(f)
})

# Flag ordering ----

test_that("CLI parse handles flags after positional args", {
  thin()
  parsed <- arl:::CLI$new(c("script.arl", "-q"))$parse()
  expect_equal(parsed$action, "file")
  expect_true("script.arl" %in% parsed$files)
  expect_length(parsed$errors, 0)
})

# Eval with spaces and special characters ----

test_that("CLI parse handles -e with spaces in expression", {
  thin()
  parsed <- arl:::CLI$new(c("-e", "(define x 42)"))$parse()
  expect_equal(parsed$action, "eval")
  expect_equal(parsed$expr, "(define x 42)")
  expect_length(parsed$errors, 0)
})

test_that("cli -e with multi-word expression evaluates correctly", {
  thin()
  output <- capture.output(arl:::cli(c("-e", "(+ 100 200)")))
  expect_true(any(grepl("300", output)))
})

# Unknown flag error content ----

test_that("CLI parse reports unrecognized flag in error message", {
  thin()
  parsed <- arl:::CLI$new(c("--bogus"))$parse()
  expect_true(length(parsed$errors) > 0)
  errors_text <- paste(parsed$errors, collapse = " ")
  # Error should mention the unrecognized flag
  expect_true(grepl("bogus", errors_text, ignore.case = TRUE))
})

# Error output paths ----

test_that("cli_exit_with_error produces visible error message", {
  thin()
  error_msg <- NULL
  withr::local_options(list(
    arl.cli_exit_fn = function(message, show_help) {
      error_msg <<- message
    }
  ))
  cli_obj <- arl:::CLI$new()
  cli_obj$cli_exit_with_error("test error message", show_help = FALSE)
  expect_equal(error_msg, "test error message")
})

test_that("cli_exit_with_error signals arl_cli_error when no exit_fn set", {
  thin()
  cli_obj <- arl:::CLI$new()
  err <- NULL
  suppressMessages(capture.output(
    err <- tryCatch(
      cli_obj$cli_exit_with_error("bad input", show_help = FALSE),
      arl_cli_error = function(e) e
    )
  ))
  expect_s3_class(err, "arl_cli_error")
  expect_equal(err$message, "bad input")
  expect_false(err$show_help)
})

test_that("run() signals arl_cli_error on parse errors when no exit_fn set", {
  thin()
  err <- NULL
  suppressMessages(capture.output(
    err <- tryCatch(
      arl:::cli(c("--unknown-flag")),
      arl_cli_error = function(e) e
    )
  ))
  expect_s3_class(err, "arl_cli_error")
  expect_true(grepl("unknown", err$message, ignore.case = TRUE))
})

test_that("run() displays parse errors to user", {
  thin()
  exit_messages <- character(0)
  withr::local_options(list(
    arl.cli_exit_fn = function(message, show_help) {
      exit_messages <<- c(exit_messages, message)
    }
  ))
  # Capture both stdout (help text) and stderr (message handlers)
  messages <- character(0)
  capture.output(
    withCallingHandlers(
      arl:::cli(c("--unknown-flag")),
      message = function(m) {
        messages <<- c(messages, conditionMessage(m))
        invokeRestart("muffleMessage")
      }
    )
  )
  # Either the error goes through exit_fn or is printed — one of these should have content
  has_output <- length(messages) > 0 || length(exit_messages) > 0
  expect_true(has_output)
})