tests/testthat/test-osrm_server.R

# ROBUST SKIP: Check if OSRM is actually available before running these tests.
# This prevents crashes locally AND ensures CRAN compliance.
# We check both the Option (set by setup) and the PATH.
osrm_exec_opt <- getOption("osrm.routed.exec", "")
has_osrm_option <- nzchar(osrm_exec_opt) && nzchar(Sys.which(osrm_exec_opt))
has_osrm_path <- nzchar(Sys.which("osrm-routed"))

if (!has_osrm_option && !has_osrm_path) {
  testthat::skip("OSRM binary not found (Skipping Server Tests)")
}

# Helper for logging tests - creates MockProcess stub
create_mock_process <- function(captured_env) {
  list(
    new = function(command, args, ..., stdout, stderr) {
      captured_env$captured <- list(
        command = command,
        args = args,
        stdout = stdout,
        stderr = stderr
      )
      structure(
        list(
          is_alive = function() TRUE,
          get_pid = function() 12345,
          kill = function() TRUE,
          wait = function(...) TRUE
        ),
        class = c("process", "list")
      )
    }
  )
}

test_that("osrm_start_server launches osrm-routed with correct arguments", {
  skip_if_not_installed("processx")
  skip_on_cran()
  skip_if(
    packageVersion("testthat") < "3.2.0",
    "Requires testthat >= 3.2.0 for object mocking"
  )

  tmp_dir <- tempdir()
  osrm_path <- file.path(tmp_dir, "test.osrm.mldgr")
  file.create(osrm_path)
  on.exit(unlink(osrm_path), add = TRUE)

  captured <- list()

  # Mock processx::process
  # Mock processx::process without R6 dependency
  MockProcess <- list(
    new = function(command, args, ...) {
      captured <<- list(command = tools::file_path_sans_ext(basename(command)), args = args)
      structure(
        list(
          is_alive = function() TRUE,
          get_pid = function() 12345,
          kill = function() TRUE,
          wait = function(...) TRUE
        ),
        class = c("process", "list")
      )
    }
  )

  state_env <- asNamespace("osrm.backend")$.osrm_state
  orig_registry <- state_env$registry
  orig_session_id <- state_env$session_id
  on.exit({
    state_env$registry <- orig_registry
    state_env$session_id <- orig_session_id
  }, add = TRUE)

  state_env$registry <- list()
  state_env$session_id <- "test-session"

  with_mocked_bindings(
    {
      server <- osrm_start_server(
        osrm_path = osrm_path,
        algorithm = "MLD",
        port = 5002L,
        threads = 4L,
        max_table_size = 500L,
        quiet = TRUE
      )
    },
    process = MockProcess,
    .package = "processx"
  )

  expect_equal(tools::file_path_sans_ext(basename(captured$command)), "osrm-routed")
  expect_true("-a" %in% captured$args && "MLD" %in% captured$args)
  expect_true("-p" %in% captured$args && "5002" %in% captured$args)
  expect_true("-t" %in% captured$args && "4" %in% captured$args)
  expect_true("--max-table-size" %in% captured$args && "500" %in% captured$args)
})

test_that("osrm_start_server validates input file extension", {
  tmp_file <- "test.txt"
  file.create(tmp_file)
  on.exit(unlink(tmp_file))

  expect_error(
    osrm_start_server(tmp_file),
    "must end in .osrm.mldgr or .osrm.hsgr"
  )
})

test_that("osrm_stop handles stopping by object, id, port, and pid", {
  skip_if_not_installed("processx")
  skip_if(
    packageVersion("testthat") < "3.2.0",
    "Requires testthat >= 3.2.0 for object mocking"
  )

  # Mock registry state
  mock_reg <- list(
    "server1" = list(id = "server1", pid = 1001L, port = 5001L, proc = NULL),
    "server2" = list(id = "server2", pid = 1002L, port = 5002L, proc = NULL)
  )

  state_env <- asNamespace("osrm.backend")$.osrm_state
  orig_registry <- state_env$registry
  on.exit(state_env$registry <- orig_registry, add = TRUE)
  state_env$registry <- mock_reg

  with_mocked_bindings(
    {
      # Stop by ID
      res1 <- osrm_stop(id = "server1", quiet = TRUE)
      expect_equal(res1$id, "server1")

      # Stop by Port
      res2 <- osrm_stop(port = 5002, quiet = TRUE)
      expect_equal(res2$port, 5002)

      # Stop non-existent
      expect_error(
        osrm_stop(id = "server3", quiet = TRUE),
        "Could not identify a server"
      )
    },
    .osrm_deregister = function(...) TRUE,
    .osrm_pid_is_running = function(...) TRUE,
    .osrm_kill_pid = function(...) TRUE
  )
})

# Additional tests for osrm_servers() ----
test_that("osrm_servers returns empty data frame when no servers", {
  skip_if(
    packageVersion("testthat") < "3.2.0",
    "Requires testthat >= 3.2.0 for object mocking"
  )

  state_env <- asNamespace("osrm.backend")$.osrm_state
  orig_registry <- state_env$registry
  on.exit(state_env$registry <- orig_registry, add = TRUE)
  state_env$registry <- list()

  result <- osrm_servers()

  expect_s3_class(result, "data.frame")
  expect_equal(nrow(result), 0)
  expect_named(
    result,
    c(
      "id",
      "pid",
      "port",
      "algorithm",
      "started_at",
      "alive",
      "has_handle",
      "log",
      "input_osm",
      "center_lon",
      "center_lat"
      ))
})

test_that("osrm_servers returns server information correctly", {
  skip_if(
    packageVersion("testthat") < "3.2.0",
    "Requires testthat >= 3.2.0 for object mocking"
  )

  mock_proc <- list(
    is_alive = function() TRUE,
    get_pid = function() 1001L
  )
  class(mock_proc) <- c("process", "list")

  mock_reg <- list(
    "server1" = list(
      id = "server1",
      pid = 1001L,
      port = 5001L,
      algorithm = "mld",
      started_at = "2025-01-01T12:00:00.000Z",
      input_osm = "data1.osm.pbf",
      proc = mock_proc
    ),
    "server2" = list(
      id = "server2",
      pid = 1002L,
      port = 5002L,
      algorithm = "ch",
      started_at = "2025-01-01T12:00:01.000Z",
      input_osm = "data2.osm.pbf",
      proc = NULL
    )
  )

  state_env <- asNamespace("osrm.backend")$.osrm_state
  orig_registry <- state_env$registry
  on.exit(state_env$registry <- orig_registry, add = TRUE)
  state_env$registry <- mock_reg

  with_mocked_bindings(
    {
      result <- osrm_servers()

      expect_equal(nrow(result), 2)
      expect_equal(result$id, c("server1", "server2"))
      expect_equal(result$pid, c(1001L, 1002L))
      expect_equal(result$port, c(5001L, 5002L))
      expect_equal(result$algorithm, c("mld", "ch"))
      expect_equal(result$input_osm, c("data1.osm.pbf", "data2.osm.pbf"))
      expect_true(result$has_handle[1])
      expect_false(result$has_handle[2])
    },
    .osrm_pid_is_running = function(...) TRUE
  )
})

# Tests for osrm_stop_all() ----
test_that("osrm_stop_all stops all servers", {
  skip_if(
    packageVersion("testthat") < "3.2.0",
    "Requires testthat >= 3.2.0 for object mocking"
  )

  mock_reg <- list(
    "server1" = list(id = "server1", pid = 1001L, port = 5001L, proc = NULL),
    "server2" = list(id = "server2", pid = 1002L, port = 5002L, proc = NULL)
  )

  state_env <- asNamespace("osrm.backend")$.osrm_state
  orig_registry <- state_env$registry
  on.exit(state_env$registry <- orig_registry, add = TRUE)
  state_env$registry <- mock_reg

  stop_calls <- character()

  with_mocked_bindings(
    {
      result <- osrm_stop_all()

      expect_equal(result, 2L)
      expect_length(stop_calls, 2)
    },
    osrm_stop = function(id, quiet) {
      stop_calls <<- c(stop_calls, id)
      list(id = id, stopped = TRUE)
    }
  )
})

test_that("osrm_stop_all returns 0 when no servers", {
  skip_if(
    packageVersion("testthat") < "3.2.0",
    "Requires testthat >= 3.2.0 for object mocking"
  )

  state_env <- asNamespace("osrm.backend")$.osrm_state
  orig_registry <- state_env$registry
  on.exit(state_env$registry <- orig_registry, add = TRUE)
  state_env$registry <- list()

  result <- osrm_stop_all()
  expect_equal(result, 0L)
})

# Tests for server registry internal functions ----
test_that("registry saves and loads correctly", {
  skip_if_not_installed("jsonlite")
  skip_if(
    packageVersion("testthat") < "3.2.0",
    "Requires testthat >= 3.2.0 for object mocking"
  )

  tmp_dir <- tempfile()
  dir.create(tmp_dir, recursive = TRUE)
  on.exit(unlink(tmp_dir, recursive = TRUE), add = TRUE)

  state_env <- asNamespace("osrm.backend")$.osrm_state
  orig_registry <- state_env$registry
  orig_session_id <- state_env$session_id
  on.exit({
    state_env$registry <- orig_registry
    state_env$session_id <- orig_session_id
  }, add = TRUE)

  state_env$session_id <- "session-test-12345"
  state_env$registry <- list(
    "test-server" = list(
      id = "test-server",
      pid = 1234L,
      port = 5001L,
      algorithm = "mld",
      started_at = "2025-01-01T12:00:00.000Z",
      prefix = "/tmp/test.osrm"
    )
  )

  with_mocked_bindings(
    {
      # Test save
      .osrm_registry_save()

      # Check file exists
      registry_path <- file.path(tmp_dir, "session-test-12345.json")
      expect_true(file.exists(registry_path))

      # Test load
      .osrm_state$registry <- list() # Clear registry
      .osrm_registry_load()

      # Check loaded correctly (excluding proc field which is NULL after load)
      expect_true("test-server" %in% names(.osrm_state$registry))
      expect_equal(.osrm_state$registry$`test-server`$pid, 1234L)
    },
    .osrm_registry_dir = function() tmp_dir,
    .osrm_cleanup_orphans = function() invisible(NULL)
  )
})

# Tests for osrm_start_server error validation ----
test_that("osrm_start_server validates input file extension", {
  tmp_file <- "test.txt"
  file.create(tmp_file)
  on.exit(unlink(tmp_file))

  expect_error(
    osrm_start_server(tmp_file),
    "must end in .osrm.mldgr or .osrm.hsgr"
  )
})

test_that("osrm_start_server accepts dataset_name parameter", {
  skip_if_not_installed("processx")
  skip_on_cran()
  skip_if(
    packageVersion("testthat") < "3.2.0",
    "Requires testthat >= 3.2.0 for object mocking"
  )

  tmp_dir <- tempdir()
  osrm_path <- file.path(tmp_dir, "test.osrm.mldgr")
  file.create(osrm_path)
  on.exit(unlink(osrm_path), add = TRUE)

  captured <- list()

  MockProcess <- list(
    new = function(command, args, ...) {
      captured <<- list(command = tools::file_path_sans_ext(basename(command)), args = args)
      structure(
        list(
          is_alive = function() TRUE,
          get_pid = function() 12345,
          kill = function() TRUE,
          wait = function(...) TRUE
        ),
        class = c("process", "list")
      )
    }
  )

  state_env <- asNamespace("osrm.backend")$.osrm_state
  orig_registry <- state_env$registry
  orig_session_id <- state_env$session_id
  on.exit({
    state_env$registry <- orig_registry
    state_env$session_id <- orig_session_id
  }, add = TRUE)

  state_env$registry <- list()
  state_env$session_id <- "test-session"

  with_mocked_bindings(
    {
      server <- osrm_start_server(
        osrm_path = osrm_path,
        dataset_name = "my_dataset",
        quiet = TRUE
      )

      expect_true("--dataset-name" %in% captured$args)
      expect_true("my_dataset" %in% captured$args)
    },
    process = MockProcess,
    .package = "processx"
  )
})

test_that("osrm_start_server handles max size parameters", {
  skip_if_not_installed("processx")
  skip_on_cran()
  skip_if(
    packageVersion("testthat") < "3.2.0",
    "Requires testthat >= 3.2.0 for object mocking"
  )

  tmp_dir <- tempdir()
  osrm_path <- file.path(tmp_dir, "test.osrm.mldgr")
  file.create(osrm_path)
  on.exit(unlink(osrm_path), add = TRUE)

  captured <- list()

  MockProcess <- list(
    new = function(command, args, ...) {
      captured <<- list(command = tools::file_path_sans_ext(basename(command)), args = args)
      structure(
        list(
          is_alive = function() TRUE,
          get_pid = function() 12345,
          kill = function() TRUE,
          wait = function(...) TRUE
        ),
        class = c("process", "list")
      )
    }
  )

  state_env <- asNamespace("osrm.backend")$.osrm_state
  orig_registry <- state_env$registry
  orig_session_id <- state_env$session_id
  on.exit({
    state_env$registry <- orig_registry
    state_env$session_id <- orig_session_id
  }, add = TRUE)

  state_env$registry <- list()
  state_env$session_id <- "test-session"

  with_mocked_bindings(
    {
      server <- osrm_start_server(
        osrm_path = osrm_path,
        max_table_size = 200L,
        max_trip_size = 50L,
        quiet = TRUE
      )

      expect_true("--max-table-size" %in% captured$args)
      expect_true("200" %in% captured$args)
      expect_true("--max-trip-size" %in% captured$args)
      expect_true("50" %in% captured$args)
    },
    process = MockProcess,
    .package = "processx"
  )
})

# Tests for logging configuration ----
test_that("osrm_start_server uses temp file by default for logging", {
  skip_if_not_installed("processx")
  skip_on_cran()
  skip_if(
    packageVersion("testthat") < "3.2.0",
    "Requires testthat >= 3.2.0 for object mocking"
  )

  tmp_dir <- tempdir()
  osrm_path <- file.path(tmp_dir, "test.osrm.mldgr")
  file.create(osrm_path)
  on.exit(unlink(osrm_path), add = TRUE)

  captured_env <- new.env()
  captured_env$captured <- list()
  MockProcess <- create_mock_process(captured_env)

  state_env <- asNamespace("osrm.backend")$.osrm_state
  orig_registry <- state_env$registry
  orig_session_id <- state_env$session_id
  on.exit({
    state_env$registry <- orig_registry
    state_env$session_id <- orig_session_id
  }, add = TRUE)

  state_env$registry <- list()
  state_env$session_id <- "test-session"

  with_mocked_bindings(
    {
      server <- osrm_start_server(
        osrm_path = osrm_path,
        quiet = TRUE
      )
      on.exit(try(server$kill(), silent = TRUE), add = TRUE)

      # Should use a temp file with .log extension
      expect_type(captured_env$captured$stdout, "character")
      expect_type(captured_env$captured$stderr, "character")
      expect_false(identical(captured_env$captured$stdout, ""))
      expect_match(captured_env$captured$stdout, "\\.log$")
    },
    process = MockProcess,
    .package = "processx"
  )
})

test_that("osrm_start_server routes to console when verbose = TRUE", {
  skip_if_not_installed("processx")
  skip_on_cran()
  skip_if(
    packageVersion("testthat") < "3.2.0",
    "Requires testthat >= 3.2.0 for object mocking"
  )

  tmp_dir <- tempdir()
  osrm_path <- file.path(tmp_dir, "test.osrm.mldgr")
  file.create(osrm_path)
  on.exit(unlink(osrm_path), add = TRUE)

  captured_env <- new.env()
  captured_env$captured <- list()
  MockProcess <- create_mock_process(captured_env)

  state_env <- asNamespace("osrm.backend")$.osrm_state
  orig_registry <- state_env$registry
  orig_session_id <- state_env$session_id
  on.exit({
    state_env$registry <- orig_registry
    state_env$session_id <- orig_session_id
  }, add = TRUE)

  state_env$registry <- list()
  state_env$session_id <- "test-session"

  with_mocked_bindings(
    {
      server <- osrm_start_server(
        osrm_path = osrm_path,
        verbose = TRUE,
        quiet = TRUE
      )
      on.exit(try(server$kill(), silent = TRUE), add = TRUE)

      # Should route to console (empty string)
      expect_equal(captured_env$captured$stdout, "")
      expect_equal(captured_env$captured$stderr, "")
    },
    process = MockProcess,
    .package = "processx"
  )
})

test_that("osrm_start_server uses osrm.server.log_file option when set (character)", {
  skip_if_not_installed("processx")
  skip_on_cran()
  skip_if(
    packageVersion("testthat") < "3.2.0",
    "Requires testthat >= 3.2.0 for object mocking"
  )

  tmp_dir <- tempdir()
  osrm_path <- file.path(tmp_dir, "test.osrm.mldgr")
  file.create(osrm_path)
  on.exit(unlink(osrm_path), add = TRUE)

  custom_log <- file.path(tmp_dir, "custom_osrm.log")

  captured_env <- new.env()
  captured_env$captured <- list()
  MockProcess <- create_mock_process(captured_env)

  state_env <- asNamespace("osrm.backend")$.osrm_state
  orig_registry <- state_env$registry
  orig_session_id <- state_env$session_id
  on.exit({
    state_env$registry <- orig_registry
    state_env$session_id <- orig_session_id
  }, add = TRUE)

  state_env$registry <- list()
  state_env$session_id <- "test-session"

  with_mocked_bindings(
    {
      # Set custom log file option
      old_opt <- options(osrm.server.log_file = custom_log)
      on.exit(options(old_opt), add = TRUE)

      server <- osrm_start_server(
        osrm_path = osrm_path,
        quiet = TRUE
      )
      on.exit(try(server$kill(), silent = TRUE), add = TRUE)

      # Should use the custom log path
      expect_equal(
        normalizePath(captured_env$captured$stdout, mustWork = FALSE, winslash = "/"),
        normalizePath(custom_log, mustWork = FALSE, winslash = "/")
      )
      expect_equal(
        normalizePath(captured_env$captured$stderr, mustWork = FALSE, winslash = "/"),
        normalizePath(custom_log, mustWork = FALSE, winslash = "/")
      )
    },
    process = MockProcess,
    .package = "processx"
  )
})

test_that("osrm_start_server falls back to temp file when list option is used", {
  skip_if_not_installed("processx")
  skip_on_cran()
  skip_if(
    packageVersion("testthat") < "3.2.0",
    "Requires testthat >= 3.2.0 for object mocking"
  )

  tmp_dir <- tempdir()
  osrm_path <- file.path(tmp_dir, "test.osrm.mldgr")
  file.create(osrm_path)
  on.exit(unlink(osrm_path), add = TRUE)

  captured_env <- new.env()
  captured_env$captured <- list()
  MockProcess <- create_mock_process(captured_env)

  state_env <- asNamespace("osrm.backend")$.osrm_state
  orig_registry <- state_env$registry
  orig_session_id <- state_env$session_id
  on.exit({
    state_env$registry <- orig_registry
    state_env$session_id <- orig_session_id
  }, add = TRUE)

  state_env$registry <- list()
  state_env$session_id <- "test-session"

  with_mocked_bindings(
    {
      # Set list option (now deprecated) - should fall back to temp file
      old_opt <- options(
        osrm.server.log_file = list(
          stdout = "/tmp/out.log",
          stderr = "/tmp/err.log"
        )
      )
      on.exit(options(old_opt), add = TRUE)

      server <- osrm_start_server(
        osrm_path = osrm_path,
        quiet = TRUE
      )
      on.exit(try(server$kill(), silent = TRUE), add = TRUE)

      # Should fall back to temp file (not use the list paths)
      expect_type(captured_env$captured$stdout, "character")
      expect_type(captured_env$captured$stderr, "character")
      expect_false(identical(captured_env$captured$stdout, "/tmp/out.log"))
      expect_false(identical(captured_env$captured$stderr, "/tmp/err.log"))
      expect_match(captured_env$captured$stdout, "\\.log$")
    },
    process = MockProcess,
    .package = "processx"
  )
})

test_that("osrm_start_server reads log file on startup failure", {
  skip_if_not_installed("processx")
  skip_on_cran()
  skip_if(
    packageVersion("testthat") < "3.2.0",
    "Requires testthat >= 3.2.0 for object mocking"
  )

  tmp_dir <- tempdir()
  osrm_path <- file.path(tmp_dir, "test.osrm.mldgr")
  file.create(osrm_path)
  on.exit(unlink(osrm_path), add = TRUE)

  # Create a mock log file with error content
  mock_log_content <- c(
    "[info] Starting OSRM server...",
    "[error] Port 5001 is already in use",
    "[error] Failed to bind to socket"
  )
  mock_log_file <- file.path(tmp_dir, "mock_error.log")
  writeLines(mock_log_content, mock_log_file)

  call_count <- 0
  captured_stdout <- NULL

  MockProcess <- list(
    new = function(command, args, ..., stdout, stderr) {
      call_count <<- call_count + 1
      captured_stdout <<- stdout
      structure(
        list(
          is_alive = function() FALSE, # Simulate immediate failure
          get_pid = function() 12345,
          kill = function() TRUE,
          wait = function(...) TRUE,
          get_exit_status = function() 1
        ),
        class = c("process", "list")
      )
    }
  )

  state_env <- asNamespace("osrm.backend")$.osrm_state
  orig_registry <- state_env$registry
  orig_session_id <- state_env$session_id
  on.exit({
    state_env$registry <- orig_registry
    state_env$session_id <- orig_session_id
  }, add = TRUE)

  state_env$registry <- list()
  state_env$session_id <- "test-session"

  with_mocked_bindings(
    {
      # Use the mock log file directly via the option
      old_opt <- options(osrm.server.log_file = mock_log_file)
      on.exit(options(old_opt), add = TRUE)

      expect_error(
        osrm_start_server(osrm_path = osrm_path, quiet = TRUE),
        "Port 5001 is already in use"
      )
    },
    process = MockProcess,
    .package = "processx"
  )
})

test_that("verbose = TRUE takes precedence over osrm.server.log_file option", {
  skip_if_not_installed("processx")
  skip_on_cran()
  skip_if(
    packageVersion("testthat") < "3.2.0",
    "Requires testthat >= 3.2.0 for object mocking"
  )

  tmp_dir <- tempdir()
  osrm_path <- file.path(tmp_dir, "test.osrm.mldgr")
  file.create(osrm_path)
  on.exit(unlink(osrm_path), add = TRUE)

  custom_log <- file.path(tmp_dir, "custom_osrm.log")

  captured_env <- new.env()
  captured_env$captured <- list()
  MockProcess <- create_mock_process(captured_env)

  state_env <- asNamespace("osrm.backend")$.osrm_state
  orig_registry <- state_env$registry
  orig_session_id <- state_env$session_id
  on.exit({
    state_env$registry <- orig_registry
    state_env$session_id <- orig_session_id
  }, add = TRUE)

  state_env$registry <- list()
  state_env$session_id <- "test-session"

  with_mocked_bindings(
    {
      # Set custom log file option but also verbose = TRUE
      old_opt <- options(osrm.server.log_file = custom_log)
      on.exit(options(old_opt), add = TRUE)

      server <- osrm_start_server(
        osrm_path = osrm_path,
        verbose = TRUE,
        quiet = TRUE
      )
      on.exit(try(server$kill(), silent = TRUE), add = TRUE)

      # verbose = TRUE should take precedence (console output)
      expect_equal(captured_env$captured$stdout, "")
      expect_equal(captured_env$captured$stderr, "")
    },
    process = MockProcess,
    .package = "processx"
  )
})

# Tests for invalid osrm.server.log_file values ----
test_that("osrm_start_server falls back to temp file for empty string log option", {
  skip_if_not_installed("processx")
  skip_on_cran()
  skip_if(
    packageVersion("testthat") < "3.2.0",
    "Requires testthat >= 3.2.0 for object mocking"
  )

  tmp_dir <- tempdir()
  osrm_path <- file.path(tmp_dir, "test.osrm.mldgr")
  file.create(osrm_path)
  on.exit(unlink(osrm_path), add = TRUE)

  captured_env <- new.env()
  captured_env$captured <- list()
  MockProcess <- create_mock_process(captured_env)

  state_env <- asNamespace("osrm.backend")$.osrm_state
  orig_registry <- state_env$registry
  orig_session_id <- state_env$session_id
  on.exit({
    state_env$registry <- orig_registry
    state_env$session_id <- orig_session_id
  }, add = TRUE)

  state_env$registry <- list()
  state_env$session_id <- "test-session"

  with_mocked_bindings(
    {
      # Set empty string option - should fall back to temp file
      old_opt <- options(osrm.server.log_file = "")
      on.exit(options(old_opt), add = TRUE)

      server <- osrm_start_server(
        osrm_path = osrm_path,
        quiet = TRUE
      )
      on.exit(try(server$kill(), silent = TRUE), add = TRUE)

      # Should fall back to temp file
      expect_type(captured_env$captured$stdout, "character")
      expect_type(captured_env$captured$stderr, "character")
      expect_false(identical(captured_env$captured$stdout, ""))
      expect_match(captured_env$captured$stdout, "\\.log$")
    },
    process = MockProcess,
    .package = "processx"
  )
})

test_that("osrm_start_server falls back to temp file for NA log option", {
  skip_if_not_installed("processx")
  skip_on_cran()
  skip_if(
    packageVersion("testthat") < "3.2.0",
    "Requires testthat >= 3.2.0 for object mocking"
  )

  tmp_dir <- tempdir()
  osrm_path <- file.path(tmp_dir, "test.osrm.mldgr")
  file.create(osrm_path)
  on.exit(unlink(osrm_path), add = TRUE)

  captured_env <- new.env()
  captured_env$captured <- list()
  MockProcess <- create_mock_process(captured_env)

  state_env <- asNamespace("osrm.backend")$.osrm_state
  orig_registry <- state_env$registry
  orig_session_id <- state_env$session_id
  on.exit({
    state_env$registry <- orig_registry
    state_env$session_id <- orig_session_id
  }, add = TRUE)

  state_env$registry <- list()
  state_env$session_id <- "test-session"

  with_mocked_bindings(
    {
      # Set NA option - should fall back to temp file
      old_opt <- options(osrm.server.log_file = NA_character_)
      on.exit(options(old_opt), add = TRUE)

      server <- osrm_start_server(
        osrm_path = osrm_path,
        quiet = TRUE
      )
      on.exit(try(server$kill(), silent = TRUE), add = TRUE)

      # Should fall back to temp file
      expect_type(captured_env$captured$stdout, "character")
      expect_type(captured_env$captured$stderr, "character")
      expect_match(captured_env$captured$stdout, "\\.log$")
    },
    process = MockProcess,
    .package = "processx"
  )
})

test_that("osrm_start_server falls back to temp file for multiple paths log option", {
  skip_if_not_installed("processx")
  skip_on_cran()
  skip_if(
    packageVersion("testthat") < "3.2.0",
    "Requires testthat >= 3.2.0 for object mocking"
  )

  tmp_dir <- tempdir()
  osrm_path <- file.path(tmp_dir, "test.osrm.mldgr")
  file.create(osrm_path)
  on.exit(unlink(osrm_path), add = TRUE)

  captured_env <- new.env()
  captured_env$captured <- list()
  MockProcess <- create_mock_process(captured_env)

  state_env <- asNamespace("osrm.backend")$.osrm_state
  orig_registry <- state_env$registry
  orig_session_id <- state_env$session_id
  on.exit({
    state_env$registry <- orig_registry
    state_env$session_id <- orig_session_id
  }, add = TRUE)

  state_env$registry <- list()
  state_env$session_id <- "test-session"

  with_mocked_bindings(
    {
      # Set multiple paths - should fall back to temp file
      old_opt <- options(
        osrm.server.log_file = c("/tmp/log1.log", "/tmp/log2.log")
      )
      on.exit(options(old_opt), add = TRUE)

      server <- osrm_start_server(
        osrm_path = osrm_path,
        quiet = TRUE
      )
      on.exit(try(server$kill(), silent = TRUE), add = TRUE)

      # Should fall back to temp file (not use the list paths)
      expect_type(captured_env$captured$stdout, "character")
      expect_type(captured_env$captured$stderr, "character")
      expect_false(identical(captured_env$captured$stdout, "/tmp/log1.log"))
      expect_false(identical(captured_env$captured$stderr, "/tmp/log2.log"))
      expect_match(captured_env$captured$stdout, "\\.log$")
    },
    process = MockProcess,
    .package = "processx"
  )
})

test_that("osrm_start_server falls back to temp file for numeric log option", {
  skip_if_not_installed("processx")
  skip_on_cran()
  skip_if(
    packageVersion("testthat") < "3.2.0",
    "Requires testthat >= 3.2.0 for object mocking"
  )

  tmp_dir <- tempdir()
  osrm_path <- file.path(tmp_dir, "test.osrm.mldgr")
  file.create(osrm_path)
  on.exit(unlink(osrm_path), add = TRUE)

  captured_env <- new.env()
  captured_env$captured <- list()
  MockProcess <- create_mock_process(captured_env)

  state_env <- asNamespace("osrm.backend")$.osrm_state
  orig_registry <- state_env$registry
  orig_session_id <- state_env$session_id
  on.exit({
    state_env$registry <- orig_registry
    state_env$session_id <- orig_session_id
  }, add = TRUE)

  state_env$registry <- list()
  state_env$session_id <- "test-session"

  with_mocked_bindings(
    {
      # Set numeric option - should fall back to temp file
      old_opt <- options(osrm.server.log_file = 12345)
      on.exit(options(old_opt), add = TRUE)

      server <- osrm_start_server(
        osrm_path = osrm_path,
        quiet = TRUE
      )
      on.exit(try(server$kill(), silent = TRUE), add = TRUE)

      # Should fall back to temp file
      expect_type(captured_env$captured$stdout, "character")
      expect_type(captured_env$captured$stderr, "character")
      expect_match(captured_env$captured$stdout, "\\.log$")
    },
    process = MockProcess,
    .package = "processx"
  )
})

# Tests for error handling robustness in read_last_n_lines ----
test_that("osrm_start_server handles log file read errors gracefully during failure reporting", {
  skip_if_not_installed("processx")
  skip_on_cran()
  skip_if(
    packageVersion("testthat") < "3.2.0",
    "Requires testthat >= 3.2.0 for object mocking"
  )

  tmp_dir <- tempdir()
  osrm_path <- file.path(tmp_dir, "test.osrm.mldgr")
  file.create(osrm_path)
  on.exit(unlink(osrm_path), add = TRUE)

  # Create a log file that will be deleted during error reporting
  mock_log_file <- file.path(tmp_dir, "disappearing.log")

  log_deleted <- FALSE

  MockProcess <- list(
    new = function(command, args, ..., stdout, stderr) {
      # Create initial log content
      writeLines(c("[error] Test error"), mock_log_file)

      structure(
        list(
          is_alive = function() {
            # Delete the log file when is_alive is checked
            # This simulates the file being deleted between creation and read
            if (!log_deleted && file.exists(mock_log_file)) {
              unlink(mock_log_file)
              log_deleted <<- TRUE
            }
            FALSE # Simulate immediate failure
          },
          get_pid = function() 12345,
          kill = function() TRUE,
          wait = function(...) TRUE,
          get_exit_status = function() 1
        ),
        class = c("process", "list")
      )
    }
  )

  state_env <- asNamespace("osrm.backend")$.osrm_state
  orig_registry <- state_env$registry
  orig_session_id <- state_env$session_id
  on.exit({
    state_env$registry <- orig_registry
    state_env$session_id <- orig_session_id
  }, add = TRUE)

  state_env$registry <- list()
  state_env$session_id <- "test-session"

  with_mocked_bindings(
    {
      # Use the mock log file
      old_opt <- options(osrm.server.log_file = mock_log_file)
      on.exit(options(old_opt), add = TRUE)

      # Should still get an error, but not crash due to log reading failure
      expect_error(
        osrm_start_server(osrm_path = osrm_path, quiet = TRUE),
        "osrm-routed failed to start"
      )

      # The error should be caught gracefully, not propagate file operation errors
    },
    process = MockProcess,
    .package = "processx"
  )
})

test_that("osrm_start_server handles permission errors when reading log file", {
  skip_if_not_installed("processx")
  skip_on_cran()
  skip_on_os("windows") # Permission changes work differently on Windows
  skip_if(
    packageVersion("testthat") < "3.2.0",
    "Requires testthat >= 3.2.0 for object mocking"
  )

  tmp_dir <- tempdir()
  osrm_path <- file.path(tmp_dir, "test.osrm.mldgr")
  file.create(osrm_path)
  on.exit(unlink(osrm_path), add = TRUE)

  # Create a log file with no read permissions
  mock_log_file <- file.path(tmp_dir, "no_read_perm.log")

  MockProcess <- list(
    new = function(command, args, ..., stdout, stderr) {
      # Create log file and make it unreadable
      writeLines(c("[error] Permission test"), mock_log_file)
      Sys.chmod(mock_log_file, mode = "000")

      structure(
        list(
          is_alive = function() FALSE, # Simulate immediate failure
          get_pid = function() 12345,
          kill = function() TRUE,
          wait = function(...) TRUE,
          get_exit_status = function() 1
        ),
        class = c("process", "list")
      )
    }
  )

  state_env <- asNamespace("osrm.backend")$.osrm_state
  orig_registry <- state_env$registry
  orig_session_id <- state_env$session_id
  on.exit({
    state_env$registry <- orig_registry
    state_env$session_id <- orig_session_id
  }, add = TRUE)

  state_env$registry <- list()
  state_env$session_id <- "test-session"

  with_mocked_bindings(
    {
      # Use the mock log file
      old_opt <- options(osrm.server.log_file = mock_log_file)
      on.exit(
        {
          options(old_opt)
          # Restore permissions so cleanup can work
          if (file.exists(mock_log_file)) {
            try(Sys.chmod(mock_log_file, mode = "644"), silent = TRUE)
            unlink(mock_log_file)
          }
        },
        add = TRUE
      )

      # Should still get an error message, even though log file is unreadable
      expect_error(
        osrm_start_server(osrm_path = osrm_path, quiet = TRUE),
        "osrm-routed failed to start"
      )
    },
    process = MockProcess,
    .package = "processx"
  )
})

test_that("osrm_start_server handles empty log file during error reporting", {
  skip_if_not_installed("processx")
  skip_on_cran()
  skip_if(
    packageVersion("testthat") < "3.2.0",
    "Requires testthat >= 3.2.0 for object mocking"
  )

  tmp_dir <- tempdir()
  osrm_path <- file.path(tmp_dir, "test.osrm.mldgr")
  file.create(osrm_path)
  on.exit(unlink(osrm_path), add = TRUE)

  # Create an empty log file
  mock_log_file <- file.path(tmp_dir, "empty.log")

  MockProcess <- list(
    new = function(command, args, ..., stdout, stderr) {
      # Create empty log file
      file.create(mock_log_file)

      structure(
        list(
          is_alive = function() FALSE, # Simulate immediate failure
          get_pid = function() 12345,
          kill = function() TRUE,
          wait = function(...) TRUE,
          get_exit_status = function() 1
        ),
        class = c("process", "list")
      )
    }
  )

  state_env <- asNamespace("osrm.backend")$.osrm_state
  orig_registry <- state_env$registry
  orig_session_id <- state_env$session_id
  on.exit({
    state_env$registry <- orig_registry
    state_env$session_id <- orig_session_id
  }, add = TRUE)

  state_env$registry <- list()
  state_env$session_id <- "test-session"

  with_mocked_bindings(
    {
      # Use the mock log file
      old_opt <- options(osrm.server.log_file = mock_log_file)
      on.exit(options(old_opt), add = TRUE)

      # Should gracefully handle empty log file
      expect_error(
        osrm_start_server(osrm_path = osrm_path, quiet = TRUE),
        "osrm-routed failed to start"
      )
    },
    process = MockProcess,
    .package = "processx"
  )
})

Try the osrm.backend package in your browser

Any scripts or data that you put into this service are public.

osrm.backend documentation built on April 26, 2026, 9:06 a.m.