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