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
|
clargs <- commandArgs(trailing=TRUE)
source(file.path(clargs[1], "unittest.R"))
dyn.load(paste("abstract_access", .Platform$dynlib.ext, sep=""))
source("abstract_access.R")
dd <- D()
unittest(1, dd$z())
unittest(1, dd$do_x())
## Original version allowed dd$z <- 2
tryCatch({
dd$z <- 2
# force an error if the previous line doesn't raise an exception
stop("Test Failure A")
}, error = function(e) {
if (e$message == "Test Failure A") {
# Raise the error again to cause a failed test
stop(e)
}
message("Correct - no dollar assignment method found")
}
)
tryCatch({
dd[["z"]] <- 2
# force an error if the previous line doesn't raise an exception
stop("Test Failure B")
}, error = function(e) {
if (e$message == "Test Failure B") {
# Raise the error again to cause a failed test
stop(e)
}
message("Correct - no dollar assignment method found")
}
)
## The methods are attached to the parent class - see if we can get
## them
tryCatch({
m1 <- getMethod('$', "_p_A")
}, error = function(e) {
stop("No $ method found - there should be one")
}
)
## These methods should not be present
## They correspond to the tests that are expected
## to fail above.
tryCatch({
m2 <- getMethod('$<-', "_p_A")
# force an error if the previous line doesn't raise an exception
stop("Test Failure C")
}, error = function(e) {
if (e$message == "Test Failure C") {
# Raise the error again to cause a failed test
stop(e)
}
message("Correct - no dollar assignment method found")
}
)
tryCatch({
m3 <- getMethod('[[<-', "_p_A")
# force an error if the previous line doesn't raise an exception
stop("Test Failure D")
}, error = function(e) {
if (e$message == "Test Failure D") {
# Raise the error again to cause a failed test
stop(e)
}
message("Correct - no list assignment method found")
}
)
|
