# ------------------------------------------------------------------------------ # print() / obj_print_data() / obj_print_footer() test_that("normal print method works", { x <- year_month_day(2019, 1:5) expect_snapshot(x) }) test_that("can limit with `max`", { x <- year_month_day(2019, 1:5) expect_snapshot(print(x, max = 2)) expect_snapshot(print(x, max = 4)) # no footer if length >= max expect_snapshot(print(x, max = 5)) expect_snapshot(print(x, max = 6)) }) test_that("`max` defaults to `getOption('max.print')` but can be overridden", { local_options(max.print = 3) x <- year_month_day(2019, 1:5) expect_snapshot(x) expect_snapshot(print(x, max = 4)) expect_snapshot(print(x, max = 5)) }) test_that("`max` is validated", { x <- year_month_day(2019) expect_snapshot(error = TRUE, print(x, max = -1)) expect_snapshot(error = TRUE, print(x, max = c(1, 2))) expect_snapshot(error = TRUE, print(x, max = NA_integer_)) expect_snapshot(error = TRUE, print(x, max = "foo")) }) # ------------------------------------------------------------------------------ # calendar_group() test_that("group: `precision` is validated", { expect_snapshot(error = TRUE, calendar_group(year_month_day(2019), "foo")) }) test_that("group: `precision` must be calendar specific", { expect_snapshot(error = TRUE, calendar_group(year_month_day(2019), "quarter")) }) test_that("group: `precision` can't be wider than `x`", { expect_snapshot(error = TRUE, calendar_group(year_month_day(2019, 1, 1), "second")) }) test_that("group: can't group a subsecond precision `x` at another subsecond precision", { x <- calendar_widen(year_month_day(2019), "nanosecond") expect_snapshot(error = TRUE, calendar_group(x, "microsecond")) }) test_that("group: can group subsecond precision at the same subsecond precision", { x <- year_month_day(2019, 1, 1, 1, 1, 1, 0:1, subsecond_precision = "millisecond") expect_identical(calendar_group(x, "millisecond", n = 2L), x[c(1, 1)]) }) # ------------------------------------------------------------------------------ # calendar_narrow() test_that("narrow: `precision` is validated", { expect_snapshot(error = TRUE, calendar_narrow(year_month_day(2019), "foo")) }) test_that("narrow: `precision` must be calendar specific", { expect_snapshot(error = TRUE, calendar_narrow(year_month_day(2019), "quarter")) }) test_that("narrow: `precision` can't be wider than `x`", { expect_snapshot(error = TRUE, calendar_narrow(year_month_day(2019, 1, 1), "second")) }) test_that("narrow: can't narrow a subsecond precision `x` to another subsecond precision", { x <- calendar_widen(year_month_day(2019), "nanosecond") expect_snapshot(error = TRUE, calendar_narrow(x, "microsecond")) }) test_that("narrow: can narrow subsecond precision to same subsecond precision", { x <- year_month_day(2019, 1, 1, 1, 1, 1, 1, subsecond_precision = "millisecond") expect_identical(calendar_narrow(x, "millisecond"), x) }) # ------------------------------------------------------------------------------ # calendar_widen() test_that("widen: `precision` is validated", { expect_snapshot(error = TRUE, calendar_widen(year_month_day(2019), "foo")) }) test_that("widen: `precision` must be calendar specific", { expect_snapshot(error = TRUE, calendar_widen(year_month_day(2019), "quarter")) }) test_that("widen: `precision` can't be narrower than `x`", { expect_snapshot(error = TRUE, calendar_widen(year_month_day(2019, 1, 1), "month")) }) test_that("widen: can't widen a subsecond precision `x` to another subsecond precision", { x <- calendar_widen(year_month_day(2019), "millisecond") expect_snapshot(error = TRUE, calendar_widen(x, "microsecond")) }) test_that("widen: can widen subsecond precision to the same subsecond precision", { x <- year_month_day(2019, 1, 1, 1, 1, 1, 1, subsecond_precision = "millisecond") expect_identical(calendar_widen(x, "millisecond"), x) }) # ------------------------------------------------------------------------------ # calendar_start() test_that("start: `x` is validated", { expect_snapshot(error = TRUE, calendar_start(1)) }) test_that("start: `precision` is validated", { expect_snapshot(error = TRUE, calendar_start(year_month_day(2019), "foo")) expect_snapshot(error = TRUE, calendar_start(year_month_day(2019), 1)) }) test_that("start: errors on unsupported precision", { expect_snapshot(error = TRUE, calendar_start(year_month_day(2019, 1), "quarter")) }) test_that("start: `precision` can't be more precise than `x`", { expect_snapshot(error = TRUE, calendar_start(year_month_day(2019), "month")) }) test_that("start: can't mix different subsecond precisions", { x <- year_month_day(2019, 1, 1, 1, 1, 1, 1, subsecond_precision = "microsecond") expect_snapshot(error = TRUE, calendar_start(x, "millisecond")) }) test_that("start: can use same subsecond precision", { x <- year_month_day(2019, 1, 1, 1, 1, 1, 1, subsecond_precision = "microsecond") expect_identical(calendar_start(x, "microsecond"), x) }) test_that("start: can compute day start", { x <- year_month_day(2019, 2, 2) expect_identical(calendar_start(x, "day"), x) x <- year_month_day(2019, 2, 2, 2, 2, 2, 2, subsecond_precision = "nanosecond") expect <- year_month_day(2019, 2, 2, 0, 0, 0, 0, subsecond_precision = "nanosecond") expect_identical(calendar_start(x, "day"), expect) }) test_that("start: can compute hour start", { x <- year_month_day(2019, 2, 2, 2) expect_identical(calendar_start(x, "hour"), x) x <- year_month_day(2019, 2, 2, 2, 2, 2, 2, subsecond_precision = "nanosecond") expect <- year_month_day(2019, 2, 2, 2, 0, 0, 0, subsecond_precision = "nanosecond") expect_identical(calendar_start(x, "hour"), expect) }) test_that("start: can compute minute start", { x <- year_month_day(2019, 2, 2, 2, 2) expect_identical(calendar_start(x, "minute"), x) x <- year_month_day(2019, 2, 2, 2, 2, 2, 2, subsecond_precision = "nanosecond") expect <- year_month_day(2019, 2, 2, 2, 2, 0, 0, subsecond_precision = "nanosecond") expect_identical(calendar_start(x, "minute"), expect) }) test_that("start: can compute second start", { x <- year_month_day(2019, 2, 2, 2, 2, 2) expect_identical(calendar_start(x, "second"), x) x <- year_month_day(2019, 2, 2, 2, 2, 2, 2, subsecond_precision = "nanosecond") expect <- year_month_day(2019, 2, 2, 2, 2, 2, 0, subsecond_precision = "nanosecond") expect_identical(calendar_start(x, "second"), expect) }) test_that("start: invalid dates are adjusted", { x <- year_month_day(2019, 2, 31, 3) expect_identical(calendar_start(x, "year"), year_month_day(2019, 1, 1, 0)) expect_identical(calendar_start(x, "day"), year_month_day(2019, 2, 31, 0)) }) # ------------------------------------------------------------------------------ # calendar_end() test_that("end: `x` is validated", { expect_snapshot(error = TRUE, calendar_end(1)) }) test_that("end: `precision` is validated", { expect_snapshot(error = TRUE, calendar_end(year_month_day(2019), "foo")) expect_snapshot(error = TRUE, calendar_end(year_month_day(2019), 1)) }) test_that("end: errors on unsupported precision", { expect_snapshot(error = TRUE, calendar_end(year_month_day(2019, 1), "quarter")) }) test_that("end: `precision` can't be more precise than `x`", { expect_snapshot(error = TRUE, calendar_end(year_month_day(2019), "month")) }) test_that("end: can't mix different subsecond precisions", { x <- year_month_day(2019, 1, 1, 1, 1, 1, 1, subsecond_precision = "microsecond") expect_snapshot(error = TRUE, calendar_end(x, "millisecond")) }) test_that("end: can use same subsecond precision", { x <- year_month_day(2019, 1, 1, 1, 1, 1, 1, subsecond_precision = "microsecond") expect_identical(calendar_end(x, "microsecond"), x) }) test_that("end: can compute day end", { x <- year_month_day(2019, 2, 2) expect_identical(calendar_end(x, "day"), x) x <- year_month_day(2019, 2, 2, 2, 2, 2, 2, subsecond_precision = "nanosecond") expect <- year_month_day(2019, 2, 2, 23, 59, 59, 999999999L, subsecond_precision = "nanosecond") expect_identical(calendar_end(x, "day"), expect) }) test_that("end: can compute hour end", { x <- year_month_day(2019, 2, 2, 2) expect_identical(calendar_end(x, "hour"), x) x <- year_month_day(2019, 2, 2, 2, 2, 2, 2, subsecond_precision = "nanosecond") expect <- year_month_day(2019, 2, 2, 2, 59, 59, 999999999L, subsecond_precision = "nanosecond") expect_identical(calendar_end(x, "hour"), expect) }) test_that("end: can compute minute end", { x <- year_month_day(2019, 2, 2, 2, 2) expect_identical(calendar_end(x, "minute"), x) x <- year_month_day(2019, 2, 2, 2, 2, 2, 2, subsecond_precision = "nanosecond") expect <- year_month_day(2019, 2, 2, 2, 2, 59, 999999999L, subsecond_precision = "nanosecond") expect_identical(calendar_end(x, "minute"), expect) }) test_that("end: can compute second end", { x <- year_month_day(2019, 2, 2, 2, 2, 2) expect_identical(calendar_end(x, "second"), x) x <- year_month_day(2019, 2, 2, 2, 2, 2, 2, subsecond_precision = "nanosecond") expect <- year_month_day(2019, 2, 2, 2, 2, 2, 999999999L, subsecond_precision = "nanosecond") expect_identical(calendar_end(x, "second"), expect) }) test_that("end: invalid dates are adjusted", { x <- year_month_day(2019, 2, 31, 3) expect_identical(calendar_end(x, "year"), year_month_day(2019, 12, 31, 23)) expect_identical(calendar_end(x, "month"), year_month_day(2019, 2, 28, 23)) expect_identical(calendar_end(x, "day"), year_month_day(2019, 2, 31, 23)) }) # ------------------------------------------------------------------------------ # calendar_count_between() test_that("`n` gets used", { x <- year_month_day(2019, 1) y <- year_month_day(2019, 7) expect_identical(calendar_count_between(x, y, "month", n = 2), 3L) }) test_that("`end` must be a calendar", { x <- year_month_day(2019) expect_snapshot((expect_error(calendar_count_between(x, 1, "year")))) }) test_that("can't count with a precision finer than the calendar precision", { x <- year_month_day(2019) expect_snapshot((expect_error(calendar_count_between(x, x, "month")))) }) test_that("`n` is validated", { x <- year_month_day(2019) expect_snapshot({ (expect_error(calendar_count_between(x, x, "year", n = NA_integer_))) (expect_error(calendar_count_between(x, x, "year", n = -1))) (expect_error(calendar_count_between(x, x, "year", n = 1.5))) (expect_error(calendar_count_between(x, x, "year", n = "x"))) (expect_error(calendar_count_between(x, x, "year", n = c(1L, 2L)))) }) }) # ------------------------------------------------------------------------------ # calendar_spanning_seq() test_that("generates the regular sequence along the full span", { x <- year_month_day(c(2019, 2022, 2020), c(2, 1, 3)) expect_identical( calendar_spanning_seq(x), seq(year_month_day(2019, 2), year_month_day(2022, 1), by = 1) ) }) test_that("missing values are removed", { x <- year_month_day(c(1, NA, 0, 2)) expect_identical(calendar_spanning_seq(x), year_month_day(0:2)) x <- year_month_day(c(NA, NA)) expect_identical(calendar_spanning_seq(x), year_month_day(integer())) }) test_that("works with empty vectors", { x <- year_month_day(integer()) expect_identical(calendar_spanning_seq(x), x) }) test_that("validates the input", { expect_snapshot(error = TRUE, { calendar_spanning_seq(1) }) }) test_that("the input must be at a precision allowed by `seq()`", { expect_snapshot(error = TRUE, { calendar_spanning_seq(year_month_day(2019, 1, 2)) }) }) test_that("errors on types that don't support min/max calls", { # This is fine x <- year_month_weekday(2019, c(1, 4)) expect_identical(calendar_spanning_seq(x), year_month_weekday(2019, 1:4)) # But this is invalid x <- year_month_weekday(2019, 1, 1, 1) expect_snapshot(error = TRUE, { calendar_spanning_seq(x) }) }) # ------------------------------------------------------------------------------ # calendar_precision() test_that("precision: can get the precision", { expect_identical(calendar_precision(year_month_day(2019, 1)), "month") expect_identical(calendar_precision(year_day(2019, 100)), "day") expect_identical(calendar_precision(year_month_day(2019, 1, 1, 1, 1, 1, 1, subsecond_precision = "nanosecond")), "nanosecond") }) test_that("precision: can only be called on calendars", { expect_snapshot(error = TRUE, calendar_precision(sys_days(0))) }) # ------------------------------------------------------------------------------ # add_*() test_that("addition helpers throw error with advice", { x <- year_month_day(2019) expect_snapshot(error = TRUE, { add_weeks(x) }) expect_snapshot(error = TRUE, { add_days(x) }) expect_snapshot(error = TRUE, { add_hours(x) }) expect_snapshot(error = TRUE, { add_minutes(x) }) expect_snapshot(error = TRUE, { add_seconds(x) }) expect_snapshot(error = TRUE, { add_milliseconds(x) }) expect_snapshot(error = TRUE, { add_microseconds(x) }) expect_snapshot(error = TRUE, { add_nanoseconds(x) }) })