THIS IS A TEST INSTANCE ONLY! REPOSITORIES CAN BE DELETED AT ANY TIME!

Browse Source

Made several error messages more informative. The downside is that

those messages are no longer aligned with built-in R error message which
means that they are also not translated.
feature/c
Henrik Bengtsson 2 years ago
parent
commit
ccf2363790
  1. 8
      NEWS
  2. 2
      R/get_variable.R
  3. 4
      R/listenv,dims.R
  4. 45
      R/listenv.R
  5. 34
      R/parse_env_subset.R

8
NEWS

@ -1,8 +1,14 @@
Package: listenv
================
Version: 0.7.0-9000 [2018-10-11]
Version: 0.7.0-9000 [2018-10-12]
NEW FEATURES:
* Made several error messages more informative. The downside is that
those messages are no longer aligned with built-in R error message which
means that they are also not translated.
BUG FIXES:
* parse_env_subset(x[1, names]) on a listenv 'x' matrix would throw error

2
R/get_variable.R

@ -39,7 +39,7 @@ get_variable.listenv <- function(x, name, mustExist = FALSE,
if (length(name) > 1L) {
stop_if_not(is.numeric(name))
idxs <- name
if (anyNA(idxs)) stop("Unknown index detected")
if (anyNA(idxs)) stop("Unknown (NA) index detected")
for (kk in seq_len(ndim)) {
if (idxs[kk] < 1 || idxs[kk] > dim[kk]) {

4
R/listenv,dims.R

@ -12,7 +12,7 @@ dim.listenv <- function(x) attr(x, "dim.", exact = TRUE)
if (n == 0) {
length(x) <- p
} else {
stopf("dims [product %d] do not match the length of object [%d]", p, n)
stopf("Cannot set dimension to c(%s) because its length do not match the length of the object: %d != %s", paste(value, collapse = ", "), p, n)
}
}
names(value) <- names
@ -78,7 +78,7 @@ dimnames.listenv <- function(x) attr(x, "dimnames.", exact = TRUE)
if (is.null(names)) next
n <- length(names)
if (n != dim[kk]) {
stopf("length of 'dimnames' [%d] not equal to array extent", kk)
stopf("Length of 'dimnames' for dimension #%d not equal to array extent: %d != %d", kk, n, dim[kk])
}
}
attr(x, "dimnames.") <- value

45
R/listenv.R

@ -216,7 +216,7 @@ if (!exists("lengths", mode = "function")) {
n <- length(map)
value <- as.numeric(value)
if (value < 0) stop("invalid value")
if (value < 0) stop("Cannot set a negative length")
## Nothing to do?
if (value == n) return(invisible(x))
@ -257,12 +257,9 @@ names.listenv <- function(x) {
map <- mapping(x)
if (is.null(value)) {
} else if (length(value) != length(map)) {
stopf("Number of names does not match the number of elements: %s != %s",
stopf("The number of names does not match the number of elements: %s != %s",
length(value), length(map))
}
## if (any(duplicated(value))) {
## stop("Environments cannot have duplicate names on elements")
## }
names(map) <- value
mapping(x) <- map
invisible(x)
@ -364,8 +361,8 @@ to_index <- function(x, idxs) {
dim <- dim(x)
if (is.null(dim)) dim <- length(x)
ndim <- length(dim)
if (ndim != nidxs) {
stop("incorrect number of dimensions")
if (nidxs != ndim) {
stopf("Incorrect number of dimensions: %d != %d", nidxs, ndim)
}
dimnames <- dimnames(x)
idx_dimnames <- dimnames
@ -381,19 +378,29 @@ to_index <- function(x, idxs) {
if (is.character(i)) {
name <- i
i <- match(name, table = dimnames[[kk]])
if (anyNA(i)) stop("subscript out of bounds")
if (anyNA(i)) {
unknown <- name[is.na(i)]
stopf("Unknown names for dimension #%d: %s",
kk, hpaste(sQuote(unknown)))
}
} else if (is.logical(i)) {
d <- dim[kk]
ni <- length(i)
if (ni > d) stop("(subscript) logical subscript too long")
if (ni > d) {
stopf("Logical subscript for dimension #%d too long: %d > %d",
kk, ni, d)
}
if (ni < d) i <- rep(i, length.out = d)
i <- which(i)
} else if (is.numeric(i)) {
d <- dim[kk]
if (any(i > d)) stop("subscript out of bounds")
if (any(i > d)) {
stopf("Subscript for dimension #%d out of bounds [%d,%d]",
kk, min(1, d), d)
}
if (any(i < 0)) {
if (any(i > 0)) {
stop("only 0's may be mixed with negative subscripts")
stopf("Only 0's may be mixed with negative subscripts (dimension #%d)", kk)
}
## Drop elements
i <- setdiff(seq_len(d), -i)
@ -401,7 +408,8 @@ to_index <- function(x, idxs) {
## Drop zeros
i <- i[i != 0]
} else {
stop("invalid subscript type", sQuote(typeof(i)))
stopf("Invalid subscript type for dimension #%d: %s",
kk, sQuote(typeof(i)))
}
## Subset dimnames?
@ -538,7 +546,7 @@ to_index <- function(x, idxs) {
if (any(i < 0)) {
stop_if_not(is.null(dim(i)))
if (any(i > 0)) {
stop("only 0's may be mixed with negative subscripts")
stop("Only 0's may be mixed with negative subscripts")
}
## Drop elements
i <- setdiff(seq_len(nmap), -i)
@ -628,9 +636,9 @@ assign_by_name <- function(x, name, value) {
stop("Cannot assign value. Zero-length name.", call. = FALSE)
} else if (length(name) > 1L) {
stop("Cannot assign value. More than one name specified: ",
hpaste(name), call. = FALSE)
hpaste(sQuote(name)), call. = FALSE)
} else if (nchar(name) == 0L) {
stop("Cannot assign value. Empty name specific: ", name, call. = FALSE)
stop("Cannot assign value. Empty name specific: ", sQuote(name), call. = FALSE)
}
map <- mapping(x)
@ -709,10 +717,11 @@ remove_by_name <- function(x, name) {
if (length(name) == 0L) {
stop("Cannot remove element. Zero-length name.", call. = FALSE)
} else if (length(name) > 1L) {
stop("Cannot remove element. More than one name specified: ", hpaste(name),
call. = FALSE)
stop("Cannot remove element. More than one name specified: ",
hpaste(sQuote(name)), call. = FALSE)
} else if (nchar(name) == 0L) {
stop("Cannot remove element. Empty name specific: ", name, call. = FALSE)
stop("Cannot remove element. Empty name specific: ",
sQuote(name), call. = FALSE)
}
map <- mapping(x)

34
R/parse_env_subset.R

@ -135,17 +135,17 @@ parse_env_subset <- function(expr, envir = parent.frame(), substitute = TRUE) {
subset_kk <- subset[[kk]]
if (is.null(subset_kk)) {
} else if (any(is.na(subset_kk))) {
stopf("Invalid subsetting. Subset must not contain missing values: %s",
sQuote(code), call. = FALSE)
stopf("Invalid subsetting for dimension #%d. Subset must not contain missing values: %s",
kk, sQuote(code), call. = FALSE)
} else if (is.character(subset_kk)) {
if (!all(nzchar(subset_kk))) {
stopf("Invalid subset. Subset must not contain empty names: %s",
sQuote(code), call. = FALSE)
stopf("Invalid subset for dimension #%d. Subset must not contain empty names: %s",
kk, sQuote(code), call. = FALSE)
}
} else if (is.numeric(subset_kk)) {
} else {
stopf("Invalid subset of type %s: %s", sQuote(typeof(subset_kk)),
sQuote(code), call. = FALSE)
stopf("Invalid subset for dimension #%d of type %s: %s",
kk, sQuote(typeof(subset_kk)), sQuote(code), call. = FALSE)
}
} # for (kk ...)
@ -175,8 +175,10 @@ parse_env_subset <- function(expr, envir = parent.frame(), substitute = TRUE) {
subset[[kk]] <- seq_len(dim[kk])
} else if (is.character(subset_kk)) {
subset_kk <- match(subset_kk, dimnames[[kk]])
if (any(is.na(subset_kk))) {
stop("subscript out of bounds")
if (anyNA(subset_kk)) {
unknown <- name[is.na(subset_kk)]
stopf("Unknown names for dimension #%d: %s",
kk, hpaste(sQuote(unknown)))
}
subset[[kk]] <- subset_kk
}
@ -192,9 +194,10 @@ parse_env_subset <- function(expr, envir = parent.frame(), substitute = TRUE) {
d <- dim[kk]
if (any(i < 0)) {
if (op == "[[") {
stop("Invalid (negative) indices: ", hpaste(i))
stopf("Invalid (negative) indices for dimension #%d: %s",
kk, hpaste(i))
} else if (any(i > 0)) {
stop("only 0's may be mixed with negative subscripts")
stopf("Only 0's may be mixed with negative subscripts (dimension #%d)", kk)
}
## Drop elements
i <- setdiff(seq_len(d), -i)
@ -220,8 +223,7 @@ parse_env_subset <- function(expr, envir = parent.frame(), substitute = TRUE) {
if (is.numeric(subset_kk)) {
exists <- exists & (subset_kk >= 1 & subset_kk <= dim[kk])
} else {
stop("Internal error: Subset should already be an index: ",
mode(subset_kk))
stopf("INTERNAL ERROR: Subset for dimension #%d should already be an index: ", kk, mode(subset_kk))
}
}
stop_if_not(length(exists) == length(idx))
@ -236,7 +238,7 @@ parse_env_subset <- function(expr, envir = parent.frame(), substitute = TRUE) {
if (op == "[[") {
stop("Invalid (negative) indices: ", hpaste(i))
} else if (any(i > 0)) {
stop("only 0's may be mixed with negative subscripts")
stop("Only 0's may be mixed with negative subscripts")
}
## Drop elements
i <- setdiff(seq_len(n), -i)
@ -264,10 +266,12 @@ parse_env_subset <- function(expr, envir = parent.frame(), substitute = TRUE) {
}
subset <- subset[[1L]]
if (length(subset) > 1L) {
stop("wrong arguments for subsetting an environment", call. = TRUE)
stopf("Wrong arguments for subsetting an environment: %s",
sQuote(code), call. = TRUE)
}
if (!is.character(subset)) {
stop("wrong arguments for subsetting an environment", call. = TRUE)
stopf("Wrong arguments for subsetting an environment: %s",
sQuote(code), call. = TRUE)
}
}

Loading…
Cancel
Save