Skip to content

Commit a555353

Browse files
HenrikBengtssonHenrikBengtsson
committed
TESTS: Increase test coverage
1 parent b6a5eb6 commit a555353

File tree

6 files changed

+389
-1
lines changed

6 files changed

+389
-1
lines changed

‎DESCRIPTION‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,5 @@
11
Package: listenv
2-
Version: 0.10.0-9020
2+
Version: 0.10.0-9021
33
Depends:
44
R (>= 3.1.2)
55
Suggests:

‎inst/testme/test-aperm.R‎

Lines changed: 44 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -48,3 +48,47 @@ for (ndim in 0:5) {
4848

4949
message("*** aperm() and t() ... DONE")
5050

51+
52+
message("*** aperm() and t() - exceptions ...")
53+
54+
## aperm on non-array
55+
x <- as.listenv(1:3)
56+
res <- try(aperm(x, perm = 1), silent = TRUE)
57+
stopifnot(inherits(res, "try-error"))
58+
59+
## aperm with wrong 'perm' length
60+
x <- as.listenv(1:6)
61+
dim(x) <- c(2, 3)
62+
res <- try(aperm(x, perm = 1:3), silent = TRUE)
63+
stopifnot(inherits(res, "try-error"))
64+
65+
## aperm with out-of-range 'perm'
66+
res <- try(aperm(x, perm = c(1, 3)), silent = TRUE)
67+
stopifnot(inherits(res, "try-error"))
68+
69+
## aperm with duplicated 'perm'
70+
res <- try(aperm(x, perm = c(1, 1)), silent = TRUE)
71+
stopifnot(inherits(res, "try-error"))
72+
73+
## aperm identity (no-op)
74+
x <- as.listenv(1:6)
75+
dim(x) <- c(2, 3)
76+
dimnames(x) <- list(c("r1", "r2"), c("c1", "c2", "c3"))
77+
y <- aperm(x, perm = 1:2)
78+
stopifnot(identical(as.list(y), as.list(x)))
79+
80+
81+
message("*** t.listenv - 1D array ...")
82+
x <- as.listenv(1:3)
83+
dim(x) <- 3L
84+
y <- t(x)
85+
stopifnot(identical(dim(y), c(1L, 3L)))
86+
87+
message("*** t.listenv - error for 3D array ...")
88+
x <- as.listenv(1:24)
89+
dim(x) <- c(2, 3, 4)
90+
res <- try(t(x), silent = TRUE)
91+
stopifnot(inherits(res, "try-error"))
92+
93+
message("*** aperm() and t() - exceptions ... DONE")
94+

‎inst/testme/test-get_variable.R‎

Lines changed: 52 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -95,6 +95,58 @@ stopifnot(inherits(res, "try-error"))
9595

9696

9797

98+
## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
99+
## Odds and ends
100+
## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
101+
## get_variable with 'mustExist = TRUE' on named list environment
102+
x <- listenv(a = 1, b = 2)
103+
var <- get_variable(x, "a", mustExist = TRUE)
104+
stopifnot(!is.na(var))
105+
106+
## get_variable with 'create = FALSE' on numeric index
107+
x <- listenv()
108+
length(x) <- 3L
109+
var <- get_variable(x, 2L, create = FALSE)
110+
stopifnot(!is.na(var))
111+
stopifnot(length(x) == 3L)
112+
113+
## get_variable with numeric index expanding the mapping
114+
x <- listenv()
115+
length(x) <- 2L
116+
var <- get_variable(x, 5L)
117+
stopifnot(length(x) == 5L)
118+
119+
## get_variable with named character on existing name
120+
x <- listenv(a = 1, b = 2)
121+
var <- get_variable(x, "a")
122+
stopifnot(!is.na(var))
123+
124+
## get_variable with named character creating new name
125+
x <- listenv(a = 1)
126+
var <- get_variable(x, "z")
127+
stopifnot(!is.na(var))
128+
stopifnot(length(x) == 2L)
129+
130+
131+
## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
132+
## Multi-dimensional get_variable - exceptions
133+
## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
134+
x <- as.listenv(1:6)
135+
dim(x) <- c(2, 3)
136+
137+
## Wrong number of indices
138+
res <- try(get_variable(x, c(1, 2, 3)), silent = TRUE)
139+
stopifnot(inherits(res, "try-error"))
140+
141+
## Missing values in index
142+
res <- try(get_variable(x, c(NA_integer_, 1L)), silent = TRUE)
143+
stopifnot(inherits(res, "try-error"))
144+
145+
## Out-of-range index
146+
res <- try(get_variable(x, c(3, 1)), silent = TRUE)
147+
stopifnot(inherits(res, "try-error"))
148+
149+
98150
## Cleanup
99151
options(oopts)
100152
rm(list = setdiff(ls(envir = globalenv()), ovars), envir = globalenv())

‎inst/testme/test-listenv,dimensions.R‎

Lines changed: 40 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -458,6 +458,46 @@ dim(x) <- c(2, 3)
458458
res <- try(dimnames(x) <- list(letters[1:3], letters[1:3]), silent = TRUE)
459459
stopifnot(inherits(res, "try-error"))
460460

461+
message("* Wrong number of dimensions in [ and [<- ...")
462+
x <- as.listenv(1:24)
463+
dim(x) <- c(2, 3, 4)
464+
res <- try(x[1, 2], silent = TRUE)
465+
stopifnot(inherits(res, "try-error"))
466+
res <- try(x[1, 2] <- 99, silent = TRUE)
467+
stopifnot(inherits(res, "try-error"))
468+
469+
message("* Character subscript not found ...")
470+
x <- as.listenv(1:6)
471+
dim(x) <- c(2, 3)
472+
dimnames(x) <- list(c("a", "b"), c("c", "d", "e"))
473+
res <- try(x[["z", "c"]], silent = TRUE)
474+
stopifnot(inherits(res, "try-error"))
475+
476+
message("* Invalid subscript type ...")
477+
res <- try(x[[1 + 2i, 1]], silent = TRUE)
478+
stopifnot(inherits(res, "try-error"))
479+
480+
message("* Logical subscript shorter than dimension (recycled) ...")
481+
y <- x[c(TRUE), , drop = FALSE]
482+
stopifnot(length(y) == 6)
483+
484+
message("* dim(x) <- c(2,3) on non-empty with wrong length ...")
485+
x <- as.listenv(1:4)
486+
res <- try(dim(x) <- c(2, 3), silent = TRUE)
487+
stopifnot(inherits(res, "try-error"))
488+
489+
message("* Only one dimension can be dropped at the time ...")
490+
x <- as.listenv(1:6)
491+
dim(x) <- c(2, 3)
492+
res <- try(x[1, 2] <- NULL, silent = TRUE)
493+
stopifnot(inherits(res, "try-error"))
494+
495+
message("* Removing by zero-length index has no effect ...")
496+
x <- as.listenv(1:6)
497+
dim(x) <- c(2, 3)
498+
x[integer(0), ] <- NULL
499+
stopifnot(length(x) == 6)
500+
461501
message("* List environment and multiple dimensions ... DONE")
462502

463503

‎inst/testme/test-listenv.R‎

Lines changed: 195 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -619,6 +619,10 @@ stopifnot(identical(names(x), c("1", "3")))
619619

620620

621621
## Expand and shrink
622+
x <- listenv(a = 1, b = 2)
623+
length(x) <- 2L
624+
stopifnot(length(x) == 2L)
625+
622626
x <- listenv()
623627
stopifnot(length(x) == 0L)
624628
length(x) <- 3L
@@ -780,6 +784,197 @@ res <- try(x[[""]] <- 1, silent = TRUE)
780784
stopifnot(inherits(res, "try-error"))
781785

782786

787+
## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
788+
## print() - various cases
789+
## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
790+
## print with 1 element
791+
x <- listenv(a = 1)
792+
print(x)
793+
794+
## print with no named elements
795+
x <- listenv()
796+
names(x) <- character(0L)
797+
print(x)
798+
799+
## print matrix with all dimnames
800+
x <- as.listenv(1:6)
801+
dim(x) <- c(2, 3)
802+
dimnames(x) <- list(c("r1", "r2"), c("c1", "c2", "c3"))
803+
print(x)
804+
805+
## print matrix with only row names
806+
x <- as.listenv(1:6)
807+
dim(x) <- c(2, 3)
808+
dimnames(x) <- list(c("r1", "r2"), NULL)
809+
print(x)
810+
811+
## print matrix with only column names
812+
x <- as.listenv(1:6)
813+
dim(x) <- c(2, 3)
814+
dimnames(x) <- list(NULL, c("c1", "c2", "c3"))
815+
print(x)
816+
817+
## print matrix with NULL dimnames
818+
x <- as.listenv(1:6)
819+
dim(x) <- c(2, 3)
820+
dimnames(x) <- list(NULL, NULL)
821+
print(x)
822+
823+
## print matrix with no dimnames
824+
x <- as.listenv(1:6)
825+
dim(x) <- c(2, 3)
826+
print(x)
827+
828+
## print 3d-array with all dimnames
829+
x <- as.listenv(1:24)
830+
dim(x) <- c(2, 3, 4)
831+
dimnames(x) <- list(letters[1:2], letters[1:3], letters[1:4])
832+
print(x)
833+
834+
## print 3d-array with partial dimnames
835+
x <- as.listenv(1:24)
836+
dim(x) <- c(2, 3, 4)
837+
dimnames(x) <- list(letters[1:2], NULL, letters[1:4])
838+
print(x)
839+
840+
## print 3d-array with no dimnames
841+
x <- as.listenv(1:24)
842+
dim(x) <- c(2, 3, 4)
843+
print(x)
844+
845+
## print 3d-array with NULL dimnames
846+
x <- as.listenv(1:24)
847+
dim(x) <- c(2, 3, 4)
848+
dimnames(x) <- list(NULL, NULL, NULL)
849+
print(x)
850+
851+
852+
## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
853+
## map() is defunct
854+
## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
855+
x <- listenv(a = 1, b = 2)
856+
res <- try(map(x), silent = TRUE)
857+
stopifnot(inherits(res, "try-error"))
858+
859+
860+
## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
861+
## Additional exception handling for assign/remove helpers
862+
## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
863+
x <- listenv()
864+
length(x) <- 3L
865+
names(x) <- c("a", "b", "c")
866+
867+
## remove_by_name: non-existing name
868+
x$nonexistent <- NULL
869+
870+
## remove_by_index: out of range (no-op)
871+
x[[10L]] <- NULL
872+
873+
## [<- with zero-length replacement value
874+
res <- try({ x[1:2] <- list() }, silent = TRUE)
875+
stopifnot(inherits(res, "try-error"))
876+
877+
878+
## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
879+
## all.equal.listenv - identical objects
880+
## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
881+
x <- listenv(a = 1, b = 2)
882+
stopifnot(isTRUE(all.equal(x, x)))
883+
884+
885+
## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
886+
## [[ with non-existing character name returns NULL
887+
## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
888+
x <- listenv(a = 1, b = 2)
889+
stopifnot(is.null(x[["nonexistent"]]))
890+
891+
## [[ on unassigned (NA placeholder) element returns NULL
892+
x <- listenv()
893+
length(x) <- 3L
894+
stopifnot(is.null(x[[2]]))
895+
896+
897+
## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
898+
## [.listenv and [<-.listenv dimension mismatch
899+
## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
900+
x <- as.listenv(1:6)
901+
dim(x) <- c(2, 3)
902+
903+
## [.listenv: wrong number of dimensions
904+
res <- try(x[1, 2, 3], silent = TRUE)
905+
stopifnot(inherits(res, "try-error"))
906+
907+
## [<-.listenv: wrong number of dimensions
908+
res <- try(x[1, 2, 3] <- 1, silent = TRUE)
909+
stopifnot(inherits(res, "try-error"))
910+
911+
## [<-.listenv: multi-dim NULL with wrong number of non-missing dims
912+
res <- try(x[, ] <- NULL, silent = TRUE)
913+
stopifnot(inherits(res, "try-error"))
914+
915+
## [.listenv: mixed negative and positive subscripts
916+
res <- try(x[c(-1, 1)], silent = TRUE)
917+
stopifnot(inherits(res, "try-error"))
918+
919+
920+
## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
921+
## as.listenv.environment
922+
## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
923+
e <- new.env(parent = emptyenv())
924+
e$x <- 1
925+
e$y <- 2
926+
x <- as.listenv(e)
927+
stopifnot(length(x) == 2)
928+
y <- as.list(x)
929+
stopifnot(all(sort(names(y)) == c("x", "y")))
930+
931+
932+
## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
933+
## [[ with non-existing name returns NULL
934+
## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
935+
x <- listenv(a = 1, b = 2)
936+
stopifnot(is.null(x[["nonexistent"]]))
937+
938+
## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
939+
## Negative length error
940+
## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
941+
x <- listenv()
942+
res <- try(length(x) <- -1, silent = TRUE)
943+
stopifnot(inherits(res, "try-error"))
944+
945+
946+
## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
947+
## map() is defunct
948+
## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
949+
x <- listenv(a = 1)
950+
res <- try(listenv::map(x), silent = TRUE)
951+
stopifnot(inherits(res, "try-error"))
952+
953+
## Test deprecated path of map()
954+
Sys.setenv(R_LISTENV_MAP_DEPRECATED = "deprecated")
955+
res <- withCallingHandlers(listenv::map(x), warning = function(w) {
956+
invokeRestart("muffleWarning")
957+
})
958+
stopifnot(is.character(res))
959+
Sys.unsetenv("R_LISTENV_MAP_DEPRECATED")
960+
961+
## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
962+
## Mixing positive and negative subscripts in [
963+
## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
964+
x <- listenv()
965+
x[1:3] <- 1:3
966+
res <- try(x[c(1, -1)], silent = TRUE)
967+
stopifnot(inherits(res, "try-error"))
968+
969+
## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
970+
## [<- with zero-length replacement
971+
## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
972+
x <- listenv()
973+
x[1:3] <- 1:3
974+
res <- try(x[1] <- list(), silent = TRUE)
975+
stopifnot(inherits(res, "try-error"))
976+
977+
783978
## Cleanup
784979
options(oopts)
785980
rm(list = setdiff(ls(envir = globalenv()), ovars), envir = globalenv())

0 commit comments

Comments
 (0)