diff --git a/inst/tests/tests.Rraw b/inst/tests/tests.Rraw index 80df54b6a..2dec33a23 100644 --- a/inst/tests/tests.Rraw +++ b/inst/tests/tests.Rraw @@ -85,6 +85,8 @@ if (exists("test.data.table", .GlobalEnv, inherits=FALSE)) { which.last = data.table:::which.last `-.IDate` = data.table:::`-.IDate` haszlib = data.table:::haszlib + CcopyAsGrowable = data.table:::CcopyAsGrowable + CresizeVector = data.table:::CresizeVector # Also, for functions that are masked by other packages, we need to map the data.table one. Or else, # the other package's function would be picked up. As above, we only need to do this because we desire @@ -21775,3 +21777,23 @@ test(2377.44, copy(dt)[!(a < 5 & b != "d"), .ROW := NULL], dt[1:3]) dt = data.table(a=1:3) test(2377.91, truelength(dt$a), 0L) test(2377.92, {setallocrow(dt); truelength(dt$a)}, 3L) + +# test R C API via data.table #7810 +set.seed(108) +x = rnorm(100L) +test(2378.01, length(x) == 100L && truelength(x) == 0L) +x = .Call(CcopyAsGrowable, x) +test(2378.02, length(x) == 100L && truelength(x) == 100L) +invisible(.Call(CresizeVector, x, 50L)) +test(2378.03, length(x) == 50L && truelength(x) == 100L) +invisible(.Call(CresizeVector, x, 0L)) +test(2378.04, length(x) == 0L && truelength(x) == 100L) +invisible(.Call(CresizeVector, x, 49L)) +test(2378.05, length(x) == 49L && truelength(x) == 100L) +invisible(.Call(CresizeVector, x, 51L)) +test(2378.06, length(x) == 51L && truelength(x) == 100L) +test(2378.91, .Call(CresizeVector, x, 2), error = "must be length 1 non-NA non-negative integer value") +test(2378.92, .Call(CresizeVector, x, 2:3), error = "must be length 1 non-NA non-negative integer value") +test(2378.93, .Call(CresizeVector, x, -2L), error = "must be length 1 non-NA non-negative integer value") +test(2378.94, .Call(CresizeVector, x, NA_integer_), error = "must be length 1 non-NA non-negative integer value") +test(2378.95, .Call(CresizeVector, NULL, 2L), error = "must be a vector") diff --git a/src/data.table.h b/src/data.table.h index 43dfdc5eb..dbfe495ed 100644 --- a/src/data.table.h +++ b/src/data.table.h @@ -308,6 +308,7 @@ SEXP memcpyDT(SEXP dest, SEXP src, SEXP offset, SEXP size); SEXP memcpyVectoradaptive(SEXP dest, SEXP src, SEXP offset, SEXP size); SEXP memcpyDTadaptive(SEXP dest, SEXP src, SEXP offset, SEXP size); SEXP copyAsGrowable(SEXP x); +SEXP resizeVector(SEXP x, SEXP size); // nafill.c void nafillDouble(double *x, uint_fast64_t nx, unsigned int type, double fill, bool nan_is_na, ans_t *ans, bool verbose); diff --git a/src/frollapply.c b/src/frollapply.c index e4ccf2864..d9a64f1e5 100644 --- a/src/frollapply.c +++ b/src/frollapply.c @@ -87,3 +87,14 @@ SEXP copyAsGrowable(SEXP x) { UNPROTECT(1); return ret; } + +SEXP resizeVector(SEXP x, SEXP size) { + if (!( + isInteger(size) && LENGTH(size) == 1 && INTEGER_RO(size)[0] >= 0 + )) error(_("'size' must be length 1 non-NA non-negative integer value.")); + if (!isVector(x)) + error(_("'x' must be a vector.")); + R_xlen_t newlen = INTEGER_RO(size)[0]; + R_resizeVector(x, newlen); + return x; +} diff --git a/src/init.c b/src/init.c index 5cf786d19..069223b98 100644 --- a/src/init.c +++ b/src/init.c @@ -161,6 +161,7 @@ static const R_CallMethodDef callMethods[] = { {"CmemcpyVectoradaptive", (DL_FUNC)&memcpyVectoradaptive, -1}, {"CmemcpyDTadaptive", (DL_FUNC)&memcpyDTadaptive, -1}, {"CcopyAsGrowable", (DL_FUNC)©AsGrowable, -1}, + {"CresizeVector", (DL_FUNC)&resizeVector, -1}, {"Cfrolladapt", (DL_FUNC)&frolladapt, -1}, {"Cis_direct_child", (DL_FUNC)&is_direct_child, -1}, {NULL, NULL, 0}};