block g[[ on non-atomic input (#4161)

Rdatatable · Jan 8, 2020 · 5833fd9 · 5833fd9
1 parent 11ab05a
commit 5833fd9
Show file tree

Hide file tree

Showing 3 changed files with 15 additions and 3 deletions.
diff --git a/NEWS.md b/NEWS.md
@@ -83,6 +83,8 @@ unit = "s")
 
 4. If `.SD` is returned as-is during grouping, it is now unlocked for downstream usage, part of [#4159](https://github.com/Rdatatable/data.table/issues/4159).
 
+5. `GForce` is deactivated for `[[` on non-atomic input, part of [#4159](https://github.com/Rdatatable/data.table/issues/4159).
+
 ## NOTES
 
 1. `as.IDate`, `as.ITime`, `second`, `minute`, and `hour` now recognize UTC equivalents for speed: GMT, GMT-0, GMT+0, GMT0, Etc/GMT, and Etc/UTC, [#4116](https://github.com/Rdatatable/data.table/issues/4116).

diff --git a/R/data.table.R b/R/data.table.R
@@ -1522,7 +1522,11 @@ replace_dot_alias = function(e) {
         jvnames = sdvars
       }
     } else if (length(as.character(jsub[[1L]])) == 1L) {  # Else expect problems with <jsub[[1L]] == >
-      subopt = length(jsub) == 3L && (jsub[[1L]] == "[" || jsub[[1L]] == "[[") && (is.numeric(jsub[[3L]]) || jsub[[3L]] == ".N")
+      # g[[ only applies to atomic input, for now, was causing #4159
+      subopt = length(jsub) == 3L &&
+        (jsub[[1L]] == "[" ||
+           (jsub[[1L]] == "[[" && eval(call('is.atomic', jsub[[2L]]), envir = x))) &&
+        (is.numeric(jsub[[3L]]) || jsub[[3L]] == ".N")
       headopt = jsub[[1L]] == "head" || jsub[[1L]] == "tail"
       firstopt = jsub[[1L]] == "first" || jsub[[1L]] == "last" # fix for #2030
       if ((length(jsub) >= 2L && jsub[[2L]] == ".SD") &&
@@ -1649,7 +1653,7 @@ replace_dot_alias = function(e) {
           # otherwise there must be three arguments, and only in two cases:
           #   1) head/tail(x, 1) or 2) x[n], n>0
           length(q)==3L && length(q3 <- q[[3L]])==1L && is.numeric(q3) &&
-            ( (q1c %chin% c("head", "tail") && q3==1L) || ((q1c == "[" || q1c == "[[") && q3>0L) )
+            ( (q1c %chin% c("head", "tail") && q3==1L) || ((q1c == "[" || (q1c == "[[" && eval(call('is.atomic', q[[2L]]), envir=x))) && q3>0L) )
         }
         if (jsub[[1L]]=="list") {
           GForce = TRUE

diff --git a/inst/tests/tests.Rraw b/inst/tests/tests.Rraw
@@ -8045,6 +8045,11 @@ options(datatable.optimize=Inf)
 test(1581.14, ans2 <- dt[x %in% letters[15:20], d1[[2]], by=x, verbose=TRUE],
               output = "GForce optimized j")
 test(1581.15, ans1, ans2)
+# also, block for non-atomic input, #4159
+dt = data.table(a=1:3)
+dt[ , l := .(list(1, 2, 3))]
+test(1581.16, dt[ , .(l = l[[1L]]), by=a, verbose=TRUE],
+     dt[ , l := unlist(l)], output='(GForce FALSE)')
 
 # handle NULL value correctly #1429
 test(1582, uniqueN(NULL), 0L)
@@ -16729,7 +16734,8 @@ test(2130.03, print(DT), output=c("   x             y", "1: 1 <ex_class[3]>",
 # .SD from grouping should be unlocked, part of #4159
 x = data.table(a=1:3, b=4:6)
 test(2131, lapply(x[ , list(dt = list(.SD)), by = a]$dt, attr, '.data.table.locked'),
-     list(NULL, NULL, NULL))
+           list(NULL, NULL, NULL))
+
 
 ########################
 #  Add new tests here  #