all.equal.default(*, check.class=FALSE) now passes the option

git-svn-id: https://svn.r-project.org/R/trunk@89061 00db46b3-68df-0310-9c12-caf00c1e9a41

Author: maechler

doc/NEWS.Rd

@@ -376,6 +376,10 @@
       \item The help page \code{example(matplot)} now correctly labels
       Sepal vs Petal dimensions in its first iris data plot, thanks to
       \I{Jeff Dick}'s post on R-devel.
+
+      \item \code{all.equal(obj, simple, check.class=FALSE)} now is true, also
+      when \code{simple} is a bare atomic vector and \code{obj} has a simple
+      class, fixing the first part of \PR{18971} thanks to \I{Jan Gorecki}.
     }
   }
 }

src/library/base/R/all.equal.R

@@ -64,12 +64,13 @@ all.equal.default <- function(target, current, ..., check.class = TRUE)
     msg <- switch (mode(target),
                    integer   = ,
                    complex   = ,
-                   numeric   = all.equal.numeric  (target, current, ...),
-                   character = all.equal.character(target, current, ...),
+                   numeric   = all.equal.numeric  (target, current, check.class=check.class, ...),
+                   character = all.equal.character(target, current, check.class=check.class, ...),
                    logical   = ,
-                   raw       = all.equal.raw      (target, current, ...),
+                   raw       = all.equal.raw      (target, current, check.class=check.class, ...),
 		   ## assumes that slots are implemented as attributes :
 		   S4        = attr.all.equal(target, current, ...),
+                   ## otherwise :
                    if(check.class && data.class(target) != data.class(current)) {
                        gettextf("target is %s, current is %s",
                                 data.class(target), data.class(current))
@@ -179,12 +180,12 @@ all.equal.numeric <-
 }
 
 all.equal.character <-
-    function(target, current, ..., check.attributes = TRUE)
+    function(target, current, ..., check.attributes = TRUE, check.class = TRUE)
 {
     if (!is.logical(check.attributes))
         stop(gettextf("'%s' must be logical", "check.attributes"), domain = NA)
     msg <-  if(check.attributes) attr.all.equal(target, current, ...)
-    if(data.class(target) != data.class(current)) {
+    if(check.class && data.class(target) != data.class(current)) {
 	msg <- c(msg, paste0("target is ", data.class(target), ", current is ",
                              data.class(current)))
 	return(msg)
@@ -413,12 +414,12 @@ all.equal.list <- function(target, current, ...,
 
 ## also used for logical
 all.equal.raw <-
-    function(target, current, ..., check.attributes = TRUE)
+    function(target, current, ..., check.attributes = TRUE, check.class = TRUE)
 {
     if (!is.logical(check.attributes))
         stop(gettextf("'%s' must be logical", "check.attributes"), domain = NA)
     msg <-  if(check.attributes) attr.all.equal(target, current, ...)
-    if(data.class(target) != data.class(current)) {
+    if(check.class && data.class(target) != data.class(current)) {
 	msg <- c(msg, paste0("target is ", data.class(target), ", current is ",
                              data.class(current)))
 	return(msg)

src/library/base/man/all.equal.Rd

@@ -1,6 +1,6 @@
 % File src/library/base/man/all.equal.Rd
 % Part of the R package, https://www.R-project.org
-% Copyright 1995-2024 R Core Team
+% Copyright 1995-2025 R Core Team
 % Distributed under GPL 2 or later
 
 \name{all.equal}
@@ -33,6 +33,9 @@ all.equal(target, current, \dots)
           formatFUN = function(err, what) format(err),
           \dots, check.attributes = TRUE, check.class = TRUE, giveErr = FALSE)
 
+\method{all.equal}{character}(target, current, \dots,
+          check.attributes = TRUE, check.class = TRUE)
+
 \method{all.equal}{list}(target, current, \dots,
           check.attributes = TRUE, use.names = TRUE)
 

tests/reg-tests-1e.R

@@ -2341,6 +2341,8 @@ stopifnot(exprs = { ## logical/numeric mixtures:
              substitute(list(x, f(.)), e), do.eval = TRUE)
     }
 })
+## now does match f(NA) etc correctly
+
 
 ## check that dim and dimnames are dropped when extending with GROWABLE
 x <- 1:49
@@ -2351,6 +2353,23 @@ a <- .Internal(address(x))
 x[51] <- 51L
 stopifnot(identical(a, .Internal(address(x)))) ## reused x
 stopifnot(is.null(attributes(x))) ## dim and dimnames have been dropped
+## dim and dimnames were kept in R <= 4.5.z
+
+
+## all.equal(*, check.class=FALSE)
+two <- structure(2, foo = 1, class = "bar")
+c2 <- `storage.mode<-`(two, "character")
+r2 <- `storage.mode<-`(two, "raw")
+stopifnot(exprs = {
+    is.character(ae <- all.equal(two^20, 2^20, check.attributes = FALSE))
+    grepl(" bar.* numeric", ae)
+    ## above were TRUE already, these did *still* check class:
+    all.equal(two^20,  2^20, check.attributes = FALSE, check.class = FALSE)
+    all.equal(c2,       "2", check.attributes = FALSE, check.class = FALSE)
+    all.equal(r2, as.raw(2), check.attributes = FALSE, check.class = FALSE)
+})
+## 'check.class' was not passed downstream in R <= 4.5.2
+
 
 
 ## keep at end