Merge branch 'master' into macroRemoval

Author: badasahog

NEWS.md

@@ -44,6 +44,10 @@
 
 12. Internal functions used to signal errors are now marked as non-returning, silencing a compiler warning about potentially unchecked allocation failure. Thanks to Prof. Brian D. Ripley for the report and @aitap for the fix, [#7070](https://github.com/Rdatatable/data.table/pull/7070).
 
+13. In rare cases, `data.table` failed to expand ALTREP columns when assigning a full column by reference. This could result in the target column getting modified unintentionally if the next call to the data.table was a modification by reference of the source column. E.g. in `DT[, b := as.character(a)]` the string conversion gets deferred and subsequent modification of column `a` would also modify column `b`, [#5400](https://github.com/Rdatatable/data.table/issues/5400). Thanks to @aquasync for the report and Václav Tlapák for the PR.
+
+14. `data.table()` function is now more aligned with `data.frame()` with respect to the names of the output when one of its inputs is a single-column matrix object, [#4124](https://github.com/Rdatatable/data.table/issues/4124). Thanks @PavoDive for the report and @jangorecki for the PR.
+
 ### NOTES
 
 1. Continued work to remove non-API C functions, [#6180](https://github.com/Rdatatable/data.table/issues/6180). Thanks Ivan Krylov for the PRs and for writing a clear and concise guide about the R API: https://aitap.codeberg.page/R-api/.

R/as.data.table.R

@@ -142,7 +142,11 @@ as.data.table.list = function(x,
       xi = x[[i]] = as.POSIXct(xi)
     } else if (is.matrix(xi) || is.data.frame(xi)) {
       if (!is.data.table(xi)) {
-        xi = x[[i]] = as.data.table(xi, keep.rownames=keep.rownames)  # we will never allow a matrix to be a column; always unpack the columns
+        if (is.matrix(xi) && NCOL(xi)<=1L && is.null(colnames(xi))) { # 1 column matrix naming #4124
+          xi = x[[i]] = c(xi)
+        } else {
+          xi = x[[i]] = as.data.table(xi, keep.rownames=keep.rownames)  # we will never allow a matrix to be a column; always unpack the columns
+        }
       }
       # else avoid dispatching to as.data.table.data.table (which exists and copies)
     } else if (is.table(xi)) {

R/fread.R

@@ -70,9 +70,13 @@ yaml=FALSE, tmpdir=tempdir(), tz="UTC")
     }
   }
   if (!is.null(cmd)) {
-    (if (.Platform$OS.type == "unix") system else shell)(paste0('(', cmd, ') > ', tmpFile<-tempfile(tmpdir=tmpdir)))
-    file = tmpFile
+    tmpFile = tempfile(tmpdir=tmpdir)
     on.exit(unlink(tmpFile), add=TRUE)
+    status = (if (.Platform$OS.type == "unix") system else shell)(paste0('(', cmd, ') > ', tmpFile))
+    if (status != 0) {
+      stopf("External command failed with exit code %d. This can happen when the disk is full in the temporary directory ('%s'). See ?fread for the tmpdir argument.", status, tmpdir)
+    }
+    file = tmpFile
   }
   if (!is.null(file)) {
     if (!is.character(file) || length(file)!=1L)
@@ -116,9 +120,14 @@ yaml=FALSE, tmpdir=tempdir(), tz="UTC")
       if (!requireNamespace("R.utils", quietly = TRUE))
         stopf("To read %s files directly, fread() requires 'R.utils' package which cannot be found. Please install 'R.utils' using 'install.packages('R.utils')'.", if (w<=2L || gzsig) "gz" else "bz2") # nocov
       FUN = if (w<=2L || gzsig) gzfile else bzfile
-      R.utils::decompressFile(file, decompFile<-tempfile(tmpdir=tmpdir), ext=NULL, FUN=FUN, remove=FALSE)   # ext is not used by decompressFile when destname is supplied, but isn't optional
-      file = decompFile   # don't use 'tmpFile' symbol again, as tmpFile might be the http://domain.org/file.csv.gz download
+      decompFile = tempfile(tmpdir=tmpdir)
       on.exit(unlink(decompFile), add=TRUE)
+      tryCatch({
+        R.utils::decompressFile(file, decompFile, ext=NULL, FUN=FUN, remove=FALSE)   # ext is not used by decompressFile when destname is supplied, but isn't optional
+      }, error = function(e) {
+        stopf("R.utils::decompressFile failed to decompress file '%s':\n  %s\n. This can happen when the disk is full in the temporary directory ('%s'). See ?fread for the tmpdir argument.", file, conditionMessage(e), tmpdir)
+      })
+      file = decompFile   # don't use 'tmpFile' symbol again, as tmpFile might be the http://domain.org/file.csv.gz download
     }
     file = enc2native(file) # CfreadR cannot handle UTF-8 if that is not the native encoding, see #3078.
 

R/like.R

@@ -2,6 +2,7 @@
 # Don't use * or % like SQL's like.  Uses regexpr syntax - more powerful.
 # returns 'logical' so can be combined with other where clauses.
 like = function(vector, pattern, ignore.case = FALSE, fixed = FALSE, perl = FALSE) {
+  # TODO(R>=4.1.0): grepl itself has "smarter" logic for factor input.
   if (is.factor(vector)) {
     # indexing by factors is equivalent to indexing by the numeric codes, see ?`[` #4748
     ret = grepl(pattern, levels(vector), ignore.case = ignore.case, fixed = fixed, perl = perl)[vector]

inst/tests/tests.Rraw

@@ -2281,15 +2281,38 @@ test(753.1, DT[,c("x1","x2"):=4:6, verbose = TRUE], data.table(a=letters[1:3],x=
             output = "RHS for item 2 has been duplicated")
 test(753.2, DT[2,x2:=7L], data.table(a=letters[1:3],x=3:1,x1=4:6,x2=c(4L,7L,6L),key="a"))
 DT = data.table(a=letters[3:1],x=1:3,y=4:6)
-test(754.1, DT[,c("x1","y1","x2"):=list(x,y)], error="Supplied 3 columns to be assigned 2 items. Please see NEWS for v1.12.2")
-test(754.2, DT[,c("x1","y1","x2"):=list(x,y,x)], data.table(a=letters[3:1],x=1:3,y=4:6,x1=1:3,y1=4:6,x2=1:3))
+test(754.01, DT[,c("x1","y1","x2"):=list(x,y)], error="Supplied 3 columns to be assigned 2 items. Please see NEWS for v1.12.2")
+test(754.02, DT[,c("x1","y1","x2"):=list(x,y,x)], data.table(a=letters[3:1],x=1:3,y=4:6,x1=1:3,y1=4:6,x2=1:3))
 # And non-recycling i.e. that a single column copy does copy the column
 DT = data.table(a=1:3)
-test(754.3, DT[,b:=a][1,a:=4L][2,b:=5L], data.table(a=INT(4,2,3),b=INT(1,5,3)))
-test(754.4, DT[,b:=a][3,b:=6L], data.table(a=INT(4,2,3),b=INT(4,2,6)))
-test(754.5, DT[,a:=as.character(a),verbose=TRUE], output="Direct plonk.*no copy")
+test(754.03, DT[, b := a][1, a := 4L][2, b := 5L], data.table(a=INT(4,2,3),b=INT(1,5,3)))
+test(754.04, DT[, b := a][3, b := 6L], data.table(a=INT(4,2,3),b=INT(4,2,6)))
+test(754.05, DT[, a := as.numeric(a), verbose=TRUE], output="Direct plonk.*no copy")
 RHS = as.integer(DT$a)
-test(754.6, DT[,a:=RHS,verbose=TRUE], output="RHS for item 1 has been duplicated")
+test(754.06, DT[, a:= RHS, verbose=TRUE], output="RHS for item 1 has been duplicated")
+# Expand ALTREPS in assign.c, #5400
+# String conversion gets deferred
+## first, a regression test of R itself -- we want to make sure our own test continues to be useful & testing its intended purpose
+test(754.07, {a = 1:10; .Internal(inspect(a)); b = as.character(a); .Internal(inspect(b))}, output = "\\bcompact\\b.*\\bdeferred string conversion\\b")
+test(754.08, DT[, a := as.character(a), verbose=TRUE], output="RHS for item 1 has been duplicated")
+# Executing the code inside of test expands the ALTREP so we repeat the code
+# in order to check the result after a further assignment
+DT = data.table(a=1:3)
+DT[, b := as.character(a)]
+DT[, a := 5L]
+test(754.09, DT, data.table(a=5L, b=as.character(1:3)))
+# This function returns an ALTREP wrapper if the input is at least length 64
+testFun = function(x) {
+  x[FALSE] = 1
+  x
+}
+DT = data.table(id=1:64, col1=0, col2=0)
+test(754.10, DT[, col1 := testFun(col2), verbose = TRUE], output="RHS for item 1 has been duplicated")
+DT = data.table(id=1:64, col1=0, col2=0)
+DT[, col1 := testFun(col2)]
+DT[, col2 := 999]
+test(754.11, DT, data.table(id=1:64, col1=0, col2=999))
+rm(testFun)
 
 # Used to test warning on redundant by (#2282) but by=.EACHI has now superseded
 DT = data.table(a=letters[1:3],b=rep(c("d","e"),each=3),x=1:6,key=c('a', 'b'))
@@ -21107,16 +21130,16 @@ class(DF) = c("tbl_df", "tbl", "data.frame")
 test(2309.02, key(as.data.table(DF, key="t")), "t")
 
 # data.table keyed with "b"
-DT = data.table(a = 1:5, b = 1:5, x = 1:5, key = "b") 
-test(2309.03, key(as.data.table(DT, key="a")), "a")   
-test(2309.04, key(as.data.table(DT)), "b")            
-test(2309.05, key(as.data.table(DT, key=NULL)), NULL) 
+DT = data.table(a = 1:5, b = 1:5, x = 1:5, key = "b")
+test(2309.03, key(as.data.table(DT, key="a")), "a")
+test(2309.04, key(as.data.table(DT)), "b")
+test(2309.05, key(as.data.table(DT, key=NULL)), NULL)
 
 # non-keyed data.table
 DT = data.table(a = 1:5, b = 1:5, x = 1:5)
-test(2309.06, key(as.data.table(DT, key="a")), "a")   
-test(2309.07, key(as.data.table(DT)), NULL)          
-test(2309.08, key(as.data.table(DT, key=NULL)), NULL) 
+test(2309.06, key(as.data.table(DT, key="a")), "a")
+test(2309.07, key(as.data.table(DT)), NULL)
+test(2309.08, key(as.data.table(DT, key=NULL)), NULL)
 
 # as.data.table(x, keep.rownames=TRUE) keeps rownames for class(x)==c("*", "data.frame")
 df = structure(list(i = 1:2), class = c("tbl", "data.frame"), row.names = c("a","b"))
@@ -21192,3 +21215,25 @@ test(2319.1, !is.null(attr(dt_get, ".internal.selfref")))
 dt_get0 = data.frame(a = 1:3, b = letters[1:3])
 setDT(get0("dt_get0"))
 test(2319.2, !is.null(attr(dt_get0, ".internal.selfref")))
+
+# Improved fread error handling for cmd exe and decompression #5415
+test(2320.1, fread(cmd="false"), error="External command failed with exit code", warning = if (.Platform$OS.type=="windows") "execution failed")
+
+if (test_R.utils) local({
+  tmp <- tempfile(fileext=".gz")
+  file.create(tmp); on.exit(unlink(tmp))
+  local({
+    conn <- file(tmp, 'wb'); on.exit(close(conn))
+    writeBin(as.raw(c(31L, 139L)), conn) # Gzip header magic numbers to trigger that read path
+  })
+  test(2320.2, fread(tmp), error="R.utils::decompressFile failed to decompress", warning="invalid")
+})
+
+# Create a data.table when one vector is transposed doesn't respect the name defined by user #4124
+test(2321.1, DT <- data.table(a=1:2, b=matrix(1:2)), data.table(a=1:2, b=1:2))
+test(2321.2, names(DT), names(data.frame(a=1:2, b=matrix(1:2))))
+test(2321.3, DT <- data.table(a=integer(), b=matrix(1L, nrow=0L, ncol=1L)), data.table(a=integer(), b=integer()))
+test(2321.4, names(DT), names(data.frame(a=integer(), b=matrix(1L, nrow=0L, ncol=1L))))
+## but respect named column vectors
+test(2321.5, DT <- data.table(a=1:2, cbind(b=3:4)), data.table(a=1:2, b=3:4))
+test(2321.6, names(DT), names(data.frame(a=1:2, cbind(b=3:4))))

src/assign.c

@@ -550,11 +550,12 @@ SEXP assign(SEXP dt, SEXP rows, SEXP cols, SEXP newcolnames, SEXP values)
     if (length(rows)==0 && targetlen==vlen && (vlen>0 || nrow==0)) {
       if (  MAYBE_SHARED(thisvalue) ||  // set() protects the NAMED of atomic vectors from .Call setting arguments to 2 by wrapping with list
          (TYPEOF(values)==VECSXP && i>LENGTH(values)-1) || // recycled RHS would have columns pointing to others, #185.
-         (TYPEOF(values)!=VECSXP && i>0) // assigning the same values to a second column. Have to ensure a copy #2540
+         (TYPEOF(values)!=VECSXP && i>0) || // assigning the same values to a second column. Have to ensure a copy #2540
+         ALTREP(thisvalue) // Some ALTREP wrappers have survived to here, e.g. #5400
          ) {
         if (verbose) {
-          Rprintf(_("RHS for item %d has been duplicated because MAYBE_REFERENCED==%d MAYBE_SHARED==%d, but then is being plonked. length(values)==%d; length(cols)==%d\n"),
-                  i+1, MAYBE_REFERENCED(thisvalue), MAYBE_SHARED(thisvalue), length(values), length(cols));
+          Rprintf(_("RHS for item %d has been duplicated because MAYBE_REFERENCED==%d MAYBE_SHARED==%d ALTREP==%d, but then is being plonked. length(values)==%d; length(cols)==%d\n"),
+                  i+1, MAYBE_REFERENCED(thisvalue), MAYBE_SHARED(thisvalue), ALTREP(thisvalue), length(values), length(cols));
         }
         thisvalue = copyAsPlain(thisvalue);   // PROTECT not needed as assigned as element to protected list below.
       } else {

src/fread.c

@@ -211,19 +211,14 @@ static inline int64_t clamp_i64t(int64_t x, int64_t lower, int64_t upper) {
  * is constructed manually (using say snprintf) that warning(), stop()
  * and Rprintf() are all called as warning(_("%s"), msg) and not warning(msg).
  */
-static const char* strlim(const char *ch, size_t limit) {
-  static char buf[1002];
-  static int flip = 0;
-  char *ptr = buf + 501 * flip;
-  flip = 1 - flip;
-  char *ch2 = ptr;
-  limit = imin(limit, 500);
+static const char* strlim(const char *ch, char buf[static 500], size_t limit) {
+  char *ch2 = buf;
   size_t width = 0;
   while ((*ch > '\r' || (*ch != '\0' && *ch != '\r' && *ch != '\n')) && width++ < limit) {
     *ch2++ = *ch++;
   }
   *ch2 = '\0';
-  return ptr;
+  return buf;
 }
 
 static const char *typeLetter = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz";
@@ -1639,7 +1634,7 @@ int freadMain(freadMainArgs _args) {
   if (ch >= eof) STOP(_("Input is either empty, fully whitespace, or skip has been set after the last non-whitespace."));
   if (verbose) {
     if (lineStart > ch) DTPRINT(_("  Moved forward to first non-blank line (%d)\n"), row1line);
-    DTPRINT(_("  Positioned on line %d starting: <<%s>>\n"), row1line, strlim(lineStart, 30));
+    DTPRINT(_("  Positioned on line %d starting: <<%s>>\n"), row1line, strlim(lineStart, (char[500]) {}, 30));
   }
   ch = pos = lineStart;
   }
@@ -1830,7 +1825,7 @@ int freadMain(freadMainArgs _args) {
     if (!fill && tt != ncol) INTERNAL_STOP("first line has field count %d but expecting %d", tt, ncol); // # nocov
     if (verbose) {
       DTPRINT(_("  Detected %d columns on line %d. This line is either column names or first data row. Line starts as: <<%s>>\n"),
-              tt, row1line, strlim(pos, 30));
+              tt, row1line, strlim(pos, (char[500]) {}, 30));
       DTPRINT(_("  Quote rule picked = %d\n"), quoteRule);
       DTPRINT(_("  fill=%s and the most number of columns found is %d\n"), fill ? "true" : "false", ncol);
     }
@@ -2761,23 +2756,23 @@ int freadMain(freadMainArgs _args) {
       while (ch < eof && *ch != '\n' && *ch != '\r') ch++;
       while (ch < eof && isspace(*ch)) ch++;
       if (ch == eof) {
-        DTWARN(_("Discarded single-line footer: <<%s>>"), strlim(skippedFooter, 500));
+        DTWARN(_("Discarded single-line footer: <<%s>>"), strlim(skippedFooter, (char[500]) {}, 500));
       }
       else {
         ch = headPos;
         int tt = countfields(&ch);
         if (fill > 0) {
           DTWARN(_("Stopped early on line %"PRId64". Expected %d fields but found %d. Consider fill=%d or even more based on your knowledge of the input file. Use fill=Inf for reading the whole file for detecting the number of fields. First discarded non-empty line: <<%s>>"),
-          DTi+row1line, ncol, tt, tt, strlim(skippedFooter, 500));
+          DTi+row1line, ncol, tt, tt, strlim(skippedFooter, (char[500]) {}, 500));
         } else {
           DTWARN(_("Stopped early on line %"PRId64". Expected %d fields but found %d. Consider fill=TRUE. First discarded non-empty line: <<%s>>"),
-          DTi+row1line, ncol, tt, strlim(skippedFooter, 500));
+          DTi+row1line, ncol, tt, strlim(skippedFooter, (char[500]) {}, 500));
         }
       }
     }
   }
   if (quoteRuleBumpedCh != NULL && quoteRuleBumpedCh<headPos) {
-    DTWARN(_("Found and resolved improper quoting out-of-sample. First healed line %"PRId64": <<%s>>. If the fields are not quoted (e.g. field separator does not appear within any field), try quote=\"\" to avoid this warning."), quoteRuleBumpedLine, strlim(quoteRuleBumpedCh, 500));
+    DTWARN(_("Found and resolved improper quoting out-of-sample. First healed line %"PRId64": <<%s>>. If the fields are not quoted (e.g. field separator does not appear within any field), try quote=\"\" to avoid this warning."), quoteRuleBumpedLine, strlim(quoteRuleBumpedCh, (char[500]) {}, 500));
   }
 
   if (verbose) {

tests/autoprint.R

@@ -58,7 +58,7 @@ local({
 
 # child class of data.table doesn't induce unintended print, #3029
 dt = data.table(x = 1)
-class(dt) = c("foo", "data.table", "data.frame")
+setattr(dt, "class", c("foo", "data.table", "data.frame"))
 print.foo = function(x, ...) {
   NextMethod("print")
 }

tests/autoprint.Rout.save

@@ -172,7 +172,7 @@ NULL
 > 
 > # child class of data.table doesn't induce unintended print, #3029
 > dt = data.table(x = 1)
-> class(dt) = c("foo", "data.table", "data.frame")
+> setattr(dt, "class", c("foo", "data.table", "data.frame"))
 > print.foo = function(x, ...) {
 +   NextMethod("print")
 + }