tests/testthat/test-date.R

In DavisVaughan/timewarp: Group Dates

# as.POSIXlt.Date() is unbearably slow, this is much faster
as_posixlt_from_date <- function(x) {
  origin <- structure(0, class = "Date")
  x <- unclass(x)

  # Ignore fractional Date pieces by truncating towards 0
  if (typeof(x) == "double") {
    x <- trunc(x)
  }

  out <- as.POSIXlt(x * 86400, tz = "UTC", origin = origin)

  out
}

test_that("getting the year is identical to as.POSIXlt - integer Date", {
  x <- structure(-1e7:1e7, class = "Date")

  expect <- unclass(as_posixlt_from_date(x))
  expect <- expect$year - 70L

  expect_identical(date_get_year_offset(x), expect)
})

test_that("getting the year is identical to as.POSIXlt - double Date", {
  x <- structure(-1e7:1e7 + 0, class = "Date")

  expect <- unclass(as_posixlt_from_date(x))
  expect <- expect$year - 70L

  expect_identical(date_get_year_offset(x), expect)
})

test_that("getting the year month is identical to as.POSIXlt - integer Date", {
  x <- structure(-1e7:1e7, class = "Date")

  expect <- unclass(as_posixlt_from_date(x))
  expect <- (expect$year - 70L) * 12L + expect$mon

  expect_identical(date_get_month_offset(x), expect)
})

test_that("getting the year month is identical to as.POSIXlt - double Date", {
  x <- structure(-1e7:1e7 + 0, class = "Date")

  expect <- unclass(as_posixlt_from_date(x))
  expect <- (expect$year - 70L) * 12L + expect$mon

  expect_identical(date_get_month_offset(x), expect)
})

test_that("can get the year offset of the maximum integer value", {
  x <- structure(.Machine$integer.max, class = "Date")

  expect <- unclass(as_posixlt_from_date(x))
  expect <- expect$year - 70L

  expect_identical(date_get_year_offset(x), expect)
})

test_that("can get the year offset of a value close to the minimum integer value", {
  minimum_allowed_date <- -.Machine$integer.max + unclass(as.Date("2001-01-01"))

  x <- structure(minimum_allowed_date, class = "Date")

  expect <- unclass(as_posixlt_from_date(x))
  expect <- expect$year - 70L

  expect_identical(date_get_year_offset(x), expect)
})

test_that("going below the minimum allowed date is an error", {
  minimum_allowed_date_minus_one <- -.Machine$integer.max + unclass(as.Date("2001-01-01")) - 1L

  x <- structure(minimum_allowed_date_minus_one, class = "Date")

  expect_error(date_get_year_offset(x), "Integer overflow")
})