all.equal no longer error when not a DT

DESCRIPTION

@@ -49,7 +49,8 @@ Authors@R: c(
   person("Tyson","Barrett",        role="ctb"),
   person("Jim","Hester",           role="ctb"),
   person("Anthony","Damico",       role="ctb"),
-  person("Sebastian","Freundt",    role="ctb"))
+  person("Sebastian","Freundt",    role="ctb"),
+  person("David","Simons",         role="ctb"))
 Depends: R (>= 3.1.0)
 Imports: methods
 Suggests: bit64, curl, R.utils, knitr, xts, nanotime, zoo, yaml

NEWS.md

@@ -85,6 +85,8 @@ unit = "s")
 
 5. `GForce` is deactivated for `[[` on non-atomic input, part of [#4159](https://github.com/Rdatatable/data.table/issues/4159).
 
+6. `all.equal(DT, y)` no longer errors when `y` is not a data.table, [#4042](https://github.com/Rdatatable/data.table/issues/4042). Thanks to @d-sci for reporting and the PR.
+
 ## NOTES
 
 1. `as.IDate`, `as.ITime`, `second`, `minute`, and `hour` now recognize UTC equivalents for speed: GMT, GMT-0, GMT+0, GMT0, Etc/GMT, and Etc/UTC, [#4116](https://github.com/Rdatatable/data.table/issues/4116).

R/setops.R

@@ -103,8 +103,13 @@ fsetequal = function(x, y, all=TRUE) {
 # all.equal ----
 
 all.equal.data.table = function(target, current, trim.levels=TRUE, check.attributes=TRUE, ignore.col.order=FALSE, ignore.row.order=FALSE, tolerance=sqrt(.Machine$double.eps), ...) {
-  stopifnot(is.logical(trim.levels), is.logical(check.attributes), is.logical(ignore.col.order), is.logical(ignore.row.order), is.numeric(tolerance))
-  if (!is.data.table(target) || !is.data.table(current)) stop("'target' and 'current' must both be data.tables")
+  stopifnot(is.logical(trim.levels), is.logical(check.attributes), is.logical(ignore.col.order), is.logical(ignore.row.order), is.numeric(tolerance), is.data.table(target))
+
+  if (!is.data.table(current)) {
+    if (check.attributes) return(paste0('target is data.table, current is ', data.class(current)))
+    try({current = as.data.table(current)}, silent = TRUE)
+    if (!is.data.table(current)) return('target is data.table but current is not and failed to be coerced to it')
+  }
 
   msg = character(0L)
   # init checks that detect high level all.equal

inst/tests/tests.Rraw

@@ -8500,8 +8500,27 @@ test(1613.573, all.equal(cbind(x, factor(1)), cbind(x, factor(1)), ignore.row.or
 test(1613.581, all(all.equal(x, y, ignore.row.order = FALSE, tolerance = 1), all.equal(x, y, ignore.row.order = TRUE, tolerance = 1)))
 test(1613.582, all(all.equal(x, y, ignore.row.order = FALSE, tolerance = sqrt(.Machine$double.eps)/2), all.equal(x, y, ignore.row.order = TRUE, tolerance = sqrt(.Machine$double.eps)/2)), warning = "Argument 'tolerance' was forced")
 
-test(1613.59, all.equal.data.table(1L, 2L), error = "'target' and 'current' must both be data.tables")
-test(1613.60, all.equal(data.table(1L), 2L), error = "'target' and 'current' must both be data.tables")
+# fix for #4042
+test(1613.59, all.equal.data.table(1L, 2L), error = "is.data.table(target) is not TRUE")
+test(1613.601, all.equal(data.table(a=1), data.frame(a=1)), "target is data.table, current is data.frame")
+test(1613.602, all.equal(data.table(a=1), data.frame(a=1), check.attributes = FALSE))
+test(1613.603, all.equal(data.table(a=1), list(a=1), check.attributes = FALSE))
+test(1613.604, all.equal(data.table(a=1), 1, check.attributes = FALSE))
+test(1613.605, all.equal(data.table(a=1), try(stop('this wont work'), silent = TRUE), check.attributes = FALSE), "target is data.table but current is not and failed to be coerced to it")
+L1 <- list(a = data.table(1), b = setattr("foo", "tbl", data.table(1)))
+L2 <- list(a = 1, b = setattr("foo", "tbl", 1))
+test(1613.606, all(grepl("target is data.table, current is numeric", all.equal(L1, L2))))
+as.data.table.foo = function(x) { # test as.data.table coerce of 'current' argument
+  if (!length(x)) warning("empty foo")
+  as.data.table(unclass(foo))
+}
+registerS3method("as.data.table", "foo", as.data.table.foo)
+foo = structure(list(NULL), class="foo")
+test(1613.607, all.equal(data.table(), foo, check.attributes=FALSE))
+foo = structure(list(), class="foo")
+test(1613.608, all.equal(data.table(), foo, check.attributes=FALSE), warning="empty")
+rm(as.data.table.foo, foo)
+
 DT1 <- data.table(a = 1:4, b = letters[1:4], .seqn = 5L)
 DT2 <- data.table(a = 4:1, b = letters[4:1], .seqn = 5L)
 test(1613.61, all.equal(DT1, DT2, ignore.row.order = TRUE), error = "column named '.seqn'")

man/all.equal.data.table.Rd

@@ -14,7 +14,8 @@
 
 \arguments{
   \item{target, current}{
-      \code{data.table}s to compare
+      \code{data.table}s to compare. If \code{current} is not a \code{data.table}, but \code{check.attributes} is FALSE,
+      it will be coerced to one via \link{as.data.table}.
   }
 
   \item{trim.levels}{
@@ -79,6 +80,10 @@ x = copy(dt1)
 y = setkeyv(copy(dt1), NULL)
 all.equal(x, y)
 all.equal(x, y, check.attributes = FALSE)
+x = data.table(1L)
+y = 1L
+all.equal(x, y)
+all.equal(x, y, check.attributes = FALSE)
 
 # trim.levels
 x <- data.table(A = factor(letters[1:10])[1:4]) # 10 levels