vroom/tests/testthat/helper.R at main · tidyverse/vroom · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
test_vroom <- function(content, delim = ",", col_types = list(), ..., equals) {
  if (any(grepl("\n", content))) {
    content <- I(content)
  }
  suppressWarnings({
    # with altrep
    withr::with_envvar(
      c("VROOM_USE_ALTREP_CHR" = "true", "VROOM_USE_ALTREP_NUMERICS" = "true"),
      {
        expect_equal(
          vroom(content, delim = delim, col_types = col_types, ...),
          equals
        )
      }
    )

    # without altrep
    withr::with_envvar(
      c(
        "VROOM_USE_ALTREP_CHR" = "false",
        "VROOM_USE_ALTREP_NUMERICS" = "false"
      ),
      {
        expect_equal(
          vroom(content, delim = delim, col_types = col_types, ...),
          equals
        )
      }
    )

    if (!file.exists(content)) {
      tf <- tempfile()
      on.exit(unlink(tf))
      out_con <- file(tf, "wb", encoding = "UTF-8")
      writeBin(charToRaw(content), out_con)
      close(out_con)

      con <- file(tf, "rb")
    } else {
      con <- file(content, "rb")
    }
    on.exit(close(con), add = TRUE)

    res <- vroom(con, delim = delim, col_types = col_types, ...)

    expect_equal(res, equals)
    for (i in seq_along(res)) {
      force_materialization(res[[i]])
    }
    expect_equal(res, equals)
  })

  invisible(res)
}

test_parse_number <- function(x, expected, ...) {
  test_vroom(
    paste0(paste0(x, collapse = "\n"), "\n"),
    delim = "\t",
    col_names = FALSE,
    col_types = "n",
    ...,
    equals = tibble::tibble(X1 = expected)
  )
}

test_parse_datetime <- function(x, expected, format = "", ...) {
  test_vroom(
    paste0(paste0(x, collapse = "\n"), "\n"),
    delim = "\t",
    col_names = FALSE,
    col_types = cols(X1 = col_datetime(format = format)),
    ...,
    equals = tibble::tibble(X1 = expected)
  )
}

test_parse_date <- function(x, expected, format = "", ...) {
  test_vroom(
    paste0(paste0(x, collapse = "\n"), "\n"),
    delim = "\t",
    col_names = FALSE,
    col_types = cols(X1 = col_date(format = format)),
    ...,
    equals = tibble::tibble(X1 = expected)
  )
}

test_parse_time <- function(x, expected, format = "", ...) {
  test_vroom(
    paste0(paste0(x, collapse = "\n"), "\n"),
    delim = "\t",
    col_names = FALSE,
    col_types = cols(X1 = col_time(format = format)),
    ...,
    equals = tibble::tibble(X1 = expected)
  )
}

expect_error_free <- function(object, ...) {
  expect_error(object, regexp = NA)
}

on_github_actions <- function() {
  identical(Sys.getenv("GITHUB_ACTIONS"), "true")
}