tests/testthat/test-sem.R

In gfkse/bettermc: Enhanced Fork-Based Parallelization

test_that("semaphores work", {
  skip_on_os("windows")
  sem_name <- gen_posix_name()
  expect_error(sem_open(sem_name, create = FALSE))
  s <- sem_open(sem_name, create = TRUE, value = 1)
  expect_type(s, "externalptr")
  s <- sem_open(sem_name, create = TRUE, overwrite = TRUE)
  sem_wait(s)
  sem_post(s)
  sem_wait(s)
  sem_close(s)
  sem_unlink(sem_name)
  expect_error(sem_unlink(sem_name))
})

test_that("semaphores are interruptible", {
  skip_on_os("windows")
  sem_name <- gen_posix_name()
  s <- sem_open(sem_name, TRUE)
  ppid <- Sys.getpid()
  job <- parallel::mcparallel({Sys.sleep(1); system(paste0("kill -", tools::SIGINT, " ", ppid))})
  expect_true(tryCatch(sem_wait(s), interrupt = function(i) TRUE))
  expect_identical(parallel::mccollect(job)[[1]], 0L)
  sem_close(s)
  sem_unlink(sem_name)
})