tests/testthat/test-due_date.R

In pregnancy: Calculate and Track Dates and Medications During Pregnancy

# testing calculate_due_date() --------------------------------------------

test_that("start_date is correct format", {
  expect_error(
    calculate_due_date(2023 - 01 - 01),
    class = "pregnancy_error_class"
  )
})

test_that("start_date accepts character dates", {
  expect_equal(calculate_due_date("2023-01-31"), as.Date("2023-11-07"))
})

test_that("start_type matches arg", {
  start_date <- as.Date("2023-01-31")
  expect_error(
    calculate_due_date(start_date, start_type = "hello"),
    "must be one of"
  )
})

test_that("cycle is allowed value", {
  start_date <- as.Date("2023-01-31")
  expect_error(
    calculate_due_date(start_date, cycle = "28"),
    class = "pregnancy_error_class_or_length"
  )
  expect_error(
    calculate_due_date(start_date, cycle = 27:28),
    class = "pregnancy_error_class_or_length"
  )
  expect_error(
    calculate_due_date(start_date, cycle = NULL),
    class = "pregnancy_error_class_or_length"
  )
  expect_error(
    calculate_due_date(start_date, cycle = 19),
    class = "pregnancy_error_value"
  )
  expect_error(
    calculate_due_date(start_date, cycle = 45),
    class = "pregnancy_error_value"
  )
  expect_error(
    calculate_due_date(start_date, cycle = 27.5),
    class = "pregnancy_error_value"
  )
})

# correct output from each start_type
test_that("correct due date for each start type", {
  start_date <- as.Date("2023-01-31")
  expect_equal(calculate_due_date(start_date), as.Date("2023-11-07"))
  expect_equal(
    calculate_due_date(start_date, "conception"),
    as.Date("2023-10-24")
  )
  expect_equal(
    calculate_due_date(start_date, "transfer_day_3"),
    as.Date("2023-10-21")
  )
  expect_equal(
    calculate_due_date(start_date, "transfer_day_5"),
    as.Date("2023-10-19")
  )
  expect_equal(
    calculate_due_date(start_date, "transfer_day_6"),
    as.Date("2023-10-18")
  )
})

test_that("due date for LMP adjusts with cycle", {
  start_date <- as.Date("2023-01-31")
  expect_equal(
    calculate_due_date(start_date, cycle = 27),
    as.Date("2023-11-06")
  )
  expect_equal(
    calculate_due_date(start_date, cycle = 29),
    as.Date("2023-11-08")
  )
})

test_that("calculate_due_date message", {
  start_date <- as.Date("2023-01-31")
  expect_snapshot(calculate_due_date(start_date))
})


# testing get_due_date() --------------------------------------------------
test_that("retreives date option", {
  withr::local_options(pregnancy.due_date = as.Date("2023-01-31"))
  expect_equal(get_due_date(), as.Date("2023-01-31"))
})

test_that("NULL if due_date not set", {
  withr::local_options(pregnancy.due_date = NULL)
  expect_null(get_due_date())
})

# snapshot tests for get_due_date (both when date is set and when NULL)

# testing set_due_date(due_date) ------------------------------------------
test_that("date option gets set", {
  starting_option <- getOption("pregnancy.due_date")
  options(pregnancy.due_date = NULL)
  set_due_date(as.Date("2023-04-30"))
  expect_equal(getOption("pregnancy.due_date"), as.Date("2023-04-30"))
  options(pregnancy.due_date = starting_option)
})

test_that("character date option gets set", {
  starting_option <- getOption("pregnancy.due_date")
  options(pregnancy.due_date = NULL)
  set_due_date("2023-04-30")
  expect_equal(getOption("pregnancy.due_date"), anytime::anydate("2023-04-30"))
  options(pregnancy.due_date = starting_option)
})

test_that("NULL option gets set", {
  starting_option <- getOption("pregnancy.due_date")
  options(pregnancy.due_date = as.Date("2023-04-30"))
  set_due_date(NULL)
  expect_null(getOption("pregnancy.due_date"))
  options(pregnancy.due_date = starting_option)
})

# snapshot tests for set_due_date (both when date is set and when NULL)