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
130
131
132
133
134
135
136
137
138
139
140
141
142
|
library("listenv")
ovars <- ls(envir = globalenv())
if (exists("x")) rm(list = "x")
if (exists("y")) rm(list = "y")
## - - - - - - - - - - - - - - - - - - - - - - - - - -
## Multi-dimensional subsetting
## - - - - - - - - - - - - - - - - - - - - - - - - - -
message("*** parse_env_subset() on multi-dim listenv ...")
x <- listenv()
length(x) <- 6
dim(x) <- c(2, 3)
target <- parse_env_subset(x[2], substitute = TRUE)
str(target)
stopifnot(identical(target$envir, x), target$idx == 2, !target$exists)
target <- parse_env_subset(x[[2]], substitute = TRUE)
str(target)
stopifnot(identical(target$envir, x), target$idx == 2, !target$exists)
target <- parse_env_subset(x[1, 2], substitute = TRUE)
str(target)
stopifnot(identical(target$envir, x), target$idx == 3, !target$exists)
target <- parse_env_subset(x[[1, 2]], substitute = TRUE)
str(target)
stopifnot(identical(target$envir, x), target$idx == 3, !target$exists)
x[[1, 2]] <- 1.2
target <- parse_env_subset(x[1, 2], substitute = TRUE)
str(target)
stopifnot(identical(target$envir, x), target$idx == 3, target$exists)
target <- parse_env_subset(x[[1, 2]], substitute = TRUE)
str(target)
stopifnot(identical(target$envir, x), target$idx == 3, target$exists)
target <- parse_env_subset(x[1, 4], substitute = TRUE)
str(target)
stopifnot(identical(target$envir, x), is.na(target$idx), !target$exists)
target <- parse_env_subset(x[[1, 4]], substitute = TRUE)
str(target)
stopifnot(identical(target$envir, x), is.na(target$idx), !target$exists)
target <- parse_env_subset(x[1, 1:2], substitute = TRUE)
str(target)
stopifnot(identical(target$envir, x),
length(target$idx) == 2L, all(target$idx == c(1,3)),
length(target$exists) == 2L, all(target$exists == c(FALSE, TRUE)))
target <- parse_env_subset(x[1, -3], substitute = TRUE)
str(target)
stopifnot(identical(target$envir, x),
length(target$idx) == 2L, all(target$idx == c(1,3)),
length(target$exists) == 2L, all(target$exists == c(FALSE, TRUE)))
## Assert that x[[1, 4]] is not the same as x[[c(1, 4)]]
target <- parse_env_subset(x[[1, 4]], substitute = TRUE)
str(target)
target2 <- parse_env_subset(x[[c(1, 4)]], substitute = TRUE)
str(target2)
target$code <- target2$code <- NULL
stopifnot(!isTRUE(all.equal(target2, target)))
dimnames(x) <- list(c("a", "b"), c("A", "B", "C"))
print(x)
target <- parse_env_subset(x[["a", 2]], substitute = TRUE)
str(target)
stopifnot(identical(target$envir, x), target$idx == 3, target$exists)
target <- parse_env_subset(x[["a", "B"]], substitute = TRUE)
str(target)
stopifnot(identical(target$envir, x), target$idx == 3, target$exists)
target <- parse_env_subset(x["a", "B"], substitute = TRUE)
str(target)
stopifnot(identical(target$envir, x), target$idx == 3, target$exists)
target <- parse_env_subset(x["a", 1:3], substitute = TRUE)
str(target)
stopifnot(identical(target$envir, x), length(target$idx) == 3,
all(target$idx == c(1, 3, 5)),
all(target$exists == c(FALSE, TRUE, FALSE)))
target <- parse_env_subset(x["a", ], substitute = TRUE)
str(target)
stopifnot(identical(target$envir, x), length(target$idx) == 3,
all(target$idx == c(1, 3, 5)),
all(target$exists == c(FALSE, TRUE, FALSE)))
target <- parse_env_subset(x["a", -1], substitute = TRUE)
str(target)
stopifnot(identical(target$envir, x), length(target$idx) == 2,
all(target$idx == c(3, 5)),
all(target$exists == c(TRUE, FALSE)))
message("*** parse_env_subset() on multi-dim listenv ... DONE")
## - - - - - - - - - - - - - - - - - - - - - - - - - -
## Exception handling
## - - - - - - - - - - - - - - - - - - - - - - - - - -
message("*** parse_env_subset() on multi-dim listenv - exceptions ...")
x <- listenv()
## Multidimensional subsetting on 'x' without dimensions
res <- try(target <- parse_env_subset(x[[1, 2]], substitute = TRUE),
silent = TRUE)
stopifnot(inherits(res, "try-error"))
## Multi-dimensional subsetting
x <- listenv()
length(x) <- 6
dim(x) <- c(2, 3)
## - - - - - - - - - - - - - - - - - - - - - - - - - - -
## FIXME: Should zero indices give parse errors or not?
## - - - - - - - - - - - - - - - - - - - - - - - - - - -
res <- try(target <- parse_env_subset(x[[0]], substitute = TRUE), silent = TRUE)
## stopifnot(inherits(res, "try-error"))
res <- try(target <- parse_env_subset(x[[1, 0]], substitute = TRUE),
silent = TRUE)
## stopifnot(inherits(res, "try-error"))
res <- try(target <- parse_env_subset(x[[1, 2, 3]], substitute = TRUE),
silent = TRUE)
## stopifnot(inherits(res, "try-error"))
message("*** parse_env_subset() on multi-dim listenv - exceptions ... DONE")
## Cleanup
rm(list = setdiff(ls(envir = globalenv()), ovars), envir = globalenv())
|
