@@ -22,28 +22,51 @@ all.equal.default <- function(target, current, ...)
22 22
{
23 23
## Really a dispatcher given mode() of args :
24 24
## use data.class as unlike class it does not give "integer"
25 -
if(is.language(target) || is.function(target))
25 +
if(is.language(target))
26 26
return(all.equal.language(target, current, ...))
27 +
if(is.function(target)) {
28 +
.Deprecated("all.equal(*)", old="all.equal.default(<function>)")
29 +
return(all.equal.function(target, current, ...))
30 +
}
27 31
if(is.environment(target) || is.environment(current))# both: unclass() fails on env.
28 32
return(all.equal.environment(target, current, ...))
29 33
if(is.recursive(target))
30 34
return(all.equal.list(target, current, ...))
31 35
msg <- switch (mode(target),
32 -
integer = ,
33 -
complex = ,
34 -
numeric = all.equal.numeric(target, current, ...),
36 +
integer = ,
37 +
complex = ,
38 +
numeric = all.equal.numeric (target, current, ...),
35 39
character = all.equal.character(target, current, ...),
36 -
logical = ,
37 -
raw = all.equal.raw(target, current, ...),
40 +
logical = ,
41 +
raw = all.equal.raw (target, current, ...),
38 42
## assumes that slots are implemented as attributes :
39 -
S4 = attr.all.equal(target, current, ...),
43 +
S4 = attr.all.equal(target, current, ...),
40 44
if(data.class(target) != data.class(current)) {
41 45
gettextf("target is %s, current is %s",
42 46
data.class(target), data.class(current))
43 47
} else NULL)
44 48
if(is.null(msg)) TRUE else msg
45 49
}
46 50 51 +
all.equal.function <- function(target, current, check.environments = TRUE, ...)
52 +
{
53 +
msg <- all.equal.language(target, current, ...)
54 +
if(check.environments) {
55 +
## pre-check w/ identical(), for speed & against infinite recursion:
56 +
ee <- identical(environment(target),
57 +
environment(current), ignore.environment=FALSE)
58 +
if(!ee)
59 +
ee <- all.equal.environment(environment(target),
60 +
environment(current), ...)
61 +
if(isTRUE(msg))
62 +
ee
63 +
else
64 +
c(msg, if(!isTRUE(ee)) ee)
65 +
} else
66 +
msg
67 +
}
68 + 69 + 47 70
all.equal.numeric <-
48 71
function(target, current, tolerance = sqrt(.Machine$double.eps),
49 72
scale = NULL, countEQ = FALSE,
@@ -257,8 +280,7 @@ all.equal.formula <- function(target, current, ...)
257 280
## the misquided one in package Formula
258 281
if(length(target) != length(current))
259 282
return(paste0("target, current differ in having response: ",
260 -
length(target) == 3L,
261 -
", ",
283 +
length(target ) == 3L, ", ",
262 284
length(current) == 3L))
263 285
## <NOTE>
264 286
## This takes same-length formulas as all equal if they deparse
@@ -277,7 +299,7 @@ all.equal.language <- function(target, current, ...)
277 299
mc <- mode(current)
278 300
if(mt == "expression" && mc == "expression")
279 301
return(all.equal.list(target, current, ...))
280 -
ttxt <- paste(deparse(target), collapse = "\n")
302 +
ttxt <- paste(deparse(target ), collapse = "\n")
281 303
ctxt <- paste(deparse(current), collapse = "\n")
282 304
msg <- c(if(mt != mc)
283 305
paste0("Modes of target, current: ", mt, ", ", mc),
@@ -434,7 +456,7 @@ all.equal.POSIXt <- function(target, current, ..., tolerance = 1e-3, scale,
434 456
if(is.null(tz <- attr(dt, "tzone"))) "" else tz[1L]
435 457
}
436 458
## FIXME: check_tzones() ignores differences with "" as time zone,
437 -
## regardless of whether that other time zone is the current one.
459 +
## regardless of whether that other time zone is the current one.
438 460
## However, this code does not handle "" at all, so that it is
439 461
## treated as "inconsistent" even with the current time zone,
440 462
## leading to surprising results, e.g.
RetroSearch is an open source project built by @garambo | Open a GitHub Issue
Search and Browse the WWW like it's 1997 | Search results from DuckDuckGo
HTML:
3.2
| Encoding:
UTF-8
| Version:
0.7.4