Fixup .Devices variable in DevCurr built-in

com.oracle.truffle.r.library/src/com/oracle/truffle/r/library/fastrGrid/grDevices/DevCurr.java

@@ -23,6 +23,7 @@
 package com.oracle.truffle.r.library.fastrGrid.grDevices;
 
 import com.oracle.truffle.r.library.fastrGrid.GridContext;
+import com.oracle.truffle.r.library.fastrGrid.graphics.RGridGraphicsAdapter;
 import com.oracle.truffle.r.nodes.builtin.RExternalBuiltinNode;
 import com.oracle.truffle.r.runtime.data.RDataFactory;
 import com.oracle.truffle.r.runtime.data.model.RAbstractIntVector;
@@ -34,6 +35,7 @@ public final class DevCurr extends RExternalBuiltinNode.Arg0 {
 
     @Override
     public RAbstractIntVector execute() {
+        RGridGraphicsAdapter.fixupDevicesVariable();
         int index = GridContext.getContext().getCurrentDeviceIndex();
         return RDataFactory.createIntVector(new int[]{index + 1}, RDataFactory.COMPLETE_VECTOR);
     }

com.oracle.truffle.r.library/src/com/oracle/truffle/r/library/fastrGrid/graphics/RGridGraphicsAdapter.java

@@ -14,6 +14,7 @@
  */
 package com.oracle.truffle.r.library.fastrGrid.graphics;
 
+import com.oracle.truffle.api.CompilerDirectives.TruffleBoundary;
 import com.oracle.truffle.r.library.fastrGrid.FastRGridExternalLookup;
 import com.oracle.truffle.r.runtime.FastRConfig;
 import com.oracle.truffle.r.runtime.RError;
@@ -79,9 +80,26 @@ public final class RGridGraphicsAdapter {
         }
     }
 
+    /**
+     * Fixup .Devices array as someone may have set it to something that is not a pair list nor
+     * RNull, which breaks dev.cur built-in R function and others. GNUR seems to have active binding
+     * for it. This is such special case that it doesn't seem necessary for now.
+     */
+    @TruffleBoundary
+    public static void fixupDevicesVariable() {
+        Object devices = REnvironment.baseEnv().get(DOT_DEVICES);
+        if (devices == RNull.instance || !(devices instanceof RPairList)) {
+            // reset the .Devices and .Device variables to initial values
+            REnvironment.baseEnv().safePut(DOT_DEVICES, RNull.instance);
+            addDevice(NULL_DEVICE);
+            setCurrentDevice(NULL_DEVICE);
+        }
+    }
+
     public static void removeDevice(int index) {
         assert index > 0 : "cannot remove null device";
         REnvironment baseEnv = REnvironment.baseEnv();
+        fixupDevicesVariable();
         RPairList devices = (RPairList) baseEnv.get(DOT_DEVICES);
         assert index < devices.getLength() : "wrong index in removeDevice";
         RPairList prev = devices;
@@ -95,7 +113,7 @@ public final class RGridGraphicsAdapter {
 
     public static void setCurrentDevice(String name) {
         REnvironment baseEnv = REnvironment.baseEnv();
-        assert contains((RPairList) baseEnv.get(DOT_DEVICES), name) : "setCurrentDevice can be invoked only after the device is added with addDevice";
+        assert contains(baseEnv.get(DOT_DEVICES), name) : "setCurrentDevice can be invoked only after the device is added with addDevice";
         baseEnv.safePut(DOT_DEVICE, name);
     }
 
@@ -124,13 +142,11 @@ public final class RGridGraphicsAdapter {
         return dotDevices instanceof RPairList ? ((RPairList) dotDevices).getLength() : 0;
     }
 
-    public static String getDeviceName(int index) {
-        RPairList dotDevices = (RPairList) REnvironment.baseEnv().get(DOT_DEVICES);
-        return RRuntime.asString(dotDevices.getDataAtAsObject(index));
-    }
-
-    private static boolean contains(RPairList devices, String name) {
-        for (RPairList dev : devices) {
+    private static boolean contains(Object devices, String name) {
+        if (!(devices instanceof RPairList)) {
+            return false;
+        }
+        for (RPairList dev : (RPairList) devices) {
             if (dev.car().equals(name)) {
                 return true;
             }

com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/ExpectedTestOutput.test

@@ -20393,6 +20393,16 @@ attr(,"class")
 #argv <- structure(list(x = structure(c(0, 0, 0, 0, 0, 0, NA,     0, 0, NA, NA, 0, 0, 0, 0, 1), .Dim = c(4L, 4L))), .Names = 'x');do.call('det', argv)
 [1] 0
+##com.oracle.truffle.r.test.builtins.TestBuiltin_devcur.simpleTests#
+#{ .Devices <- list(); dev.cur(); }
+null device
+          1
+
+##com.oracle.truffle.r.test.builtins.TestBuiltin_devcur.simpleTests#
+#{ dev.cur() }
+null device
+          1
+
 ##com.oracle.truffle.r.test.builtins.TestBuiltin_dfltWarn.testdfltWarn1#
 #argv <- list('f is deprecated.\nUse convertY instead.\nSee help(Deprecated)', NULL); .Internal(.dfltWarn(argv[[1]], argv[[2]]))
 NULL

com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/builtins/TestBuiltin_devcur.java

+/*
+ * Copyright (c) 2017, Oracle and/or its affiliates. All rights reserved.
+ * DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER.
+ *
+ * This code is free software; you can redistribute it and/or modify it
+ * under the terms of the GNU General Public License version 2 only, as
+ * published by the Free Software Foundation.
+ *
+ * This code is distributed in the hope that it will be useful, but WITHOUT
+ * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+ * FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+ * version 2 for more details (a copy is included in the LICENSE file that
+ * accompanied this code).
+ *
+ * You should have received a copy of the GNU General Public License version
+ * 2 along with this work; if not, write to the Free Software Foundation,
+ * Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA.
+ *
+ * Please contact Oracle, 500 Oracle Parkway, Redwood Shores, CA 94065 USA
+ * or visit www.oracle.com if you need additional information or have any
+ * questions.
+ */
+package com.oracle.truffle.r.test.builtins;
+
+import org.junit.Test;
+
+import com.oracle.truffle.r.test.TestBase;
+
+public class TestBuiltin_devcur extends TestBase {
+
+    @Test
+    public void simpleTests() {
+        assertEval("{ dev.cur() }");
+        assertEval("{ .Devices <- list(); dev.cur(); }");
+    }
+}