1library("listenv")
2
3ovars <- ls(envir = globalenv())
4if (exists("x")) rm(list = "x")
5if (exists("y")) rm(list = "y")
6
7## - - - - - - - - - - - - - - - - - - - - - - - - - -
8## Multi-dimensional subsetting
9## - - - - - - - - - - - - - - - - - - - - - - - - - -
10message("*** parse_env_subset() on multi-dim listenv ...")
11
12x <- listenv()
13length(x) <- 6
14dim(x) <- c(2, 3)
15
16target <- parse_env_subset(x[2], substitute = TRUE)
17str(target)
18stopifnot(identical(target$envir, x), target$idx  == 2, !target$exists)
19
20target <- parse_env_subset(x[[2]], substitute = TRUE)
21str(target)
22stopifnot(identical(target$envir, x), target$idx  == 2, !target$exists)
23
24target <- parse_env_subset(x[1, 2], substitute = TRUE)
25str(target)
26stopifnot(identical(target$envir, x), target$idx == 3, !target$exists)
27
28target <- parse_env_subset(x[[1, 2]], substitute = TRUE)
29str(target)
30stopifnot(identical(target$envir, x), target$idx == 3, !target$exists)
31
32x[[1, 2]] <- 1.2
33target <- parse_env_subset(x[1, 2], substitute = TRUE)
34str(target)
35stopifnot(identical(target$envir, x), target$idx == 3, target$exists)
36
37target <- parse_env_subset(x[[1, 2]], substitute = TRUE)
38str(target)
39stopifnot(identical(target$envir, x), target$idx == 3, target$exists)
40
41target <- parse_env_subset(x[1, 4], substitute = TRUE)
42str(target)
43stopifnot(identical(target$envir, x), is.na(target$idx), !target$exists)
44
45target <- parse_env_subset(x[[1, 4]], substitute = TRUE)
46str(target)
47stopifnot(identical(target$envir, x), is.na(target$idx), !target$exists)
48
49target <- parse_env_subset(x[1, 1:2], substitute = TRUE)
50str(target)
51stopifnot(identical(target$envir, x),
52          length(target$idx) == 2L, all(target$idx == c(1,3)),
53	  length(target$exists) == 2L, all(target$exists == c(FALSE, TRUE)))
54
55target <- parse_env_subset(x[1, -3], substitute = TRUE)
56str(target)
57stopifnot(identical(target$envir, x),
58          length(target$idx) == 2L, all(target$idx == c(1,3)),
59	  length(target$exists) == 2L, all(target$exists == c(FALSE, TRUE)))
60
61## Assert that x[[1, 4]] is not the same as x[[c(1, 4)]]
62target <- parse_env_subset(x[[1, 4]], substitute = TRUE)
63str(target)
64target2 <- parse_env_subset(x[[c(1, 4)]], substitute = TRUE)
65str(target2)
66target$code <- target2$code <- NULL
67stopifnot(!isTRUE(all.equal(target2, target)))
68
69
70dimnames(x) <- list(c("a", "b"), c("A", "B", "C"))
71print(x)
72
73target <- parse_env_subset(x[["a", 2]], substitute = TRUE)
74str(target)
75stopifnot(identical(target$envir, x), target$idx == 3, target$exists)
76
77target <- parse_env_subset(x[["a", "B"]], substitute = TRUE)
78str(target)
79stopifnot(identical(target$envir, x), target$idx == 3, target$exists)
80
81target <- parse_env_subset(x["a", "B"], substitute = TRUE)
82str(target)
83stopifnot(identical(target$envir, x), target$idx == 3, target$exists)
84
85target <- parse_env_subset(x["a", 1:3], substitute = TRUE)
86str(target)
87stopifnot(identical(target$envir, x), length(target$idx) == 3,
88          all(target$idx == c(1, 3, 5)),
89          all(target$exists == c(FALSE, TRUE, FALSE)))
90
91target <- parse_env_subset(x["a", ], substitute = TRUE)
92str(target)
93stopifnot(identical(target$envir, x), length(target$idx) == 3,
94          all(target$idx == c(1, 3, 5)),
95          all(target$exists == c(FALSE, TRUE, FALSE)))
96
97target <- parse_env_subset(x["a", -1], substitute = TRUE)
98str(target)
99stopifnot(identical(target$envir, x), length(target$idx) == 2,
100          all(target$idx == c(3, 5)),
101          all(target$exists == c(TRUE, FALSE)))
102
103message("*** parse_env_subset() on multi-dim listenv ... DONE")
104
105
106## - - - - - - - - - - - - - - - - - - - - - - - - - -
107## Exception handling
108## - - - - - - - - - - - - - - - - - - - - - - - - - -
109message("*** parse_env_subset() on multi-dim listenv - exceptions ...")
110
111x <- listenv()
112
113## Multidimensional subsetting on 'x' without dimensions
114res <- try(target <- parse_env_subset(x[[1, 2]], substitute = TRUE),
115           silent = TRUE)
116stopifnot(inherits(res, "try-error"))
117
118## Multi-dimensional subsetting
119x <- listenv()
120length(x) <- 6
121dim(x) <- c(2, 3)
122
123
124## - - - - - - - - - - - - - - - - - - - - - - - - - - -
125## FIXME: Should zero indices give parse errors or not?
126## - - - - - - - - - - - - - - - - - - - - - - - - - - -
127res <- try(target <- parse_env_subset(x[[0]], substitute = TRUE), silent = TRUE)
128## stopifnot(inherits(res, "try-error"))
129
130res <- try(target <- parse_env_subset(x[[1, 0]], substitute = TRUE),
131           silent = TRUE)
132## stopifnot(inherits(res, "try-error"))
133
134res <- try(target <- parse_env_subset(x[[1, 2, 3]], substitute = TRUE),
135           silent = TRUE)
136## stopifnot(inherits(res, "try-error"))
137
138message("*** parse_env_subset() on multi-dim listenv - exceptions ... DONE")
139
140
141## Cleanup
142rm(list = setdiff(ls(envir = globalenv()), ovars), envir = globalenv())
143