The R Project SVN R

Rev

Rev 84054 | Show entire file | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 84054 Rev 84152
Line 1... Line 1...
1 
 
 1 
 
2 
R Under development (unstable) (2023-03-16 r83996) -- "Unsuffered Consequences"
 2 
R Under development (unstable) (2023-03-26 r84067) -- "Unsuffered Consequences"
3 
Copyright (C) 2023 The R Foundation for Statistical Computing
 3 
Copyright (C) 2023 The R Foundation for Statistical Computing
4 
Platform: x86_64-pc-linux-gnu (64-bit)
 4 
Platform: x86_64-pc-linux-gnu (64-bit)
5 
 
 5 
 
6 
R is free software and comes with ABSOLUTELY NO WARRANTY.
 6 
R is free software and comes with ABSOLUTELY NO WARRANTY.
7 
You are welcome to redistribute it under certain conditions.
 7 
You are welcome to redistribute it under certain conditions.
Line 104... Line 104...
104 
> abc(e1[[1]])
 104 
> abc(e1[[1]])
105 
abc: Before dispatching; x has class `call': language sin(x)
 105 
abc: Before dispatching; x has class `call': language sin(x)
106 
abc.default(e1[[1]])
 106 
abc.default(e1[[1]])
107 
>
107 
>
108 
>
108 
>
- 
 
 109 
> ## Some tests for `nameOfClass()`, called from inherits()
- 
 
 110 
> ClassX <- structure(list(), name = "ClassX",
- 
 
 111 
+                     class = c("S3pp_class", "S3pp_object"))
- 
 
 112 
>
- 
 
 113 
> classx_instance <- structure(list(), class = c("ClassX", "S3pp_object"))
- 
 
 114 
>
- 
 
 115 
> nameOfClass.S3pp_class <- function(x) attr(x, "name", TRUE)
- 
 
 116 
> nameOfClass.foo <- function(x) "bar"
- 
 
 117 
>
- 
 
 118 
> stopifnot(exprs = {
- 
 
 119 
+     inherits(classx_instance, "ClassX")
- 
 
 120 
+     inherits(classx_instance, ClassX)
- 
 
 121 
+     ## ignore class on a character object
- 
 
 122 
+     isTRUE(inherits(1, structure("numeric", class = "foo")))
- 
 
 123 
+     ## make sure class is nor evaluated in calling nameOfClass
- 
 
 124 
+     isFALSE(inherits(1, structure(quote(stop("should not be evaluated")),
- 
 
 125 
+                                   class = "foo")))
- 
 
 126 
+ })
- 
 
 127 
>
- 
 
 128 
>
109 
> ## Some tests for `@` dispatching
 129 
> ## Some tests for `@` dispatching
110 
> ## make sure that
 130 
> ## make sure that
111 
> ## - `@` evals the first args only once,
 131 
> ## - `@` evals the first args only once,
112 
> ## -  doesn't dispatch for S4
 132 
> ## -  doesn't dispatch for S4
113 
> ## -  works on `.Data` even for nonS4 objects
 133 
> ## -  works on `.Data` even for nonS4 objects
Line 178... Line 198...
178 
+ }
 198 
+ }
179 
>
199 
>
180 
> p <- new("Person", name = "Who", age = -1)
 200 
> p <- new("Person", name = "Who", age = -1)
181 
> stopifnot(p@name == "Who")
 201 
> stopifnot(p@name == "Who")
182 
>
202 
>
- 
 
 203 
>
- 
 
 204 
> ## Some tests for `chooseOpsMethod()`, called from C DispatchGroup() when
- 
 
 205 
> ## 2 methods are found
- 
 
 206 
> foo_obj <- structure(1, class = "foo")
- 
 
 207 
> bar_obj <- structure(1, class = "bar")
- 
 
 208 
>
- 
 
 209 
> `+.foo` <- function(e1, e2) "foo"
- 
 
 210 
> `+.bar` <- function(e1, e2) "bar"
- 
 
 211 
>
- 
 
 212 
> invisible(foo_obj + bar_obj)  # Warning: Incompatible methods
- 
 
 213 
Warning message:
- 
 
 214 
Incompatible methods ("+.foo", "+.bar") for "+"
- 
 
 215 
>
- 
 
 216 
> chooseOpsMethod.bar <- function(x, y, mx, my, cl, reverse) TRUE
- 
 
 217 
>
- 
 
 218 
> stopifnot(exprs = {
- 
 
 219 
+     identical(foo_obj + bar_obj, "bar")
- 
 
 220 
+     identical(bar_obj + foo_obj, "bar")
- 
 
 221 
+ })
- 
 
 222 
>