Merge pull request #6875 from Rdatatable/reset_class_as.data.frame

force class reset in as.data.table.data.frame

Author: MichaelChirico

NEWS.md

@@ -16,6 +16,8 @@
 
 4. `as.data.table()` now properly handles keys: specifying keys sets them, omitting keys preserves existing ones, and setting `key=NULL` clears them, [#6859](https://github.com/Rdatatable/data.table/issues/6859). Thanks @brookslogan for the report and @Mukulyadav2004 for the fix.
 
+5. `as.data.table()` on `x` avoids an infinite loop if the output of the corresponding `as.data.frame()` method has the same class as the input, [#6874](https://github.com/Rdatatable/data.table/issues/6874). Concretely, we had `class(x) = c('foo', 'data.frame')` and `class(as.data.frame(x)) = c('foo', 'data.frame')`, so `as.data.frame.foo` wound up getting called repeatedly. Thanks @matschmitz for the report and @ben-schwen for the fix.
+
 ## 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

@@ -215,7 +215,12 @@ as.data.table.list = function(x,
 
 as.data.table.data.frame = function(x, keep.rownames=FALSE, key=NULL, ...) {
   if (is.data.table(x)) return(as.data.table.data.table(x, key=key)) # S3 is weird, #6739. Also # nocov; this is tested in 2302.{2,3}, not sure why it doesn't show up in coverage.
-  if (!identical(class(x), "data.frame")) return(as.data.table(as.data.frame(x), keep.rownames=keep.rownames, key=key, ...))
+  if (!identical(class(x), "data.frame")) {
+    class_orig = class(x)
+    x = as.data.frame(x)
+    if (identical(class(x), class_orig)) setattr(x, "class", "data.frame") # cater for cases when as.data.frame can generate a loop #6874
+    return(as.data.table.data.frame(x, keep.rownames=keep.rownames, key=key, ...))
+  }
   if (!isFALSE(keep.rownames)) {
     # can specify col name to keep.rownames, #575; if it's the same as key,
     #   kludge it to 'rn' since we only apply the new name afterwards, #4468

inst/tests/S4.Rraw

@@ -126,3 +126,9 @@ setMethod(`%foo%`, c("Date", "CustomDurationClass"), function (e1, e2) e1 - e2@.
 test(8, as.IDate("2025-03-01") %foo% CustomDurationClass(1), as.IDate("2025-02-28"))
 removeGeneric("%foo%")
 removeClass("CustomDurationClass")
+
+# data.table(s4) #6874 should work
+s4cl = setClass("s4cl", slots=list(x="integer"))
+DT = setalloccol(structure(list(a=new("s4cl", x=1L)), row.names=c(NA, -1L), class=c("data.table", "data.frame")))
+test(9, data.table(a=s4cl(x=1L)), DT)
+removeClass("s4cl")

inst/tests/tests.Rraw

@@ -21104,3 +21104,8 @@ 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) 
+
+# as.data.frame(x) does not reset class(x) to "data.frame" #6874
+as.data.frame.no.reset = function(x) x
+DF = structure(list(a = 1:2), class = c("data.frame", "no.reset"), row.names = c(NA, -2L))
+test(2310.01, as.data.table(DF), data.table(a=1:2))

src/assign.c

@@ -232,7 +232,7 @@ SEXP setdt_nrows(SEXP x)
       }
       len_xi = INTEGER(dim_xi)[0];
     } else {
-      len_xi = LENGTH(xi);
+      len_xi = length(xi);
     }
     if (!base_length) {
       base_length = len_xi;