Merge branch 'master' of https://github.com/Rdatatable/data.table into issue_2606

Author: venom1204

NEWS.md

@@ -74,6 +74,8 @@
 
 12. `print(..., col.names = 'none')` now correctly adapts column widths to the data content, ignoring the original column names and producing a more compact output, [#6882](https://github.com/Rdatatable/data.table/issues/6882). Thanks to @brooksambrose for the report and @venom1204 for the PR.
 
+13. Reference to `.SD` in `...` arguments to `lapply()`, e.g. ``lapply(list_of_tables, `[`, j=.SD[1L])`` is evaluated correctly, [#2982](https://github.com/Rdatatable/data.table/issues/2982). Thanks @franknarf1 for the report and @MichaelChirico for the fix.
+
 ### NOTES
 
 1. The following in-progress deprecations have proceeded:

R/cedta.R

@@ -39,6 +39,16 @@ cedta.pkgEvalsUserCode = c("gWidgetsWWW","statET","FastRWeb","slidify","rmarkdow
 }
 # nocov end
 
+.any_sd_queries_in_stack = function(calls) {
+  for (ii in length(calls):1) { # nolint: seq_linter. As above.
+    if (!calls[[ii]] %iscall% "[") next
+    the_lhs = calls[[ii]][[2L]]
+    if (!is.name(the_lhs) || the_lhs != ".SD") next
+    return(TRUE)
+  }
+  FALSE
+}
+
 # cedta = Calling Environment Data.Table-Aware
 cedta = function(n=2L) {
   # Calling Environment Data Table Aware
@@ -52,12 +62,15 @@ cedta = function(n=2L) {
     return(TRUE)
   }
   nsname = getNamespaceName(ns)
+  sc = sys.calls()
   ans = nsname=="data.table" ||
     "data.table" %chin% names(getNamespaceImports(ns)) ||   # most common and recommended cases first for speed
     (nsname=="utils" &&
       (exists("debugger.look", parent.frame(n+1L)) ||
-      (length(sc<-sys.calls())>=8L && sc[[length(sc)-7L]] %iscall% 'example')) ) || # 'example' for #2972
-    (nsname=="base" && all(c("FUN", "X") %chin% ls(parent.frame(n)))) || # lapply
+      (length(sc)>=8L && sc[[length(sc)-7L]] %iscall% 'example')) ) || # 'example' for #2972
+    (nsname=="base" && # lapply
+      (all(c("FUN", "X") %chin% ls(parent.frame(n))) ||
+      .any_sd_queries_in_stack(sc))) ||
     (nsname %chin% cedta.pkgEvalsUserCode && .any_eval_calls_in_stack()) ||
     nsname %chin% cedta.override ||
     isTRUE(ns$.datatable.aware) ||  # As of Sep 2018: RCAS, caretEnsemble, dtplyr, rstanarm, rbokeh, CEMiTool, rqdatatable, RImmPort, BPRMeth, rlist

R/test.data.table.R

@@ -197,7 +197,7 @@ test.data.table = function(script="tests.Rraw", verbose=FALSE, pkg=".", silent=F
     tryCatch(error = function(c) warningf("Attempt to subset to %d tests matching '%s' failed, running full suite.", length(keep_test_ids), testPattern), {
       new_script = file_lines[c(header_lines, keep_lines)]
       parse(text = new_script) # as noted above the static approach is not fool-proof (yet?), so force the script to at least parse before continuing.
-      fn = tempfile()
+      fn = setNames(tempfile(), names(fn))
       on.exit(unlink(fn), add=TRUE)
       catf("Running %d of %d tests matching '%s'\n", length(keep_test_ids), nrow(test_calls), testPattern)
       writeLines(new_script, fn)

inst/tests/tests.Rraw

@@ -21427,34 +21427,37 @@ test(2330.7, as.data.table(list(z), keep.rownames=TRUE), data.table(rn=rep("", 3
 M <- matrix(1:6, nrow=3, dimnames=list(rep("", 3), c("V1", "V2")))   #  test of list(M) for empty-rowname'd matrix input
 test(2330.8, as.data.table(list(M), keep.rownames=TRUE), data.table(rn=rep("", 3), V1=1:3, V2=4:6))
 
+# .SD reference in '...' passed to lapply(FUN=) is recognized as data.table
+test(2331, lapply(list(data.table(a=1:2)), `[`, j=.SD[1L]), list(data.table(a=1L)))
+
 #2606 Recursive tables() naming convention
-test(2331.1, local({
+test(2332.1, local({
   lst_named = list(inner = data.table(a = 1))
   lst_unnamed = list(data.table(b = 2))
   nested = list(l1 = list(l2 = data.table(c = 3)))
   out = tables(recursive = TRUE)$NAME
   all(c("lst_named$inner", "lst_unnamed[[1]]", "nested$l1$l2") %in% out)
 }))
-test(2331.2, local({
+test(2332.2, local({
   mixed = list(data.table(x = 1), y = data.table(z = 2))
   out = tables(recursive = TRUE)$NAME
   all(c("mixed[[1]]", "mixed$y") %in% out)
 }))
-test(2331.3, local({
+test(2332.3, local({
   mixed_nested = list(
   A = list(data.table(p = 1), q = data.table(q = 2)))
   out = tables(recursive = TRUE)$NAME
   all(c("mixed_nested$A[[1]]", "mixed_nested$A$q") %in% out)
 }))
-test(2331.4, local({
+test(2332.4, local({
   dt <- data.table(val = 42)
   e <- new.env()
   e$dt <- dt
   e$self <- e
   out = tables(recursive = TRUE, env = e)$NAME
   identical(out, "dt")
 }))
-test(2331.5, local({
+test(2332.5, local({
   cycle <- list()
   cycle[[1]] <- cycle
   cycle[[2]] <- list(cycle)  # nested cycle