library("listenv") ovars <- ls(envir = globalenv()) oopts <- options(warn = 1) with_r_330 <- function(expr) { if (getRversion() < "3.3.0") return() eval(substitute(expr), envir = parent.frame(), enclos = baseenv()) } ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ## Allocation ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - x <- listenv() print(x) stopifnot(length(x) == 0) stopifnot(is.null(names(x))) with_r_330({ stopifnot(identical(lengths(x), integer(0L))) }) ## Named, empty list environment x <- listenv() names(x) <- character(0L) print(x) x <- listenv(a = 1) print(x) stopifnot(length(x) == 1) stopifnot(identical(names(x), c("a"))) stopifnot(identical(x$a, 1)) with_r_330({ stopifnot(identical(lengths(x), c(a = 1L))) }) x <- listenv(a = 1, b = 2:3) print(x) stopifnot(length(x) == 2) stopifnot(identical(names(x), c("a", "b"))) stopifnot(identical(x$a, 1), identical(x$b, 2:3)) with_r_330({ stopifnot(identical(lengths(x), c(a = 1L, b = 2L))) stopifnot(identical(lengths(x, use.names = FALSE), c(1L, 2L))) }) x <- listenv(b = 2:3, .a = 1) print(x) stopifnot(length(x) == 2) stopifnot(identical(names(x), c("b", ".a"))) stopifnot(identical(x$.a, 1), identical(x$b, 2:3)) with_r_330({ stopifnot(identical(lengths(x), c(b = 2L, .a = 1L))) }) x <- listenv(length = 3, a = 1) print(x) stopifnot(length(x) == 2) stopifnot(identical(names(x), c("length", "a"))) stopifnot(identical(x$length, 3), identical(x$a, 1)) with_r_330({ stopifnot(identical(lengths(x), c(length = 1L, a = 1L))) }) ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ## Single-element assignments and subsetting ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - x <- listenv() print(x) print(length(x)) print(names(x)) stopifnot(length(x) == 0) x$a <- 1 print(x) print(length(x)) print(names(x)) stopifnot(length(x) == 1) stopifnot(identical(names(x), c("a"))) stopifnot(identical(x$a, 1), is.null(x$b)) x$b <- 2 print(x) print(length(x)) print(names(x)) stopifnot(length(x) == 2) stopifnot(identical(names(x), c("a", "b"))) stopifnot(identical(x$b, 2)) x$a <- 0 print(x) print(length(x)) print(names(x)) stopifnot(length(x) == 2) stopifnot(identical(names(x), c("a", "b"))) stopifnot(identical(x[["a"]], 0)) x$"a" <- 1 print(x) print(length(x)) print(names(x)) stopifnot(length(x) == 2) stopifnot(identical(names(x), c("a", "b"))) stopifnot(identical(x$a, 1)) with_r_330({ stopifnot(identical(lengths(x), c(a = 1L, b = 1L))) }) x[["a"]] <- 0 print(x) print(length(x)) print(names(x)) stopifnot(length(x) == 2) stopifnot(identical(names(x), c("a", "b"))) key <- "b" x[[key]] <- 3 print(length(x)) print(names(x)) stopifnot(length(x) == 2) stopifnot(identical(names(x), c("a", "b"))) stopifnot(identical(x$b, 3), identical(x[["b"]], 3), identical(x[[key]], 3)) x[[3]] <- 3.14 print(x) print(length(x)) print(names(x)) stopifnot(length(x) == 3) stopifnot(identical(names(x), c("a", "b", ""))) stopifnot(identical(x[[3]], 3.14)) names(x) <- c("a", "b", "c") stopifnot(length(x) == 3) stopifnot(identical(names(x), c("a", "b", "c"))) stopifnot(identical(x[[3]], 3.14), identical(x[["c"]], 3.14), identical(x$c, 3.14)) with_r_330({ stopifnot(identical(lengths(x), c(a = 1L, b = 1L, c = 1L))) }) ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ## Multi-element subsetting ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ## Assert than no false names are introduced x <- listenv() x[1:3] <- list(1, NULL, 3) print(x) stopifnot(is.null(names(x))) with_r_330({ stopifnot(identical(lengths(x), c(1L, 0L, 1L))) }) y <- x[] print(y) stopifnot(length(y) == length(x)) stopifnot(all.equal(y, x)) stopifnot(!identical(y, x)) stopifnot(is.null(names(y))) with_r_330({ stopifnot(identical(lengths(y), c(1L, 0L, 1L))) }) y <- x[1] print(y) stopifnot(is.null(names(y))) y <- x[2:3] print(y) stopifnot(is.null(names(y))) with_r_330({ stopifnot(identical(lengths(y), c(0L, 1L))) }) y <- x[-1] print(y) stopifnot(is.null(names(y))) with_r_330({ stopifnot(identical(lengths(y), c(0L, 1L))) }) x[c("c", ".a", "b")] <- list(NULL, 3, 1) print(x) stopifnot(identical(names(x), c("", "", "", "c", ".a", "b"))) with_r_330({ stopifnot(identical(lengths(x), c(1L, 0L, 1L, c = 0L, .a = 1L, b = 1L))) }) y <- as.list(x) str(y) stopifnot(identical(names(y), c("", "", "", "c", ".a", "b"))) y <- as.list(x, all.names = FALSE) str(y) stopifnot(identical(names(y), c("", "", "", "c", "b"))) y <- as.list(x, sorted = TRUE) str(y) stopifnot(identical(names(y), c("", "", "", ".a", "b", "c"))) y <- as.list(x, all.names = FALSE, sorted = TRUE) str(y) stopifnot(identical(names(y), c("", "", "", "b", "c"))) x <- listenv() x[c("a", "b", "c")] <- list(1, NULL, 3) y <- x[NULL] print(y) z <- as.list(y) print(z) stopifnot(identical(z, list())) y <- x[integer(0L)] print(y) z <- as.list(y) print(z) stopifnot(identical(z, list())) y <- x["a"] print(y) z <- as.list(y) print(z) stopifnot(identical(z, list(a = 1))) y <- x[c("a", "c")] print(y) z <- as.list(y) print(z) stopifnot(identical(z, list(a = 1, c = 3))) y <- x[c("c", "a")] print(y) z <- as.list(y) print(z) stopifnot(identical(z, list(c = 3, a = 1))) y <- x[c(1, 3)] print(y) z <- as.list(y) print(z) stopifnot(identical(z, list(a = 1, c = 3))) y <- x[-2] print(y) z <- as.list(y) print(z) stopifnot(identical(z, list(a = 1, c = 3))) y <- x[-c(1, 3)] print(y) z <- as.list(y) print(z) stopifnot(identical(z, list(b = NULL))) y <- x[rep(1L, times = 6L)] print(y) z <- as.list(y) print(z) stopifnot(identical(z, rep(list(a = 1), times = 6L))) y <- x[1:10] print(y) z <- as.list(y) print(z) stopifnot(identical(z, c(as.list(x), rep(list(NULL), times = 7L)))) y <- x[c(TRUE, FALSE, TRUE)] print(y) z <- as.list(y) print(z) stopifnot(identical(z, list(a = 1, c = 3))) y <- x[c(TRUE, FALSE)] print(y) z <- as.list(y) print(z) stopifnot(identical(z, list(a = 1, c = 3))) y <- x[TRUE] print(y) z <- as.list(y) print(z) stopifnot(identical(z, as.list(x))) y <- x[FALSE] print(y) z <- as.list(y) print(z) stopifnot(identical(z, list())) y <- x[rep(TRUE, times = 5L)] print(y) z <- as.list(y) print(z) stopifnot(identical(z, c(as.list(x), list(NULL), list(NULL)))) with_r_330({ stopifnot(identical(lengths(z), c(a = 1L, b = 0L, c = 1L, 0L, 0L))) }) ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ## Local access ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - x <- listenv(a = 1, b = 2, c = 3.14) y <- local({ x[[3]] }) stopifnot(identical(y, 3.14)) y <- local({ x[3] }) stopifnot(identical(y[[1]], 3.14)) y <- local({ ii <- 3 x[[ii]] }) stopifnot(identical(y, 3.14)) y <- local({ ii <- 3 x[ii] }) stopifnot(identical(y[[1]], 3.14)) local({ x[[3]] <- 42L }) y <- x[[3]] stopifnot(identical(y, 42L)) local({ x[3] <- 3.14 }) y <- x[[3]] stopifnot(identical(y, 3.14)) local({ ii <- 3 x[ii] <- 42L }) y <- x[[3]] stopifnot(identical(y, 42L)) local({ ii <- 3 x[[ii]] <- 3.14 }) y <- x[[3]] stopifnot(identical(y, 3.14)) ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ## Removing elements ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - x[["a"]] <- NULL print(x) print(length(x)) print(names(x)) stopifnot(length(x) == 2) stopifnot(identical(names(x), c("b", "c"))) x[[3L]] <- NULL print(x) print(length(x)) print(names(x)) stopifnot(length(x) == 2) stopifnot(identical(names(x), c("b", "c"))) x[[2L]] <- NULL print(x) print(length(x)) print(names(x)) stopifnot(length(x) == 1) stopifnot(identical(names(x), c("b"))) x$b <- NULL print(x) print(length(x)) print(names(x)) stopifnot(length(x) == 0) ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ## Assigning NULL ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - x[2L] <- list(NULL) print(x) print(length(x)) print(names(x)) stopifnot(length(x) == 2) stopifnot(identical(names(x), c("", ""))) x["c"] <- list(NULL) print(x) print(length(x)) print(names(x)) stopifnot(length(x) == 3) stopifnot(identical(names(x), c("", "", "c"))) ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ## Assigning multiple elements at once ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - x <- listenv() x[c("a", "b", "c")] <- 1:3 print(x) str(as.list(x)) print(length(x)) print(names(x)) stopifnot(length(x) == 3) stopifnot(identical(names(x), c("a", "b", "c"))) stopifnot(identical(as.list(x), list(a = 1L, b = 2L, c = 3L))) stopifnot(identical(unlist(x), c(a = 1L, b = 2L, c = 3L))) x[] <- 3:1 stopifnot(length(x) == 3) stopifnot(identical(names(x), c("a", "b", "c"))) stopifnot(identical(as.list(x), list(a = 3L, b = 2L, c = 1L))) x[c("c", "b")] <- 2:3 print(x) str(as.list(x)) print(length(x)) print(names(x)) stopifnot(length(x) == 3) stopifnot(identical(names(x), c("a", "b", "c"))) stopifnot(identical(as.list(x), list(a = 3L, b = 3L, c = 2L))) x[c("a", "c")] <- 1L print(x) str(as.list(x)) print(length(x)) print(names(x)) stopifnot(length(x) == 3) stopifnot(identical(names(x), c("a", "b", "c"))) stopifnot(identical(as.list(x), list(a = 1L, b = 3L, c = 1L))) x[c("d", "e")] <- 4:5 print(x) str(as.list(x)) print(length(x)) print(names(x)) stopifnot(length(x) == 5) stopifnot(identical(names(x), c("a", "b", "c", "d", "e"))) stopifnot(identical(as.list(x), list(a = 1L, b = 3L, c = 1L, d = 4L, e = 5L))) x <- listenv() x[c("a", "b")] <- 1:2 x[c(TRUE, FALSE)] <- 2L print(x) str(as.list(x)) print(length(x)) print(names(x)) stopifnot(length(x) == 2) stopifnot(identical(names(x), c("a", "b"))) stopifnot(identical(as.list(x), list(a = 2L, b = 2L))) x[c(TRUE)] <- 1L print(x) str(as.list(x)) print(length(x)) print(names(x)) stopifnot(length(x) == 2) stopifnot(identical(names(x), c("a", "b"))) stopifnot(identical(as.list(x), list(a = 1L, b = 1L))) x[c(TRUE, FALSE, TRUE, FALSE)] <- 3L print(x) str(as.list(x)) print(length(x)) print(names(x)) stopifnot(length(x) == 3) stopifnot(identical(names(x), c("a", "b", ""))) stopifnot(identical(as.list(x), list(a = 3L, b = 1L, 3L))) ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ## Removing multiple elements at once ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - x <- as.listenv(1:6) names(x) <- letters[seq_along(x)] y <- as.list(x) stopifnot(identical(as.list(x), y)) x[2] <- NULL y[2] <- NULL stopifnot(identical(as.list(x), y)) x[4:3] <- NULL y[4:3] <- NULL stopifnot(identical(as.list(x), y)) x[rep(2, times = 10)] <- NULL y[rep(2, times = 10)] <- NULL stopifnot(identical(as.list(x), y)) ## Erase all elements y[] <- NULL x[] <- NULL stopifnot(identical(as.list(x), y)) x <- as.listenv(1:6) names(x) <- letters[seq_along(x)] y <- as.list(x) stopifnot(identical(as.list(x), y)) # Every other by logical indexing x[c(TRUE, FALSE)] <- NULL y[c(TRUE, FALSE)] <- NULL stopifnot(identical(as.list(x), y)) x[c("b", "f")] <- NULL y[c("b", "f")] <- NULL stopifnot(identical(as.list(x), y)) ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ## Expanding ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - x <- listenv() for (ii in 1:3) { x[[ii]] <- letters[ii] print(x[[ii]]) } print(x) names(x) <- sprintf("item%d", seq_along(x)) print(x) y <- as.list(x) str(y) stopifnot(identical(names(y), c("item1", "item2", "item3"))) stopifnot(identical(y[[1]], "a"), identical(y[[2]], "b"), identical(y[[3]], "c")) x[[2]] <- "B" stopifnot(identical(x$item2, "B")) x <- listenv() x[[1]] <- { 1 } x[[3]] <- { "Hello world!" } stopifnot(length(x) == 3) stopifnot(identical(seq_along(x), seq_len(length(x)))) print(x) names(x) <- c("a", "b", "c") print(x) x$b <- TRUE stopifnot(identical(x[[1]], 1)) stopifnot(identical(x[[2]], TRUE)) stopifnot(identical(x$b, TRUE)) stopifnot(identical(x[["b"]], TRUE)) y <- as.list(x) str(y) stopifnot(length(y) == 3) ## Mixed names and indices x <- listenv() x$a <- 1 x[[3]] <- 3 print(names(x)) stopifnot(identical(names(x), c("a", "", ""))) # First element (should be named "a") var <- get_variable(x, "a") stopifnot(var == "a") var <- get_variable(x, 1) stopifnot(var == "a") # Third element (should be a temporary name) var <- get_variable(x, 3) stopifnot(var != "c") names(x) <- c("a", "b", "c") var <- get_variable(x, 3) stopifnot(var != "c") var <- get_variable(x, "c") stopifnot(var != "c") ## Second element (should become "b", because it was never used # before it was "named" "b") x$b <- 2 var <- get_variable(x, 2) stopifnot(var == "b") var <- get_variable(x, "b") stopifnot(var == "b") ## Names where as.integer(names(x)) are integers x <- listenv() x[["1"]] <- 1 x[["3"]] <- 3 print(names(x)) stopifnot(identical(names(x), c("1", "3"))) ## Expand and shrink x <- listenv() stopifnot(length(x) == 0L) length(x) <- 3L stopifnot(length(x) == 3L) stopifnot(is.null(names(x))) names(x) <- c("a", "b", "c") x$a <- 2 stopifnot(identical(x$a, 2)) x[c("a", "c")] <- c(2, 1) stopifnot(identical(x$a, 2), identical(x$c, 1)) length(x) <- 4L stopifnot(length(x) == 4L) stopifnot(identical(names(x), c("a", "b", "c", ""))) length(x) <- 1L stopifnot(length(x) == 1L) stopifnot(identical(names(x), c("a"))) stopifnot(identical(x$a, 2)) length(x) <- 0L stopifnot(length(x) == 0L) stopifnot(length(names(x)) == 0) # Actually, character(0), cf. lists ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ## Flatten ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - for (recursive in c(FALSE, TRUE)) { x <- list(); x$a <- list(B = 1:3); x$b <- list(C = 1:3, D = 4:5) y1 <- unlist(x, recursive = recursive) x <- listenv(); x$a <- list(B = 1:3); x$b <- list(C = 1:3, D = 4:5) y2 <- unlist(x, recursive = recursive) stopifnot(identical(y2, y1)) } # for (recursive ...) x <- listenv(); x$a <- list(B = 1:3); x$b <- as.listenv(list(C = 1:3, D = 4:5)) y3 <- unlist(x, recursive = TRUE) stopifnot(identical(y3, y1)) x <- listenv() y <- unlist(x) stopifnot(length(y) == 0) stopifnot(is.null(y)) ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ## Comparisons ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - x <- listenv(c = NULL, .a = 3, b = 1) print(x) ## A list environment is always equal to itself stopifnot(all.equal(x, x)) ## List environments emulate lists stopifnot(all.equal(x, list(c = NULL, .a = 3, b = 1))) stopifnot(all.equal(x, list(c = NULL, .a = 3, b = 1), sorted = TRUE)) stopifnot(all.equal(x, list(.a = 3, b = 1, c = NULL), sorted = TRUE)) stopifnot(all.equal(x, list(c = NULL, b = 1), all.names = FALSE)) stopifnot(all.equal(x, list(.a = 3, c = NULL, b = 1), all.names = FALSE)) stopifnot(all.equal(x, list(b = 1, c = NULL), all.names = FALSE, sorted = TRUE)) res <- all.equal(x, list(b = 1, c = NULL), sorted = FALSE) stopifnot(!isTRUE(res)) res <- all.equal(x, list(b = 1, c = NULL), all.names = FALSE) stopifnot(!isTRUE(res)) ## Assert listenv() -> as.list() -> as.listenv() equality y <- as.list(x) stopifnot(identical(names(y), names(x))) z <- as.listenv(y) stopifnot(identical(names(z), names(y))) stopifnot(all.equal(x, y)) ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ## Warnings ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - x <- listenv() x[1:3] <- 1:3 res <- tryCatch(x[1:2] <- 1:4, warning = function(w) { class(w) <- "try-warning" w }) stopifnot(inherits(res, "try-warning")) res <- tryCatch(x[1:3] <- 1:2, warning = function(w) { class(w) <- "try-warning" w }) stopifnot(inherits(res, "try-warning")) res <- tryCatch(x[integer(0L)] <- 1, warning = function(w) { class(w) <- "try-warning" w }) stopifnot(!inherits(res, "try-warning")) ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ## Exception handling ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - x <- listenv() length(x) <- 3L names(x) <- c("a", "b", "c") res <- try(names(x) <- c("a", "b"), silent = TRUE) stopifnot(inherits(res, "try-error")) res <- try(x[[1:2]], silent = TRUE) stopifnot(inherits(res, "try-error")) res <- try(x[[0]], silent = TRUE) stopifnot(inherits(res, "try-error")) res <- try(x[[length(x) + 1]], silent = TRUE) stopifnot(inherits(res, "try-error")) res <- try(x[[1 + 2i]], silent = TRUE) stopifnot(inherits(res, "try-error")) res <- try(x[1 + 2i], silent = TRUE) stopifnot(inherits(res, "try-error")) res <- try(x[[1 + 2i]] <- 1, silent = TRUE) stopifnot(inherits(res, "try-error")) res <- try(x[1 + 2i] <- 1, silent = TRUE) stopifnot(inherits(res, "try-error")) res <- try(x[[integer(0L)]] <- 1, silent = TRUE) stopifnot(inherits(res, "try-error")) res <- try(x[[1:2]] <- 1, silent = TRUE) stopifnot(inherits(res, "try-error")) res <- try(x[[Inf]] <- 1, silent = TRUE) stopifnot(inherits(res, "try-error")) res <- try(x[[0]] <- 1, silent = TRUE) stopifnot(inherits(res, "try-error")) res <- try(x[[-1]] <- 1, silent = TRUE) stopifnot(inherits(res, "try-error")) res <- try(x[[character(0L)]] <- 1, silent = TRUE) stopifnot(inherits(res, "try-error")) res <- try(x[[c("a", "b")]] <- 1, silent = TRUE) stopifnot(inherits(res, "try-error")) res <- try(x[[""]] <- 1, silent = TRUE) stopifnot(inherits(res, "try-error")) ## Cleanup options(oopts) rm(list = setdiff(ls(envir = globalenv()), ovars), envir = globalenv())
Generated by dwww version 1.15 on Wed May 22 22:38:22 CEST 2024.