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
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
|
message("TESTING: BasicObject...")
library("R.oo")
obj <- BasicObject()
print(obj)
obj <- BasicObject(42L)
print(obj)
stopifnot(obj == 42L)
obj$a <- 1:99
print(obj)
fields <- getFields(obj)
print(fields)
hasA <- hasField(obj, "a")
print(hasA)
stopifnot(hasA)
value <- obj$a
str(value)
stopifnot(identical(value, 1:99))
obj$a <- 1:100
print(obj)
value <- obj[["a"]]
str(value)
stopifnot(identical(value, 1:100))
size <- objectSize(obj)
print(size)
ref <- isReferable(obj)
print(ref)
stopifnot(isTRUE(ref))
time <- getInstantiationTime(obj)
print(time)
# - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# Attach and detach
# - - - - - - - - - - - - - - - - - - - - - - - - - - - -
obj <- BasicObject(42L)
obj$a <- 1:99
res <- attach(obj)
print(res)
stopifnot(exists("a", mode="integer"))
str(a)
## Object already attached
res <- tryCatch(attach(obj), warning=function(w) w)
stopifnot(inherits(res, "warning"))
res <- detach(obj)
print(res)
## Object already detached
res <- tryCatch(detach(obj), warning=function(w) w)
stopifnot(inherits(res, "warning"))
obj <- BasicObject(list(a=1L, b=2, c=3))
res <- attach(obj)
print(res)
stopifnot(exists("a", mode="integer"))
str(a)
res <- detach(obj)
print(res)
# - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# Class
# - - - - - - - - - - - - - - - - - - - - - - - - - - - -
obj2 <- newInstance(obj, 43L)
print(obj2)
stopifnot(obj2 == 43L)
# - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# Inheritance
# - - - - - - - - - - - - - - - - - - - - - - - - - - - -
setConstructorS3("MyObject", function(...) {
extend(BasicObject(), "MyObject", ...)
})
obj <- MyObject(a=1, b=2)
print(obj)
str(obj)
stopifnot(all(c("a", "b") %in% names(attributes(obj))))
setMethodS3("foo", "MyObject", function(static, x=1L, ...) {
list(x=x, ...)
}, static=TRUE)
res <- MyObject$foo(y=2L)
stopifnot(identical(res$x, 1L))
stopifnot(identical(res$y, 2L))
# - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# FIXME: hashCode() return integer(0) whenever
# getInstantiationTime() returns NULL, which is
# now the default behavior of BasicObject
# - - - - - - - - - - - - - - - - - - - - - - - - - - - -
hash <- hashCode(obj)
print(hash)
## FIXME: Currently returns integer(0)
## stopifnot(length(hash) == 1L)
neq <- equals(obj, 1)
print(neq)
## FIXME: Currently returns NA
## stopifnot(!neq)
eq <- equals(obj, obj)
print(eq)
## FIXME: Currently returns NA
## stopifnot(eq)
message("TESTING: BasicObject...DONE")
|
