test-naive-time.R
In clock: Date-Time Types and Tools

# ------------------------------------------------------------------------------
# naive_time_info()

test_that("naive-time-info returns the right structure", {
  info <- naive_time_info(naive_days(0), "America/New_York")

  expect_type(info$type, "character")
  expect_s3_class(info$first, "data.frame")
  expect_s3_class(info$second, "data.frame")
})

test_that("unique info works", {
  info <- naive_time_info(naive_days(0), "America/New_York")
  na_sys_info <- sys_time_info(sys_days(NA), "America/New_York")

  expect_identical(info$type, "unique")
  expect_identical(info$second, na_sys_info)

  begin <- as_sys_time(year_month_day(1969, 10, 26, 06, 00, 00))
  end <- as_sys_time(year_month_day(1970, 4, 26, 7, 0, 0))
  offset <- duration_seconds(-18000)

  expect_identical(info$first$begin, begin)
  expect_identical(info$first$end, end)
  expect_identical(info$first$offset, offset)
  expect_identical(info$first$dst, FALSE)
  expect_identical(info$first$abbreviation, "EST")
})

test_that("nonexistent info works", {
  x <- as_naive_time(year_month_day(1970, 4, 26, 2, 30, 00))
  info <- naive_time_info(x, "America/New_York")

  expect_identical(info$type, "nonexistent")

  begin <- as_sys_time(year_month_day(1969, 10, 26, 06, 00, 00))
  end <- as_sys_time(year_month_day(1970, 4, 26, 7, 0, 0))
  offset <- duration_seconds(-18000)

  expect_identical(info$first$begin, begin)
  expect_identical(info$first$end, end)
  expect_identical(info$first$offset, offset)
  expect_identical(info$first$dst, FALSE)
  expect_identical(info$first$abbreviation, "EST")

  begin <- as_sys_time(year_month_day(1970, 4, 26, 7, 0, 0))
  end <- as_sys_time(year_month_day(1970, 10, 25, 6, 0, 0))
  offset <- duration_seconds(-14400)

  expect_identical(info$second$begin, begin)
  expect_identical(info$second$end, end)
  expect_identical(info$second$offset, offset)
  expect_identical(info$second$dst, TRUE)
  expect_identical(info$second$abbreviation, "EDT")
})

test_that("ambiguous info works", {
  x <- as_naive_time(year_month_day(1970, 10, 25, 1, 30, 00))
  info <- naive_time_info(x, "America/New_York")

  expect_identical(info$type, "ambiguous")

  begin <- as_sys_time(year_month_day(1970, 4, 26, 7, 0, 0))
  end <- as_sys_time(year_month_day(1970, 10, 25, 6, 0, 0))
  offset <- duration_seconds(-14400)

  expect_identical(info$first$begin, begin)
  expect_identical(info$first$end, end)
  expect_identical(info$first$offset, offset)
  expect_identical(info$first$dst, TRUE)
  expect_identical(info$first$abbreviation, "EDT")

  begin <- as_sys_time(year_month_day(1970, 10, 25, 6, 0, 0))
  end <- as_sys_time(year_month_day(1971, 4, 25, 7, 0, 0))
  offset <- duration_seconds(-18000)

  expect_identical(info$second$begin, begin)
  expect_identical(info$second$end, end)
  expect_identical(info$second$offset, offset)
  expect_identical(info$second$dst, FALSE)
  expect_identical(info$second$abbreviation, "EST")
})

test_that("all rows are NA when x is NA", {
  info <- naive_time_info(naive_days(NA), "UTC")
  na_sys_info <- sys_time_info(sys_days(NA), "UTC")
  df <- data_frame(type = NA_character_, first = na_sys_info, second = na_sys_info)
  expect_identical(info, df)
})

test_that("x must be naive", {
  expect_snapshot(error = TRUE, naive_time_info(sys_days(0), "UTC"))
})

test_that("zone is vectorized and recycled against x", {
  info <- naive_time_info(naive_days(0), c("UTC", "America/New_York"))
  expect_identical(nrow(info), 2L)

  expect_snapshot(error = TRUE, naive_time_info(naive_days(0:3), c("UTC", "America/New_York")))
})

# ------------------------------------------------------------------------------
# as.character()

test_that("as.character() works", {
  x <- as_naive_time(year_month_day(2019, 1, 1))
  expect_identical(as.character(x), "2019-01-01")

  x <- as_naive_time(year_month_day(2019, 1, 1, 1, 1))
  expect_identical(as.character(x), "2019-01-01T01:01")
})

# ------------------------------------------------------------------------------
# naive_time_parse()

test_that("can parse day precision", {
  x <- c("2019-01-01", "2019-01-31")

  expect_identical(
    naive_time_parse(x, precision = "day"),
    as_naive_time(year_month_day(2019, 1, c(1, 31)))
  )
})

test_that("can parse second precision", {
  x <- c("2019-01-01T00:00:05", "2019-01-31T00:00:10")

  expect_identical(
    naive_time_parse(x, precision = "second"),
    as_naive_time(year_month_day(2019, 1, c(1, 31), 00, 00, c(05, 10)))
  )
})

test_that("can parse subsecond precision", {
  x <- c("2019-01-01T00:00:05.123", "2019-01-31T00:00:10.124")
  y <- c("2019-01-01T00:00:05.12345", "2019-01-31T00:00:10.124567")
  z <- c("2019-01-01T00:00:05.12345678", "2019-01-31T00:00:10.124567899")

  sec <- year_month_day(2019, 1, c(1, 31), 00, 00, c(05, 10))

  expect_identical(
    naive_time_parse(x, precision = "millisecond"),
    as_naive_time(set_millisecond(sec, c(123, 124)))
  )
  expect_identical(
    naive_time_parse(y, precision = "microsecond"),
    as_naive_time(set_microsecond(sec, c(123450, 124567)))
  )
  expect_identical(
    naive_time_parse(z, precision = "nanosecond"),
    as_naive_time(set_nanosecond(sec, c(123456780, 124567899)))
  )
})

test_that("parsing works if `precision` uses a default that doesn't attempt to capture all the info", {
  # Uses %Y-%m-%d
  x <- "2019-01-01T01:00:00"
  expect_identical(
    naive_time_parse(x, precision = "day"),
    as_naive_time(year_month_day(2019, 1, 1))
  )

  # Uses %Y-%m-%dT%H:%M
  x <- "2019-01-01T01:00:59"
  expect_identical(
    naive_time_parse(x, precision = "minute"),
    as_naive_time(year_month_day(2019, 1, 1, 1, 0))
  )
})

test_that("parsing day components with second precision uses midnight as time", {
  x <- "2019/1/1"

  expect_identical(
    naive_time_parse(x, format = "%Y/%m/%d", precision = "second"),
    as_naive_time(year_month_day(2019, 1, 1, 0, 0, 0))
  )
})

test_that("cannot parse invalid dates", {
  x <- "2019-02-31"

  expect_warning(
    expect_identical(
      naive_time_parse(x, precision = "day"),
      naive_days(NA)
    )
  )

  expect_snapshot(naive_time_parse(x, precision = "day"))
})

test_that("can parse with multiple formats", {
  x <- c("2019-01-01", "2020/1/2", "January 05, 2019")
  formats <- c("%Y-%m-%d", "%Y/%m/%d", "%B %d, %Y")

  expect_identical(
    naive_time_parse(x, format = formats, precision = "day"),
    as_naive_time(year_month_day(c(2019, 2020, 2019), 1, c(1, 2, 5)))
  )
})

test_that("failure to parse results in NA", {
  x <- "2019-01-oh"

  expect_warning(
    expect_identical(
      naive_time_parse(x, format = "%Y-%m-%d", precision = "day"),
      naive_days(NA)
    )
  )
})

test_that("failure to parse throws a warning", {
  expect_warning(naive_time_parse("foo"), class = "clock_warning_parse_failures")
  expect_snapshot(naive_time_parse("foo"))
})

test_that("names of input are kept", {
  x <- c(foo = "2019-01-01")
  expect_named(naive_time_parse(x, precision = "day"), "foo")
})

test_that("can use a different locale", {
  x <- "janvier 01, 2019"
  y <- "2019-01-01T00:00:00,123456"

  expect_identical(
    naive_time_parse(x, format = "%B %d, %Y", precision = "day", locale = clock_locale("fr")),
    as_naive_time(year_month_day(2019, 1, 1))
  )
  expect_identical(
    naive_time_parse(y, precision = "microsecond", locale = clock_locale(decimal_mark = ",")),
    as_naive_time(year_month_day(2019, 1, 1, 0, 0, 0, 123456, subsecond_precision = "microsecond"))
  )
})

test_that("`x` is translated to UTF-8", {
  x <- "f\u00E9vrier 05, 2019"
  x <- iconv(x, from = "UTF-8", to = "latin1")

  locale <- clock_locale("fr")
  format <- "%B %d, %Y"

  expect_identical(Encoding(x[1]), "latin1")
  expect_identical(Encoding(locale$labels$month[2]), "UTF-8")

  expect_identical(
    naive_time_parse(x, format = format, precision = "day", locale = locale),
    as_naive_time(year_month_day(2019, 2, 5))
  )
})

test_that("%z is completely ignored, but is required to be parsed correctly if specified", {
  x <- "2019-01-01 00:00:00+0100"
  y <- "2019-01-01 00:00:00"

  expect_identical(
    naive_time_parse(x, format = "%Y-%m-%d %H:%M:%S%z"),
    as_naive_time(year_month_day(2019, 1, 1, 0, 0, 0))
  )
  expect_warning(
    expect_identical(
      naive_time_parse(y, format = "%Y-%m-%d %H:%M:%S%z"),
      naive_seconds(NA)
    )
  )
})

test_that("%Z is completely ignored", {
  x <- "2019-01-01 00:00:00 America/New_York"

  expect_identical(
    naive_time_parse(x, format = "%Y-%m-%d %H:%M:%S %Z"),
    as_naive_time(year_month_day(2019, 1, 1, 0, 0, 0))
  )
})

test_that("parsing rounds parsed components more precise than the resulting container (#207) (#230) (undocumented)", {
  expect_identical(
    naive_time_parse("2019-12-31 11", format = "%Y-%m-%d %H", precision = "day"),
    as_naive_time(year_month_day(2019, 12, 31))
  )
  expect_identical(
    naive_time_parse("2019-12-31 12", format = "%Y-%m-%d %H", precision = "day"),
    as_naive_time(year_month_day(2020, 1, 1))
  )

  # If you don't try and parse them, it won't round
  expect_identical(
    naive_time_parse("2019-12-31 12", format = "%Y-%m-%d", precision = "day"),
    as_naive_time(year_month_day(2019, 12, 31))
  )
})

test_that("parsing rounds parsed subsecond components more precise than the resulting container (#207) (#230) (undocumented)", {
  # Default N for milliseconds is 6, so `%6S` (2 hour seconds, 1 for decimal, 3 for subseconds)
  expect_identical(
    naive_time_parse("2019-01-01 01:01:01.1238", format = "%Y-%m-%d %H:%M:%S", precision = "millisecond"),
    as_naive_time(year_month_day(2019, 1, 1, 1, 1, 1, 123, subsecond_precision = "millisecond"))
  )

  # Requesting `%7S` parses the full `01.1238`, and the `1238` portion is rounded up
  expect_identical(
    naive_time_parse("2019-01-01 01:01:01.1238", format = "%Y-%m-%d %H:%M:%7S", precision = "millisecond"),
    as_naive_time(year_month_day(2019, 1, 1, 1, 1, 1, 124, subsecond_precision = "millisecond"))
  )
})

test_that("parsing fails when undocumented rounding behavior would result in invalid 60 second component (#230) (undocumented)", {
  expect_warning(
    expect_identical(
      naive_time_parse("2019-01-01 01:01:59.550", format = "%Y-%m-%d %H:%M:%6S", precision = "second"),
      as_naive_time(year_month_day(NA, NA, NA, NA, NA, NA))
    ),
    class = "clock_warning_parse_failures"
  )
})

test_that("`naive_time_parse()` validates `locale`", {
  expect_snapshot(error = TRUE, {
    naive_time_parse("2019-01-01T00:00:00", locale = 1)
  })
})

# ------------------------------------------------------------------------------
# format()

test_that("default format is correct", {
  expect_snapshot(format(naive_seconds(0)))
})

test_that("`%Z` generates format warnings (#204)", {
  x <- naive_seconds(0)

  expect_warning(format(x, format = "%Z"), class = "clock_warning_format_failures")

  expect_snapshot(format(x, format = "%Z"))
  expect_snapshot(format(c(x, x), format = "%Z"))
})

test_that("`%z` generates format warnings (#204)", {
  x <- naive_seconds(0)

  expect_warning(format(x, format = "%z"), class = "clock_warning_format_failures")

  expect_snapshot(format(x, format = "%z"))
  expect_snapshot(format(c(x, x), format = "%z"))
})

# ------------------------------------------------------------------------------
# as_zoned_time()

test_that("can convert non-ambiguous/nonexistent times to zoned time", {
  zone <- "America/New_York"
  x <- as_naive_time(year_month_day(2019, 1, 1))
  expect <- as_sys_time(year_month_day(2019, 1, 1, 5))
  expect_identical(as_zoned_time(x, zone), as_zoned_time(expect, zone))
})

test_that("sub daily time point precision is retained", {
  zone <- "America/New_York"
  x <- as_naive_time(year_month_day(2019, 1, 1, 1, 1, 1, 1, subsecond_precision = "nanosecond"))
  expect_identical(zoned_time_precision_attribute(as_zoned_time(x, zone)), PRECISION_NANOSECOND)
})

test_that("day precision time point is promoted", {
  zone <- "America/New_York"
  x <- as_naive_time(year_month_day(2019, 1, 1))
  expect_identical(zoned_time_precision_attribute(as_zoned_time(x, zone)), PRECISION_SECOND)
})

test_that("can resolve ambiguous issues - character", {
  zone <- "America/New_York"
  x <- as_naive_time(year_month_day(1970, 10, 25, 01, 30, 00, 01, subsecond_precision = "millisecond"))
  earliest <- as_sys_time(year_month_day(1970, 10, 25, 05, 30, 00, 01, subsecond_precision = "millisecond"))
  latest <- as_sys_time(year_month_day(1970, 10, 25, 06, 30, 00, 01, subsecond_precision = "millisecond"))

  expect_snapshot(error = TRUE, as_zoned_time(x, zone))
  expect_error(as_zoned_time(x, zone), class = "clock_error_ambiguous_time")

  expect_identical(
    as_zoned_time(x, zone, ambiguous = "earliest"),
    as_zoned_time(earliest, zone)
  )
  expect_identical(
    as_zoned_time(x, zone, ambiguous = "latest"),
    as_zoned_time(latest, zone)
  )
  expect_identical(
    as_zoned_time(x, zone, ambiguous = "NA"),
    as_zoned_time(as_naive_time(duration_milliseconds(NA)), zone)
  )
})

test_that("can resolve ambiguous issues - zoned-time", {
  zone <- "America/New_York"
  nt <- as_naive_time(year_month_day(1970, 10, 25, 01, 30, c(00, 00)))
  zt <- as_zoned_time(nt, zone, ambiguous = c("earliest", "latest"))

  expect_identical(
    as_zoned_time(nt, zone, ambiguous = zt),
    zt
  )

  nt <- as_naive_time(year_month_day(1970, 10, 25, c(01, 02), 30, 00))
  zt <- as_zoned_time(nt, zone, ambiguous = "earliest")

  expect_identical(
    as_zoned_time(nt, zone, ambiguous = zt),
    zt
  )

  # Issue at location 2 because zt[2] isn't ambiguous so we can't use offset
  # information from it
  nt_tweaked <- as_naive_time(set_hour(as_year_month_day(nt), 1))
  expect_snapshot(error = TRUE, as_zoned_time(nt_tweaked, zone, ambiguous = zt))

  # Jump from one ambiguous time to another. Still can't use offset info,
  # because the ambiguous time transitions are different.
  ymd <- year_month_day(1969, 10, 26, 01, 30, 00)
  nt <- as_naive_time(ymd)
  zt <- as_zoned_time(nt, zone, ambiguous = "earliest")
  nt_tweaked <- nt + duration_days(364)
  expect_snapshot(error = TRUE, as_zoned_time(nt_tweaked, zone, ambiguous = zt))
})

test_that("can resolve ambiguous issues - list", {
  zone <- "America/New_York"
  nt <- as_naive_time(year_month_day(1970, 10, 25, c(01, 01, 02), 30, 00))
  zt <- as_zoned_time(nt, zone, ambiguous = c("earliest", "latest", "error"))
  nt_tweaked <- as_naive_time(set_hour(as_year_month_day(nt), 1))

  # First two are resolved from consulting `zt`, otherwise resolved with "latest"
  expect_identical(
    as_zoned_time(nt_tweaked, zone, ambiguous = list(zt, "latest")),
    as_zoned_time(nt_tweaked, zone, ambiguous = c("earliest", "latest", "latest"))
  )
})

test_that("zoned-time ambiguous argument is recycled", {
  zone <- "America/New_York"
  nt <- as_naive_time(year_month_day(1970, 10, 25, 01, 30, 00))
  zt <- as_zoned_time(nt, zone, ambiguous = "earliest")
  nt_tweaked <- nt + duration_seconds(c(0, 1))

  expect_identical(
    as_zoned_time(nt_tweaked, zone, ambiguous = zt),
    as_zoned_time(nt_tweaked, zone, ambiguous = "earliest")
  )
})

test_that("can resolve nonexistent issues", {
  zone <- "America/New_York"
  x <- as_naive_time(year_month_day(1970, 04, 26, 02, 30, 00))

  expect_snapshot(error = TRUE, as_zoned_time(x, zone))
  expect_error(as_zoned_time(x, zone), class = "clock_error_nonexistent_time")

  expect_identical(
    as_zoned_time(x, zone, nonexistent = "roll-forward"),
    as_zoned_time(add_minutes(x, 30), zone)
  )
  expect_identical(
    as_zoned_time(x, zone, nonexistent = "roll-backward"),
    as_zoned_time(add_seconds(add_minutes(x, -30), -1), zone)
  )
  expect_identical(
    as_zoned_time(x, zone, nonexistent = "shift-forward"),
    as_zoned_time(add_minutes(x, 60), zone)
  )
  expect_identical(
    as_zoned_time(x, zone, nonexistent = "shift-backward"),
    as_zoned_time(add_minutes(x, -60), zone)
  )
  expect_identical(
    as_zoned_time(x, zone, nonexistent = "NA"),
    as_zoned_time(naive_seconds(NA), zone)
  )
})

test_that("nonexistent can be vectorized", {
  zone <- "America/New_York"
  x <- as_naive_time(year_month_day(1970, 04, 26, 02, 00, c(00, 00)))

  expect_identical(
    as_zoned_time(x, zone, nonexistent = c("roll-forward", "roll-backward")),
    as_zoned_time(x + duration_seconds(c(3600, -1)), zone)
  )
})

test_that("roll-backward uses precision to determine last moment in time", {
  zone <- "America/New_York"
  w <- as_naive_time(year_month_day(1970, 04, 26, 02, 00, 00))
  x <- w + duration_milliseconds(0)
  y <- w + duration_microseconds(0)
  z <- w + duration_nanoseconds(0)

  expect_identical(
    as_zoned_time(w, zone, nonexistent = "roll-backward"),
    as_zoned_time(add_seconds(w, -1), zone)
  )
  expect_identical(
    as_zoned_time(x, zone, nonexistent = "roll-backward"),
    as_zoned_time(add_milliseconds(x, -1), zone)
  )
  expect_identical(
    as_zoned_time(y, zone, nonexistent = "roll-backward"),
    as_zoned_time(add_microseconds(y, -1), zone)
  )
  expect_identical(
    as_zoned_time(z, zone, nonexistent = "roll-backward"),
    as_zoned_time(add_nanoseconds(z, -1), zone)
  )
})

test_that("names are retained", {
  zone <- "America/New_York"
  x <- as_naive_time(year_month_day(2019, 1, 1))
  x <- c(foo = x)
  expect_named(as_zoned_time(x, zone), "foo")
})

test_that("NA pass through", {
  x <- as_zoned_time(naive_seconds(NA), "America/New_York")
  expect_true(is.na(x))
})

test_that("`ambiguous` is validated", {
  zone <- "America/New_York"
  expect_snapshot(error = TRUE, as_zoned_time(naive_seconds(), zone, ambiguous = 1))
  expect_snapshot(error = TRUE, as_zoned_time(naive_seconds(), zone, ambiguous = "foo"))
  expect_snapshot(error = TRUE, as_zoned_time(naive_seconds(), zone, ambiguous = c("earliest", "latest")))

  ambiguous <- as_zoned_time(naive_seconds(), "America/Los_Angeles")
  expect_snapshot(error = TRUE, as_zoned_time(naive_seconds(), zone, ambiguous = ambiguous))

  reference <- as_zoned_time(naive_seconds(), zone)
  expect_snapshot(error = TRUE, as_zoned_time(naive_seconds(), zone, ambiguous = list()))
  expect_snapshot(error = TRUE, as_zoned_time(naive_seconds(), zone, ambiguous = list(1, 1)))
  expect_snapshot(error = TRUE, as_zoned_time(naive_seconds(), zone, ambiguous = list(reference, 1)))
  expect_snapshot(error = TRUE, as_zoned_time(naive_seconds(), zone, ambiguous = list(reference, "foo")))
})

test_that("`nonexistent` is validated", {
  zone <- "America/New_York"
  expect_snapshot(error = TRUE, as_zoned_time(naive_seconds(), zone, nonexistent = 1))
  expect_snapshot(error = TRUE, as_zoned_time(naive_seconds(), zone, nonexistent = "foo"))
  expect_snapshot(error = TRUE, as_zoned_time(naive_seconds(), zone, nonexistent = c("roll-forward", "roll-forward")))
})

test_that("zone is validated", {
  expect_snapshot(error = TRUE, as_zoned_time(naive_seconds(), "foo"))
  expect_snapshot(error = TRUE, as_zoned_time(naive_seconds(), 1))
  expect_snapshot(error = TRUE, as_zoned_time(naive_seconds(), c("America/New_York", "EST", "EDT")))
})

test_that("strict mode can be activated - nonexistent", {
  local_options(clock.strict = TRUE)
  zone <- "America/New_York"
  expect_snapshot(error = TRUE, as_zoned_time(naive_seconds(), zone, ambiguous = "earliest"))
})

test_that("strict mode can be activated - ambiguous", {
  zone <- "America/New_York"
  zt <- as_zoned_time(naive_seconds(), zone)

  local_options(clock.strict = TRUE)

  expect_snapshot(error = TRUE, as_zoned_time(naive_seconds(), zone, nonexistent = "roll-forward"))
  expect_snapshot(error = TRUE, as_zoned_time(naive_seconds(), zone, nonexistent = "roll-forward", ambiguous = zt))
  expect_snapshot(error = TRUE, as_zoned_time(naive_seconds(), zone, nonexistent = "roll-forward", ambiguous = list(zt, NULL)))
})

test_that("empty dots are checked", {
  expect_snapshot(error = TRUE, as_zoned_time(naive_seconds(), "UTC", "roll-forward"))
})

# ------------------------------------------------------------------------------
# vec_ptype_full() / vec_ptype_abbr()

test_that("`vec_ptype_full()` prints correctly", {
  expect_snapshot({
    vec_ptype_full(naive_days())
    vec_ptype_full(naive_seconds(1:5))
  })
})

test_that("`vec_ptype_abbr()` prints correctly", {
  expect_snapshot({
    vec_ptype_abbr(naive_days())
    vec_ptype_abbr(naive_seconds(1:5))
  })
})

# ------------------------------------------------------------------------------
# vec_ptype()

test_that("ptype is correct", {
  base <- naive_days(0)
  ptype <- naive_days(integer())

  for (precision in precision_names()) {
    if (precision_to_integer(precision) < PRECISION_DAY) {
      next
    }

    x <- time_point_cast(base, precision)
    expect <- time_point_cast(ptype, precision)

    expect_identical(vec_ptype(x), expect)
  }
})

# ------------------------------------------------------------------------------
# vec_math()

test_that("is.nan() works", {
  x <- naive_days(c(2019, NA))
  expect_identical(is.nan(x), c(FALSE, FALSE))
})

test_that("is.finite() works", {
  x <- naive_days(c(2019, NA))
  expect_identical(is.finite(x), c(TRUE, FALSE))
})

test_that("is.infinite() works", {
  x <- naive_days(c(2019, NA))
  expect_identical(is.infinite(x), c(FALSE, FALSE))
})