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
|
expect_arglist_is_empty <- function(object) {
act <- quasi_label(enquo(object), arg = "object")
act$formals <- formals(act$val)
expect(
is.null(act$formals),
sprintf("%s has an empty argument list.", act$lab)
)
invisible(act$val)
}
expect_all_args_have_default_values <- function(object) {
act <- quasi_label(enquo(object), arg = "object")
act$args <- formals(act$val)
act$args <- act$args[names(act$args) != "..."]
act$char_args <- map_chr(act$args, as.character)
expect(
all(nzchar(act$char_args, keepNA = FALSE)),
sprintf("%s has arguments without default values", act$lab)
)
invisible(act$val)
}
has_method <- function(method_name) {
function(x) {
my_class <- class(x)
expect_true(
length(findMethod(method_name, my_class)) > 0L,
paste("object of class", my_class, "has no", method_name, "method")
)
}
}
expect_visible <- function(code) {
ret <- withVisible(code)
expect_true(ret$visible)
ret$value
}
expect_invisible_true <- function(code) {
ret <- withVisible(code)
expect_true(ret$value)
expect_false(ret$visible)
invisible(ret$value)
}
expect_equal_df <- function(actual, expected) {
factor_cols <- map_lgl(expected, is.factor)
expected[factor_cols] <- map(expected[factor_cols], as.character)
asis_cols <- map_lgl(expected, inherits, "AsIs")
expected[asis_cols] <- map(expected[asis_cols], unclass)
list_cols <- map_lgl(expected, is.list)
if (!any(list_cols)) {
order_actual <- do.call(order, actual)
order_expected <- do.call(order, expected)
} else {
expect_false(all(list_cols))
expect_equal(anyDuplicated(actual[!list_cols]), 0)
expect_equal(anyDuplicated(expected[!list_cols]), 0)
order_actual <- do.call(order, actual[!list_cols])
order_expected <- do.call(order, expected[!list_cols])
}
has_rownames_actual <- is.character(attr(actual, "row.names"))
has_rownames_expected <- is.character(attr(expected, "row.names"))
expect_equal(has_rownames_actual, has_rownames_expected)
if (has_rownames_actual) {
expect_equal(sort(row.names(actual)), sort(row.names(expected)))
}
actual <- unrowname(actual[order_actual, ])
expected <- unrowname(expected[order_expected, ])
expect_identical(actual, expected)
}
expect_equal_arrow <- function(actual, expected) {
expect_equal_df(as.data.frame(actual), as.data.frame(expected))
}
skip_if_not_dbitest <- function(ctx, version) {
if (as.package_version(ctx$tweaks$dbitest_version) < version) {
skip(paste0("tweak: dbitest_version: required: ", version, ", available: ", ctx$tweaks$dbitest_version))
}
}
|
