Fixed bug where setattr crashed on character(0) value. (#2628)

NEWS.md

@@ -138,6 +138,8 @@ Thanks to @MichaelChirico for reporting and to @MarkusBonsch for the implementat
 
 32. `x.` prefixes during joins sometimes resulted in a "column not found" error. This is now fixed. Closes [#2313](https://github.com/Rdatatable/data.table/issues/2313). Thanks to @franknarf1 for the MRE.
 
+33. `setattr()` no longer segfaults when setting 'class' to empty character vector, [#2386](https://github.com/Rdatatable/data.table/issues/2386). Thanks to @hatal175 for reporting and to @MarkusBonsch for fixing.
+
 #### NOTES
 
 0. The license has been changed from GPL to MPL (Mozilla Public License). All contributors were consulted and approved. [PR#2456](https://github.com/Rdatatable/data.table/pull/2456) details the reasons for the change.

R/data.table.R

@@ -2411,11 +2411,10 @@ setattr <- function(x,name,value) {
     # creating names longer than the number of columns of x, and to change the key, too
     # For convenience so that setattr(DT,"names",allnames) works as expected without requiring a switch to setnames.
   else {
-    # fix for R's global TRUE value input, #1281
     ans = .Call(Csetattrib, x, name, value)
     # If name=="names" and this is the first time names are assigned (e.g. in data.table()), this will be grown by alloc.col very shortly afterwards in the caller.
     if (!is.null(ans)) {
-      warning("Input is a length=1 logical that points to the same address as R's global TRUE value. Therefore the attribute has not been set by reference, rather on a copy. You will need to assign the result back to a variable. See https://github.com/Rdatatable/data.table/issues/1281 for more.")
+      warning("Input is a length=1 logical that points to the same address as R's global value. Therefore the attribute has not been set by reference, rather on a copy. You will need to assign the result back to a variable. See issue #1281.")
       x = ans
     }
   }

inst/tests/tests.Rraw

@@ -11671,6 +11671,10 @@ unlink(f)
 test(1876, fread("http://hkhfsk\nhttp://fhdkf\nhttp://kjfhskd\nhttp://hfkjf", header=FALSE),    # data not a download, #2531
            data.table(V1=c("http://hkhfsk","http://fhdkf","http://kjfhskd","http://hfkjf")))
 
+# segfault with setattr() of "class" attribute to 0-length value, #2386
+test(1877.1, attr(setattr(data.table(x = 1:10), "class", NULL), "class"), NULL)              # ok before
+test(1877.2, attr(setattr(data.table(x = 1:10), "class", character()), "class"), NULL)       # now ok (was segfault)
+test(1877.3, attr(setattr(data.table(x = 1:10), "test", character()), "test"), character(0)) # ok before
 
 ##########################
 

src/wrappers.c

@@ -8,13 +8,15 @@
 
 SEXP setattrib(SEXP x, SEXP name, SEXP value)
 {
-  if (TYPEOF(name) != STRSXP) error("Attribute name must be of type character");
-  if ( !isNewList(x) &&
-       strcmp(CHAR(STRING_ELT(name, 0)), "class") == 0 &&
-       isString(value) && (strcmp(CHAR(STRING_ELT(value, 0)), "data.table") == 0 ||
-       strcmp(CHAR(STRING_ELT(value, 0)), "data.frame") == 0) )
+  if (!isString(name) || LENGTH(name)!=1) error("Attribute name must be a character vector of length 1");
+  if (!isNewList(x) &&
+      strcmp(CHAR(STRING_ELT(name,0)),"class")==0 &&
+      isString(value) && LENGTH(value)>0 &&
+      (strcmp(CHAR(STRING_ELT(value, 0)),"data.table")==0 || strcmp(CHAR(STRING_ELT(value,0)),"data.frame")==0) ) {
     error("Internal structure doesn't seem to be a list. Can't set class to be 'data.table' or 'data.frame'. Use 'as.data.table()' or 'as.data.frame()' methods instead.");
-  if (isLogical(x) && x == ScalarLogical(TRUE)) {  // ok not to protect this ScalarLogical() as not assigned or passed
+  }
+  if (isLogical(x) && LENGTH(x)==1 &&
+      (x==ScalarLogical(TRUE) || x==ScalarLogical(FALSE) || x==ScalarLogical(NA_LOGICAL))) {  // R's internal globals, #1281
     x = PROTECT(duplicate(x));
     setAttrib(x, name, MAYBE_REFERENCED(value) ? duplicate(value) : value);
     UNPROTECT(1);