diff --git a/NEWS.md b/NEWS.md index 3a1036e651..6246080291 100644 --- a/NEWS.md +++ b/NEWS.md @@ -10,6 +10,8 @@ 1. `rbindlist()` of a malformed factor missing levels attribute is now a helpful error rather than a cryptic error about `STRING_ELT`, [#3315](https://github.com/Rdatatable/data.table/issues/3315). Thanks to Michael Chirico for reporting. +2. Forgetting `type=` in `shift(val, "lead")` would segfault, [#3354](https://github.com/Rdatatable/data.table/issues/3354). A helpful error is now produced to indicate `"lead"` is being passed to `n=` rather than the intended `type=` argument. Thanks to @SymbolixAU for reporting. + #### NOTES 1. When upgrading to 1.12.0 some Windows users might have seen `CdllVersion not found` in some circumstances. We found a way to catch that so the [helpful message](https://twitter.com/MattDowle/status/1084528873549705217) now occurs for those upgrading from versions prior to 1.12.0 too, as well as those upgrading from 1.12.0 to a later version. See item 1 in notes section of 1.12.0 below for more background. diff --git a/R/shift.R b/R/shift.R index 7f8595c755..4f6e7bdc70 100644 --- a/R/shift.R +++ b/R/shift.R @@ -1,5 +1,6 @@ shift <- function(x, n=1L, fill=NA, type=c("lag", "lead", "shift"), give.names=FALSE) { type = match.arg(type) + stopifnot(is.numeric(n)) ans = .Call(Cshift, x, as.integer(n), fill, type) if (give.names && is.list(ans)) { if (is.null(names(x))) { diff --git a/inst/tests/tests.Rraw b/inst/tests/tests.Rraw index 097ab1ec4b..9db1c0dbcb 100644 --- a/inst/tests/tests.Rraw +++ b/inst/tests/tests.Rraw @@ -13304,6 +13304,11 @@ test(1979, DT[,.(a,b,if(FALSE)c)], DT[,c("a","b")]) x <- as.array(1:5) test(1980, names(data.table(x)), "x") +# this was crashing RStudio #3354 +DT = data.table( id = 1:5 , val = letters[1:5] ) +test(1981.1, DT[, new_col := shift(val, "lead")], error="is.numeric(n) is not TRUE") +test(1981.2, DT[, new_col := shift(val, NA_integer_)], error="Item 1 of n is NA") + ################################### # Add new tests above this line # diff --git a/src/shift.c b/src/shift.c index 5083ccd5a4..da7555f7b9 100644 --- a/src/shift.c +++ b/src/shift.c @@ -5,7 +5,7 @@ SEXP shift(SEXP obj, SEXP k, SEXP fill, SEXP type) { size_t size; - R_len_t i=0, j, m, nx, nk, xrows, thisk, protecti=0; + int protecti=0; SEXP x, tmp=R_NilValue, elem, ans, thisfill, klass; unsigned long long *dthisfill; enum {LAG, LEAD/*, SHIFT, CYCLIC*/} stype = LAG; // currently SHIFT maps to LAG and CYCLIC is unimplemented (see comments in #1708) @@ -16,40 +16,40 @@ SEXP shift(SEXP obj, SEXP k, SEXP fill, SEXP type) { } else x = obj; if (!isNewList(x)) error("x must be a list, data.frame or data.table"); - if (!isInteger(k)) - error("Internal error: n must be integer"); // # nocov if (length(fill) != 1) error("fill must be a vector of length 1"); // the following two errors should be caught by match.arg() at the R level if (!isString(type) || length(type) != 1) error("Internal error: invalid type for shift(), should have been caught before. please report to data.table issue tracker"); // # nocov - if (!strcmp(CHAR(STRING_ELT(type, 0)), "lag")) stype = LAG; else if (!strcmp(CHAR(STRING_ELT(type, 0)), "lead")) stype = LEAD; else if (!strcmp(CHAR(STRING_ELT(type, 0)), "shift")) stype = LAG; // when we get rid of nested if branches we can use SHIFT, for now it maps to LAG else error("Internal error: invalid type for shift(), should have been caught before. please report to data.table issue tracker"); // # nocov - nx = length(x); nk = length(k); + int nx = length(x), nk = length(k); + if (!isInteger(k)) error("Internal error: k must be integer"); // # nocov + const int *kd = INTEGER(k); + for (int i=0; i= 0) ? INTEGER(k)[j] : -INTEGER(k)[j]; + for (int j=0; j= 0) ? kd[j] : -kd[j]; thisk = (xrows >= thisk) ? thisk : xrows; SET_VECTOR_ELT(ans, i*nk+j, tmp=allocVector(INTSXP, xrows) ); // LAG when type = 'lag' and n >= 0 _or_ type = 'lead' and n < 0 - if ((stype == LAG && INTEGER(k)[j] >= 0) || (stype == LEAD && INTEGER(k)[j] < 0)) { + if ((stype == LAG && kd[j] >= 0) || (stype == LEAD && kd[j] < 0)) { if (xrows - thisk > 0) memmove((char *)DATAPTR(tmp)+(thisk*size), (char *)DATAPTR(elem), (xrows-thisk)*size); - for (m=0; m=0 _or_ type = 'lag', n<0 } else { @@ -57,7 +57,7 @@ SEXP shift(SEXP obj, SEXP k, SEXP fill, SEXP type) { memmove((char *)DATAPTR(tmp), (char *)DATAPTR(elem)+(thisk*size), (xrows-thisk)*size); - for (m=xrows-thisk; m= 0) ? INTEGER(k)[j] : -INTEGER(k)[j]; - thisk = (xrows >= INTEGER(k)[j]) ? INTEGER(k)[j] : xrows; + for (int j=0; j= 0) ? kd[j] : -kd[j]; + thisk = (xrows >= kd[j]) ? kd[j] : xrows; SET_VECTOR_ELT(ans, i*nk+j, tmp=allocVector(REALSXP, xrows) ); - if ((stype == LAG && INTEGER(k)[j] >= 0) || (stype == LEAD && INTEGER(k)[j] < 0)) { + if ((stype == LAG && kd[j] >= 0) || (stype == LEAD && kd[j] < 0)) { if (xrows - thisk > 0) { memmove((char *)DATAPTR(tmp)+(thisk*size), (char *)DATAPTR(elem), (xrows-thisk)*size); } - for (m=0; m= 0) ? INTEGER(k)[j] : -INTEGER(k)[j]; + for (int j=0; j= 0) ? kd[j] : -kd[j]; thisk = (xrows >= thisk) ? thisk : xrows; SET_VECTOR_ELT(ans, i*nk+j, tmp=allocVector(LGLSXP, xrows) ); - if ((stype == LAG && INTEGER(k)[j] >= 0) || (stype == LEAD && INTEGER(k)[j] < 0)) { + if ((stype == LAG && kd[j] >= 0) || (stype == LEAD && kd[j] < 0)) { if (xrows - thisk > 0) memmove((char *)DATAPTR(tmp)+(thisk*size), (char *)DATAPTR(elem), (xrows-thisk)*size); - for (m=0; m 0) memmove((char *)DATAPTR(tmp), (char *)DATAPTR(elem)+(thisk*size), (xrows-thisk)*size); - for (m=xrows-thisk; m= 0) ? INTEGER(k)[j] : -INTEGER(k)[j]; - if ((stype == LAG && INTEGER(k)[j] >= 0) || (stype == LEAD && INTEGER(k)[j] < 0)) { - for (m=0; m= 0) ? kd[j] : -kd[j]; + if ((stype == LAG && kd[j] >= 0) || (stype == LEAD && kd[j] < 0)) { + for (int m=0; m= 0) ? INTEGER(k)[j] : -INTEGER(k)[j]; - if ((stype == LAG && INTEGER(k)[j] >= 0) || (stype == LEAD && INTEGER(k)[j] < 0)) { - for (m=0; m= 0) ? kd[j] : -kd[j]; + if ((stype == LAG && kd[j] >= 0) || (stype == LEAD && kd[j] < 0)) { + for (int m=0; m