Skip to content

Commit 58ba258

Browse files
perrydvperrydv
committed
avoid use of template specializations within class definition. fix set_all_values tests.
1 parent a3bf115 commit 58ba258

2 files changed

Lines changed: 104 additions & 97 deletions

File tree

‎nCompiler/inst/include/nCompiler/nC_inter/post_Rcpp/generic_class_interface_Rcpp_steps.h‎

Lines changed: 4 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -160,13 +160,9 @@ class genericInterfaceC : virtual public genericInterfaceBaseC {
160160
return (access->second->get(this));
161161
}
162162

163-
template<typename Rtype>
164-
void set_all_values_impl(const Rtype Robj);
165-
166163
// For a list input, checking names in the list is costly
167164
// so we iterate through the list and check names against name2access.
168-
template<>
169-
void set_all_values_impl<Rcpp::List>(const Rcpp::List Robj) {
165+
void set_all_values_impl_list(const Rcpp::List Robj) {
170166
// Cache names once to avoid repeatedly constructing the names vector
171167
Rcpp::Nullable<Rcpp::CharacterVector> nmsN = Robj.names();
172168
if(nmsN.isNull()) {
@@ -186,8 +182,7 @@ class genericInterfaceC : virtual public genericInterfaceBaseC {
186182
// For an environment input, checking names is less costly
187183
// so we iterate through name2access and check for each name
188184
// whether it exists in the environment.
189-
template<>
190-
void set_all_values_impl<Rcpp::Environment>(const Rcpp::Environment Robj) {
185+
void set_all_values_impl_environment(const Rcpp::Environment Robj) {
191186
size_t n = name2access.size();
192187
auto i_n2a = name2access.begin();
193188
auto end_n2a = name2access.end();
@@ -201,9 +196,9 @@ class genericInterfaceC : virtual public genericInterfaceBaseC {
201196

202197
void set_all_values(SEXP Robj) {
203198
if(Rcpp::is<Rcpp::Environment>(Robj)) {
204-
set_all_values_impl<Rcpp::Environment>(Robj);
199+
set_all_values_impl_environment(Robj);
205200
} else if(Rcpp::is<Rcpp::List>(Robj)) {
206-
set_all_values_impl<Rcpp::List>(Robj);
201+
set_all_values_impl_list(Robj);
207202
} else {
208203
Rcpp::stop("Setting all values of an nClass only works from environment (including nClass or R6) or list objects.\n");
209204
}

‎nCompiler/tests/testthat/nClass_tests/test-nClass_set_all_values.R‎

Lines changed: 100 additions & 88 deletions
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,7 @@
11
# Tests of assigning multiple fields of an nClass from a list or environment
22

3-
library(nCompiler)
4-
library(testthat)
3+
# library(nCompiler)
4+
# library(testthat)
55

66
test_that("assigning multiple fields of an nClass from a list works", {
77

@@ -48,65 +48,67 @@ test_that("assigning multiple fields of an nClass from a list works", {
4848

4949
obj1a <- comp$nc1()
5050
value(obj1a, "x") <- 1:3
51-
value(obj1a, "x")
52-
value(obj1a) <- list(x = 1:3, y = TRUE)
53-
value(obj1a, "x")
54-
value(obj1a, "y")
51+
expect_equal(value(obj1a, "x"), 1:3)
52+
expect_equal(value(obj1a, "y"), logical())
53+
value(obj1a) <- list(x = 2:4, y = TRUE)
54+
expect_equal(value(obj1a, "x"), 2:4)
55+
expect_equal(value(obj1a, "y"), TRUE)
5556
value(obj1a) <- list(x = 4:6)
56-
value(obj1a, "x")
57-
value(obj1a, "y")
57+
expect_equal(value(obj1a, "x"), 4:6)
58+
expect_equal(value(obj1a, "y"), TRUE)
5859
value(obj1a) <- list(y = c(1, 0, 1))
59-
value(obj1a, "x")
60-
value(obj1a, "y")
60+
expect_equal(value(obj1a, "x"), 4:6)
61+
expect_equal(value(obj1a, "y"), as.logical(c(1,0,1)))
6162
value(obj1a) <- list(not_there = 100)
62-
value(obj1a, "x")
63-
value(obj1a, "y")
64-
63+
expect_equal(value(obj1a, "x"), 4:6)
64+
expect_equal(value(obj1a, "y"), as.logical(c(1,0,1)))
6565

6666
value(obj1a) <- as.environment(list(x = 7:9, y = c(0, 1)))
67-
value(obj1a, "x")
68-
value(obj1a, "y")
67+
expect_equal(value(obj1a, "x"), 7:9)
68+
expect_equal(value(obj1a, "y"), as.logical(c(0,1)))
6969
value(obj1a) <- as.environment(list(y = FALSE))
70-
value(obj1a, "x")
71-
value(obj1a, "y")
70+
expect_equal(value(obj1a, "x"), 7:9)
71+
expect_equal(value(obj1a, "y"), FALSE)
7272
value(obj1a) <- as.environment(list(not_there = 100))
73-
value(obj1a, "x")
74-
value(obj1a, "y")
73+
expect_equal(value(obj1a, "x"), 7:9)
74+
expect_equal(value(obj1a, "y"), FALSE)
7575

7676
obj2a <- comp$nc2()
77-
value(obj2a, "my_nc1") |> value("x")
77+
expect_identical(value(obj2a, "my_nc1") |> value("x"), numeric())
7878
value(obj2a) <- list(z = 42, my_nc1 = obj1a)
79-
value(obj2a, "z")
80-
value(obj2a, "my_nc1") |> value("x")
81-
value(obj2a, "my_nc1") |> value("y")
79+
expect_equal(value(obj2a, "z"), 42)
80+
expect_equal(value(obj2a, "my_nc1") |> value("x"), 7:9)
81+
expect_equal(value(obj2a, "my_nc1") |> value("y"), FALSE)
8282

8383
value( value(obj2a, "my_nc1"), "x") <- 101:103
84-
value(obj1a, "x")
84+
expect_equal(value(obj1a, "x"), 101:103)
8585

8686
value( value(obj2a, "my_nc1") ) <- list(x = 104:106, y = c(1,1,1))
87-
value(obj1a, "x")
88-
value(obj1a, "y")
89-
90-
value(obj2a, "my_nc1") <- list(x = 201:203, y = c(0,0,0)) # makes new object
91-
expect_equal(value(obj1a, "x"), 104:106) # old values, because obj2a$my_nc1 is new
92-
expect_equal(value(obj1a, "y"), c(T, T, T))
93-
obj1b <- value(obj2a, "my_nc1") # new object
94-
expect_equal(value(obj1b, "x"), 201:203) # new values
95-
expect_equal(value(obj1b, "y"), c(F, F, F))
87+
expect_equal(value(obj1a, "x"), 104:106)
88+
expect_equal(value(obj1a, "y"), as.logical(c(1,1,1)))
9689

97-
value(obj2a, "my_nc1") <- as.environment(list(x = 301:303)) # makes new object
90+
value(obj2a, "my_nc1") <- list(x = 201:203, y = c(0,0,0))
91+
expect_equal(value(obj1a, "x"), 201:203)
92+
expect_equal(value(obj1a, "y"), as.logical(c(0,0,0)))
93+
obj1b <- value(obj2a, "my_nc1")
9894
expect_equal(value(obj1b, "x"), 201:203)
9995
expect_equal(value(obj1b, "y"), c(F, F, F))
96+
97+
value(obj2a, "my_nc1") <- as.environment(list(x = 301:303))
98+
expect_equal(value(obj1b, "x"), 301:303)
99+
expect_equal(value(obj1b, "y"), c(F, F, F))
100100
obj1c <- value(obj2a, "my_nc1")
101101
expect_equal(value(obj1c, "x"), 301:303)
102-
expect_equal(value(obj1c, "y"), logical())
102+
expect_equal(value(obj1c, "y"), c(F,F,F))
103103

104-
value(obj2a, "my_null_nc1") <- list(x = 1:3, y = TRUE)
105-
value(obj2a, "my_null_nc1") |> value("x")
104+
value(obj2a, "my_null_nc1") <- list(x = 1:3, y = TRUE) # makes new object
105+
expect_equal(value(obj2a, "my_null_nc1") |> value("x"), 1:3)
106106
value(obj2a, "my_null_nc1") <- as.environment(list(x = 4:6, y = TRUE))
107-
value(obj2a, "my_null_nc1") |> value("x")
107+
expect_equal(value(obj2a, "my_null_nc1") |> value("x"), 4:6)
108+
expect_equal(value(obj2a, "my_null_nc1") |> value("y"), TRUE)
108109

109110
expect_error(value(obj2a, "my_nc0") <- list(w = 1:3))
111+
rm(obj1a, obj1b, obj2a); gc()
110112
})
111113

112114

@@ -151,90 +153,100 @@ test_that("assigning multiple fields of an nClass from a list works", {
151153

152154
comp <- nCompile(nc0, nc1, nc2, interfaces = "full")
153155

156+
# Use the tests above because generic interface
157+
# should also work with full interface objects
154158
obj1a <- comp$nc1$new()
155159
value(obj1a, "x") <- 1:3
156-
value(obj1a, "x")
157-
value(obj1a) <- list(x = 1:3, y = TRUE)
158-
value(obj1a, "x")
159-
value(obj1a, "y")
160+
expect_equal(value(obj1a, "x"), 1:3)
161+
expect_equal(value(obj1a, "y"), logical())
162+
value(obj1a) <- list(x = 2:4, y = TRUE)
163+
expect_equal(value(obj1a, "x"), 2:4)
164+
expect_equal(value(obj1a, "y"), TRUE)
160165
value(obj1a) <- list(x = 4:6)
161-
value(obj1a, "x")
162-
value(obj1a, "y")
166+
expect_equal(value(obj1a, "x"), 4:6)
167+
expect_equal(value(obj1a, "y"), TRUE)
163168
value(obj1a) <- list(y = c(1, 0, 1))
164-
value(obj1a, "x")
165-
value(obj1a, "y")
169+
expect_equal(value(obj1a, "x"), 4:6)
170+
expect_equal(value(obj1a, "y"), as.logical(c(1,0,1)))
166171
value(obj1a) <- list(not_there = 100)
167-
value(obj1a, "x")
168-
value(obj1a, "y")
169-
172+
expect_equal(value(obj1a, "x"), 4:6)
173+
expect_equal(value(obj1a, "y"), as.logical(c(1,0,1)))
170174

171175
value(obj1a) <- as.environment(list(x = 7:9, y = c(0, 1)))
172-
value(obj1a, "x")
173-
value(obj1a, "y")
176+
expect_equal(value(obj1a, "x"), 7:9)
177+
expect_equal(value(obj1a, "y"), as.logical(c(0,1)))
174178
value(obj1a) <- as.environment(list(y = FALSE))
175-
value(obj1a, "x")
176-
value(obj1a, "y")
179+
expect_equal(value(obj1a, "x"), 7:9)
180+
expect_equal(value(obj1a, "y"), FALSE)
177181
value(obj1a) <- as.environment(list(not_there = 100))
178-
value(obj1a, "x")
179-
value(obj1a, "y")
182+
expect_equal(value(obj1a, "x"), 7:9)
183+
expect_equal(value(obj1a, "y"), FALSE)
180184

181185
obj2a <- comp$nc2$new()
182-
value(obj2a, "my_nc1") |> value("x")
186+
expect_identical(value(obj2a, "my_nc1") |> value("x"), numeric())
183187
value(obj2a) <- list(z = 42, my_nc1 = obj1a)
184-
value(obj2a, "z")
185-
value(obj2a, "my_nc1") |> value("x")
186-
value(obj2a, "my_nc1") |> value("y")
188+
expect_equal(value(obj2a, "z"), 42)
189+
expect_equal(value(obj2a, "my_nc1") |> value("x"), 7:9)
190+
expect_equal(value(obj2a, "my_nc1") |> value("y"), FALSE)
187191

188192
value( value(obj2a, "my_nc1"), "x") <- 101:103
189-
value(obj1a, "x")
193+
expect_equal(value(obj1a, "x"), 101:103)
190194

191195
value( value(obj2a, "my_nc1") ) <- list(x = 104:106, y = c(1,1,1))
192-
value(obj1a, "x")
193-
value(obj1a, "y")
194-
195-
value(obj2a, "my_nc1") <- list(x = 201:203, y = c(0,0,0)) # makes new object
196-
expect_equal(value(obj1a, "x"), 104:106) # old values, because obj2a$my_nc1 is new
197-
expect_equal(value(obj1a, "y"), c(T, T, T))
198-
obj1b <- value(obj2a, "my_nc1") # new object
199-
expect_equal(value(obj1b, "x"), 201:203) # new values
200-
expect_equal(value(obj1b, "y"), c(F, F, F))
196+
expect_equal(value(obj1a, "x"), 104:106)
197+
expect_equal(value(obj1a, "y"), as.logical(c(1,1,1)))
201198

202-
value(obj2a, "my_nc1") <- as.environment(list(x = 301:303)) # makes new object
199+
value(obj2a, "my_nc1") <- list(x = 201:203, y = c(0,0,0))
200+
expect_equal(value(obj1a, "x"), 201:203)
201+
expect_equal(value(obj1a, "y"), as.logical(c(0,0,0)))
202+
obj1b <- value(obj2a, "my_nc1")
203203
expect_equal(value(obj1b, "x"), 201:203)
204204
expect_equal(value(obj1b, "y"), c(F, F, F))
205+
206+
value(obj2a, "my_nc1") <- as.environment(list(x = 301:303))
207+
expect_equal(value(obj1b, "x"), 301:303)
208+
expect_equal(value(obj1b, "y"), c(F, F, F))
205209
obj1c <- value(obj2a, "my_nc1")
206210
expect_equal(value(obj1c, "x"), 301:303)
207-
expect_equal(value(obj1c, "y"), logical())
211+
expect_equal(value(obj1c, "y"), c(F,F,F))
208212

209-
value(obj2a, "my_null_nc1") <- list(x = 1:3, y = TRUE)
210-
value(obj2a, "my_null_nc1") |> value("x")
213+
value(obj2a, "my_null_nc1") <- list(x = 1:3, y = TRUE) # makes new object
214+
expect_equal(value(obj2a, "my_null_nc1") |> value("x"), 1:3)
211215
value(obj2a, "my_null_nc1") <- as.environment(list(x = 4:6, y = TRUE))
212-
value(obj2a, "my_null_nc1") |> value("x")
216+
expect_equal(value(obj2a, "my_null_nc1") |> value("x"), 4:6)
217+
expect_equal(value(obj2a, "my_null_nc1") |> value("y"), TRUE)
213218

214219
expect_error(value(obj2a, "my_nc0") <- list(w = 1:3))
220+
rm(obj1a, obj1b, obj2a); gc()
215221

216-
#####
222+
###
223+
## Add some tests using the actual full interface
217224

218225
obj2a <- comp$nc2$new()
219-
obj2a$my_nc1$x
226+
expect_equal(obj2a$my_nc1$x, numeric())
220227
obj2a$my_nc1$x <- 101:103
221-
obj2a$my_nc1$x
228+
expect_equal(obj2a$my_nc1$x, 101:103)
222229
obj2a$my_nc1 <- list(x = 104:106, y = c(1,1,1))
223-
obj2a$my_nc1$x
230+
expect_equal(obj2a$my_nc1$x, 104:106)
224231
obj1a <- obj2a$my_nc1
225-
obj1a$x
226-
obj1a$y
232+
expect_equal(obj1a$x, 104:106)
233+
expect_equal(obj1a$y, as.logical(c(1,1,1)))
227234

228235
obj2a$my_nc1 <- as.environment(list(x = 201:203, y = c(0,0,0)))
229-
obj1a$x
230-
obj1a$y
236+
expect_equal(obj1a$x, 201:203)
237+
expect_equal(obj1a$y, as.logical(c(0,0,0)))
231238

232239
obj2a$my_null_nc1 <- list(x = 1:3, y = TRUE)
233-
obj2a$my_null_nc1$x
234-
obj2a$my_null_nc1$y
240+
expect_equal(obj2a$my_null_nc1$x, 1:3)
241+
expect_equal(obj2a$my_null_nc1$y, TRUE)
235242
obj2a$my_null_nc1 <- as.environment(list(x = 4:6, y = FALSE))
236-
obj2a$my_null_nc1$x
237-
obj2a$my_null_nc1$y
238-
239-
obj2a$my_nc0 <- list(w = 1:3)
243+
expect_equal(obj2a$my_null_nc1$x, 4:6)
244+
expect_equal(obj2a$my_null_nc1$y, FALSE)
245+
246+
# Could add more but stopping. I'm not sure there's a purpose
247+
# in further exercising the full interface. At this point I have
248+
# ended up testing that the generic interface for a full object
249+
# does the same thing internally and there is no further point
250+
# to pursue here.
251+
rm(obj2a, obj1a); gc()
240252
})

0 commit comments

Comments
 (0)