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
|
#' @rdname are_identical
#' @export
assert_are_identical <- function(x, y, allow_attributes = FALSE,
severity = getOption("assertive.severity", "stop"))
{
assert_engine(
are_identical,
x,
y = y,
.xname = get_name_in_parent(x),
.yname = get_name_in_parent(y),
severity = severity
)
}
#' @rdname are_identical
#' @export
assert_all_are_identical_legacy <- function(..., l = list())
{
# Nasty reimplementation of functionality since assert_engine doesn't work
# ... inputs right now.
ok <- are_identical_legacy(..., l = list())
if(!all(ok))
{
handler_type <- match.arg(
getOption("assertive.severity"),
c("stop", "warning", "message", "none")
)
if(handler_type == "none") return()
handler <- match.fun(handler_type)
handler(
"The expressions ",
toString(as.list(match.call())[-1]),
" are not all identical.",
call. = FALSE
)
}
}
#' @rdname are_identical
#' @export
assert_any_are_identical_legacy <- function(..., l = list())
{
# Also nasty.
ok <- are_identical_legacy(..., l = list())
if(!any(ok))
{
handler_type <- match.arg(
getOption("assertive.severity"),
c("stop", "warning", "message", "none")
)
if(handler_type == "none") return()
handler <- match.fun(handler_type)
handler(
"The expressions ",
toString(as.list(match.call())[-1]),
" are all not identical.",
call. = FALSE
)
}
}
|
