From d0300fa2447281c73c71fcbb2baa40ed1eca6301 Mon Sep 17 00:00:00 2001
From: stepan <stepan.sindelar@oracle.com>
Date: Fri, 6 Oct 2017 11:35:28 +0200
Subject: [PATCH] Fixup .Devices variable in DevCurr built-in
---
.../library/fastrGrid/grDevices/DevCurr.java | 2 ++
.../graphics/RGridGraphicsAdapter.java | 32 ++++++++++++-----
.../truffle/r/test/ExpectedTestOutput.test | 10 ++++++
.../r/test/builtins/TestBuiltin_devcur.java | 36 +++++++++++++++++++
4 files changed, 72 insertions(+), 8 deletions(-)
create mode 100644 com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/builtins/TestBuiltin_devcur.java
diff --git a/com.oracle.truffle.r.library/src/com/oracle/truffle/r/library/fastrGrid/grDevices/DevCurr.java b/com.oracle.truffle.r.library/src/com/oracle/truffle/r/library/fastrGrid/grDevices/DevCurr.java
index b386e03956..924c7f411a 100644
--- a/com.oracle.truffle.r.library/src/com/oracle/truffle/r/library/fastrGrid/grDevices/DevCurr.java
+++ b/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);
}
diff --git a/com.oracle.truffle.r.library/src/com/oracle/truffle/r/library/fastrGrid/graphics/RGridGraphicsAdapter.java b/com.oracle.truffle.r.library/src/com/oracle/truffle/r/library/fastrGrid/graphics/RGridGraphicsAdapter.java
index d0f5518a6e..651ec5ff1b 100644
--- a/com.oracle.truffle.r.library/src/com/oracle/truffle/r/library/fastrGrid/graphics/RGridGraphicsAdapter.java
+++ b/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;
}
diff --git a/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/ExpectedTestOutput.test b/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/ExpectedTestOutput.test
index 85d7860d9a..05bc42255c 100644
--- a/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/ExpectedTestOutput.test
+++ b/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
diff --git a/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/builtins/TestBuiltin_devcur.java b/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/builtins/TestBuiltin_devcur.java
new file mode 100644
index 0000000000..c3720ff4b5
--- /dev/null
+++ b/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/builtins/TestBuiltin_devcur.java
@@ -0,0 +1,36 @@
+/*
+ * 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(); }");
+ }
+}
--
GitLab