Merge pull request #652 in G/fastr from...

Merge pull request #652 in G/fastr from ~STEPAN.SINDELAR_ORACLE.COM/fastr:feature/grid-support to master

* commit '51a8d559':
  Initial grid package support
  Fix: make tests independent on whether grid package is loaded or not

.gitignore

@@ -17,6 +17,8 @@
 /com.oracle.truffle.r.native/library/*/lib/*
 /com.oracle.truffle.r.native/library/stats/src/fft.c
 /com.oracle.truffle.r.native/library/tools/src/gramRd.c
+/com.oracle.truffle.r.native/library/grid/src/grid.c
+/com.oracle.truffle.r.native/library/grid/src/state.c
 /com.oracle.truffle.r.native/platform.mk
 /com.oracle.truffle.r.native/gnur/Makeconf.done
 /com.oracle.truffle.r.native/gnur/platform.mk.temp*

com.oracle.truffle.r.native/library/grid/Makefile

 #
-# Copyright (c) 2014, 2016, Oracle and/or its affiliates. All rights reserved.
+# 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
@@ -21,14 +21,43 @@
 # questions.
 #
 
+.PHONY: cleanpkg
+
 OBJ = lib
 
-GNUR_C_FILES := $(notdir $(wildcard $(GNUR_HOME)/src/library/grid/src/*.c))
+GNUR_C_FILES := gpar.c just.c layout.c matrix.c register.c unit.c util.c viewport.c
+
+GNUR_GRID = $(addprefix $(GNUR_HOME)/src/library/grid/src/, grid.c)
+GRID_OBJECT = $(addprefix $(OBJ)/, grid.o)
+
+GNUR_GRID_STATE = $(addprefix $(GNUR_HOME)/src/library/grid/src/, state.c)
+GRID_STATE_OBJECT = $(addprefix $(OBJ)/, state.o)
 
-GNUR_C_OBJECTS := $(addprefix $(OBJ)/, $(GNUR_C_FILES:.c=.o))
-#$(info GNUR_C_OBJECTS=$(GNUR_C_OBJECTS))
+GNUR_C_OBJECTS := $(addprefix $(OBJ)/, $(GNUR_C_FILES:.c=.o)) $(GRID_OBJECT) $(GRID_STATE_OBJECT)
+LIB_PKG_PRE = $(GRID_OBJECT) $(GRID_STATE_OBJECT)
+CLEAN_PKG := cleanpkg
+
+# This is necessary so that #include "grid.h" works
+PKG_INCLUDES = -I $(GNUR_SRC) 
 
 include ../lib.mk
 
+# Why is this necessary? Because if grid.c and state.c have been created by editing, 
+# lib.mk will include them in C_OBJECTS but they're already in GNUR_C_OBJECTS (uncreated case)
+C_OBJECTS := $(filter-out $(GRID_OBJECT) $(GRID_STATE_OBJECT), $(C_OBJECTS))
+
+$(C_OBJECTS): | $(OBJ)
+
+$(SRC)/grid.c: $(GNUR_GRID) src/sed_grid
+	sed -f src/sed_grid $(GNUR_GRID) > src/grid.c
+
+$(SRC)/state.c: $(GNUR_GRID_STATE) src/sed_state
+	sed -f src/sed_state $(GNUR_GRID_STATE) > src/state.c
+
+# obj files from c.o.t.r.n/library/grid/src are handled in lib.mk
+# obj files from gnur to c.o.t.r.n/library/grid/lib are handled here
 $(OBJ)/%.o: $(GNUR_SRC)/%.c
-	$(CC) $(CFLAGS) $(INCLUDES)  $(SUPPRESS_WARNINGS) -c $< -o $@
+	$(CC) $(CFLAGS) $(INCLUDES) -c $< -o $@
+
+cleanpkg:
+	rm -f $(SRC)/grid.c $(SRC)/state.c

com.oracle.truffle.r.native/library/grid/src/sed_grid

+# L_initGrid gets environment from its caller, which is .External, and saves it 
+# into a static variable R_gridEvalEnv without calling R_PreserveObject. In the 
+# Gnu R world, the environment actually cannot be garbage collected, because it 
+# is grid's environment and there are references to it.
+# 
+# Moreover, grid also uses this environment to "preserve" other objects just by 
+# adding them to that environment. See ed_state where we fix code doing this to 
+# also call R_PreserveObject and R_ReleaseObject.
+# 
+s/R_gridEvalEnv = \([[:alnum:]]*\);/R_gridEvalEnv = R_PreserveObject(\1);/g

com.oracle.truffle.r.native/library/grid/src/sed_state

+# see ed_grid for description of what is going on here.
+# 
+# Note: the state cannot be 'preserved' in globaliseState(SEXP) 
+# function, which would seem as appropriate place, because the 
+# state is stored into a global variable before globaliseState
+# is invoked.
+#
+# prepend R_PreserveObject call to any sd->systemSpecific assignment 
+# in form of sd->systemSpecific = (void*) variablename;
+s/sd->systemSpecific[[:space:]]*=[[:space:]]*(void\*)[[:space:]]*\([[:alnum:]_]*\);/\1 = R_PreserveObject(\1); sd->systemSpecific = (void*)\1;/g
+#
+# rename deglobaliseState to deglobaliseStateOriginal and prepend a 
+# new definition of deglobaliseState that calls R_ReleaseObject and 
+# the original function (note we need deglobaliseStateOriginal 
+# forward declaration)
+s/static void deglobaliseState(SEXP state)/static void deglobaliseStateOriginal(SEXP state);\
+static void deglobaliseState(SEXP state) { deglobaliseStateOriginal(state); R_ReleaseObject(state); }\
+static void deglobaliseStateOriginal(SEXP state)/g

com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/base/foreign/CallAndExternalFunctions.java

@@ -621,6 +621,16 @@ public class CallAndExternalFunctions {
                 case "sockwrite":
                     return new UnimplementedExternal(name);
 
+                // parallel
+                case "mc_is_child":
+                    return MCIsChildNodeGen.create();
+                default:
+                    return FastROptions.UseInternalGraphics.getBooleanValue() ? lookupGraphicsBuiltin(name) : null;
+            }
+        }
+
+        private RExternalBuiltinNode lookupGraphicsBuiltin(String name) {
+            switch (name) {
                 // grDevices
                 case "cairoProps":
                     return CairoPropsNodeGen.create();
@@ -632,10 +642,6 @@ public class CallAndExternalFunctions {
                     return InitGridNodeGen.create();
                 case "L_validUnits":
                     return ValidUnitsNodeGen.create();
-
-                // parallel
-                case "mc_is_child":
-                    return MCIsChildNodeGen.create();
                 default:
                     return null;
             }

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

@@ -29137,10 +29137,12 @@ NULL
 ##com.oracle.truffle.r.test.builtins.TestBuiltin_list.testlist43#
-#argv <- list(raster = structure('#000000', .Dim = c(1L, 1L), class = 'raster'), x = structure(0, unit = 'npc', valid.unit = 0L, class = 'unit'), y = structure(0.5, unit = 'npc', valid.unit = 0L, class = 'unit'), width = NULL, height = NULL, just = 'centre', hjust = NULL, vjust = NULL, interpolate = TRUE, name = NULL, gp = structure(list(), class = 'gpar'), vp = NULL);list(argv[[1]],argv[[2]],argv[[3]],argv[[4]],argv[[5]],argv[[6]],argv[[7]],argv[[8]],argv[[9]],argv[[10]],argv[[11]],argv[[12]]);
+#argv <- list(raster = structure('#000000', .Dim = c(1L, 1L), class = 'r_raster'), x = structure(0, unit = 'npc', valid.unit = 0L, class = 'r_unit'), y = structure(0.5, unit = 'npc', valid.unit = 0L, class = 'r_unit'), width = NULL, height = NULL, just = 'centre', hjust = NULL, vjust = NULL, interpolate = TRUE, name = NULL, gp = structure(list(), class = 'r_gpar'), vp = NULL);list(argv[[1]],argv[[2]],argv[[3]],argv[[4]],argv[[5]],argv[[6]],argv[[7]],argv[[8]],argv[[9]],argv[[10]],argv[[11]],argv[[12]]);
 [[1]]
      [,1]
 [1,] "#000000"
+attr(,"class")
+[1] "r_raster"
 [[2]]
 [1] 0
@@ -29149,7 +29151,7 @@ attr(,"unit")
 attr(,"valid.unit")
 [1] 0
 attr(,"class")
-[1] "unit"
+[1] "r_unit"
 [[3]]
 [1] 0.5
@@ -29158,7 +29160,7 @@ attr(,"unit")
 attr(,"valid.unit")
 [1] 0
 attr(,"class")
-[1] "unit"
+[1] "r_unit"
 [[4]]
 NULL
@@ -29184,7 +29186,7 @@ NULL
 [[11]]
 list()
 attr(,"class")
-[1] "gpar"
+[1] "r_gpar"
 [[12]]
 NULL
@@ -29809,7 +29811,7 @@ attr(,"class")attr(,"package")
 ##com.oracle.truffle.r.test.builtins.TestBuiltin_list.testlist9#
-#argv <- list(label = '', x = structure(0.5, unit = 'npc', valid.unit = 0L, class = 'unit'), y = structure(0.5, unit = 'npc', valid.unit = 0L, class = 'unit'), just = 'centre', hjust = NULL, vjust = NULL, rot = 0, check.overlap = FALSE, name = NULL, gp = structure(list(), class = 'gpar'), vp = NULL);list(argv[[1]],argv[[2]],argv[[3]],argv[[4]],argv[[5]],argv[[6]],argv[[7]],argv[[8]],argv[[9]],argv[[10]],argv[[11]]);
+#argv <- list(label = '', x = structure(0.5, unit = 'npc', valid.unit = 0L, class = 'r_unit'), y = structure(0.5, unit = 'npc', valid.unit = 0L, class = 'r_unit'), just = 'centre', hjust = NULL, vjust = NULL, rot = 0, check.overlap = FALSE, name = NULL, gp = structure(list(), class = 'r_gpar'), vp = NULL);list(argv[[1]],argv[[2]],argv[[3]],argv[[4]],argv[[5]],argv[[6]],argv[[7]],argv[[8]],argv[[9]],argv[[10]],argv[[11]]);
 [[1]]
 [1] ""
@@ -29820,7 +29822,7 @@ attr(,"unit")
 attr(,"valid.unit")
 [1] 0
 attr(,"class")
-[1] "unit"
+[1] "r_unit"
 [[3]]
 [1] 0.5
@@ -29829,7 +29831,7 @@ attr(,"unit")
 attr(,"valid.unit")
 [1] 0
 attr(,"class")
-[1] "unit"
+[1] "r_unit"
 [[4]]
 [1] "centre"
@@ -29852,7 +29854,7 @@ NULL
 [[10]]
 list()
 attr(,"class")
-[1] "gpar"
+[1] "r_gpar"
 [[11]]
 NULL
@@ -66333,7 +66335,7 @@ $a
 ##com.oracle.truffle.r.test.builtins.TestBuiltin_unclass.testunclass27#
-#argv <- list(list(structure(list(label = 'FALSE', x = structure(0, unit = 'npc', valid.unit = 0L, class = 'unit'), y = structure(0.5, unit = 'npc', valid.unit = 0L, class = 'unit'), just = c('left', 'centre'), hjust = NULL, vjust = NULL, rot = 0, check.overlap = FALSE, name = 'GRID.text.106', gp = structure(list(), class = 'gpar'), vp = NULL), .Names = c('label', 'x', 'y', 'just', 'hjust', 'vjust', 'rot', 'check.overlap', 'name', 'gp', 'vp'), class = c('text', 'grob', 'gDesc'))));unclass(argv[[1]]);
+#argv <- list(list(structure(list(label = 'FALSE', x = structure(0, unit = 'npc', valid.unit = 0L, class = 'r_unit'), y = structure(0.5, unit = 'npc', valid.unit = 0L, class = 'r_unit'), just = c('left', 'centre'), hjust = NULL, vjust = NULL, rot = 0, check.overlap = FALSE, name = 'GRID.text.106', gp = structure(list(), class = 'r_gpar'), vp = NULL), .Names = c('label', 'x', 'y', 'just', 'hjust', 'vjust', 'rot', 'check.overlap', 'name', 'gp', 'vp'), class = c('r_text', 'r_grob', 'r_gDesc'))));unclass(argv[[1]]);
 [[1]]
 $label
 [1] "FALSE"
@@ -66345,7 +66347,7 @@ attr(,"unit")
 attr(,"valid.unit")
 [1] 0
 attr(,"class")
-[1] "unit"
+[1] "r_unit"
 $y
 [1] 0.5
@@ -66354,7 +66356,7 @@ attr(,"unit")
 attr(,"valid.unit")
 [1] 0
 attr(,"class")
-[1] "unit"
+[1] "r_unit"
 $just
 [1] "left"   "centre"
@@ -66377,13 +66379,13 @@ $name
 $gp
 list()
 attr(,"class")
-[1] "gpar"
+[1] "r_gpar"
 $vp
 NULL
 attr(,"class")
-[1] "text"  "grob"  "gDesc"
+[1] "r_text"  "r_grob"  "r_gDesc"
 ##com.oracle.truffle.r.test.builtins.TestBuiltin_unclass.testunclass28#
@@ -125265,6 +125267,22 @@ attr(,"is.truffle.object")
 #if (length(grep("FastR", R.Version()$version.string)) != 1) { TRUE } else { { x<-rep(1, 100); xi1<-.fastr.identity(x); f<-function(x) { y<-x; y }; f(x); x[1]<-7; xi2<-.fastr.identity(x); xi1 == xi2 } }
 [1] TRUE
+##com.oracle.truffle.r.test.library.grid.TestGridPackage.testUnits#
+#{ library(grid); 3 * (unit(1, 'mm')); }
+[1] 3*1mm
+
+##com.oracle.truffle.r.test.library.grid.TestGridPackage.testUnits#
+#{ library(grid); grid:::unit.list(3 * unit(1, 'mm')); }
+[1] 3*1mm
+
+##com.oracle.truffle.r.test.library.grid.TestGridPackage.testUnits#
+#{ library(grid); unit.c(unit(1,'mm'), 42*unit(1,'mm')); }
+[1] 1mm    42*1mm
+
+##com.oracle.truffle.r.test.library.grid.TestGridPackage.testUnits#
+#{ library(grid); unit.c(unit(1,'mm'), unit(1,'mm')) }
+[1] 1mm 1mm
+
 ##com.oracle.truffle.r.test.library.stats.TestDistributions.testDensityFunctions#Output.MayIgnoreWarningContext#
 #dbeta(0, -1,  0.5)
 [1] NaN

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

@@ -4,7 +4,7 @@
  * http://www.gnu.org/licenses/gpl-2.0.html
  *
  * Copyright (c) 2012-2014, Purdue University
- * Copyright (c) 2013, 2016, Oracle and/or its affiliates
+ * Copyright (c) 2013, 2017, Oracle and/or its affiliates
  *
  * All rights reserved.
  */
@@ -60,7 +60,7 @@ public class TestBuiltin_list extends TestBase {
 
     @Test
     public void testlist9() {
-        assertEval("argv <- list(label = '', x = structure(0.5, unit = 'npc', valid.unit = 0L, class = 'unit'), y = structure(0.5, unit = 'npc', valid.unit = 0L, class = 'unit'), just = 'centre', hjust = NULL, vjust = NULL, rot = 0, check.overlap = FALSE, name = NULL, gp = structure(list(), class = 'gpar'), vp = NULL);list(argv[[1]],argv[[2]],argv[[3]],argv[[4]],argv[[5]],argv[[6]],argv[[7]],argv[[8]],argv[[9]],argv[[10]],argv[[11]]);");
+        assertEval("argv <- list(label = '', x = structure(0.5, unit = 'npc', valid.unit = 0L, class = 'r_unit'), y = structure(0.5, unit = 'npc', valid.unit = 0L, class = 'r_unit'), just = 'centre', hjust = NULL, vjust = NULL, rot = 0, check.overlap = FALSE, name = NULL, gp = structure(list(), class = 'r_gpar'), vp = NULL);list(argv[[1]],argv[[2]],argv[[3]],argv[[4]],argv[[5]],argv[[6]],argv[[7]],argv[[8]],argv[[9]],argv[[10]],argv[[11]]);");
     }
 
     @Test
@@ -237,7 +237,7 @@ public class TestBuiltin_list extends TestBase {
 
     @Test
     public void testlist43() {
-        assertEval("argv <- list(raster = structure('#000000', .Dim = c(1L, 1L), class = 'raster'), x = structure(0, unit = 'npc', valid.unit = 0L, class = 'unit'), y = structure(0.5, unit = 'npc', valid.unit = 0L, class = 'unit'), width = NULL, height = NULL, just = 'centre', hjust = NULL, vjust = NULL, interpolate = TRUE, name = NULL, gp = structure(list(), class = 'gpar'), vp = NULL);list(argv[[1]],argv[[2]],argv[[3]],argv[[4]],argv[[5]],argv[[6]],argv[[7]],argv[[8]],argv[[9]],argv[[10]],argv[[11]],argv[[12]]);");
+        assertEval("argv <- list(raster = structure('#000000', .Dim = c(1L, 1L), class = 'r_raster'), x = structure(0, unit = 'npc', valid.unit = 0L, class = 'r_unit'), y = structure(0.5, unit = 'npc', valid.unit = 0L, class = 'r_unit'), width = NULL, height = NULL, just = 'centre', hjust = NULL, vjust = NULL, interpolate = TRUE, name = NULL, gp = structure(list(), class = 'r_gpar'), vp = NULL);list(argv[[1]],argv[[2]],argv[[3]],argv[[4]],argv[[5]],argv[[6]],argv[[7]],argv[[8]],argv[[9]],argv[[10]],argv[[11]],argv[[12]]);");
     }
 
     @Test

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

@@ -4,7 +4,7 @@
  * http://www.gnu.org/licenses/gpl-2.0.html
  *
  * Copyright (c) 2014, Purdue University
- * Copyright (c) 2014, 2016, Oracle and/or its affiliates
+ * Copyright (c) 2014, 2017, Oracle and/or its affiliates
  *
  * All rights reserved.
  */
@@ -155,7 +155,7 @@ public class TestBuiltin_unclass extends TestBase {
 
     @Test
     public void testunclass27() {
-        assertEval("argv <- list(list(structure(list(label = 'FALSE', x = structure(0, unit = 'npc', valid.unit = 0L, class = 'unit'), y = structure(0.5, unit = 'npc', valid.unit = 0L, class = 'unit'), just = c('left', 'centre'), hjust = NULL, vjust = NULL, rot = 0, check.overlap = FALSE, name = 'GRID.text.106', gp = structure(list(), class = 'gpar'), vp = NULL), .Names = c('label', 'x', 'y', 'just', 'hjust', 'vjust', 'rot', 'check.overlap', 'name', 'gp', 'vp'), class = c('text', 'grob', 'gDesc'))));unclass(argv[[1]]);");
+        assertEval("argv <- list(list(structure(list(label = 'FALSE', x = structure(0, unit = 'npc', valid.unit = 0L, class = 'r_unit'), y = structure(0.5, unit = 'npc', valid.unit = 0L, class = 'r_unit'), just = c('left', 'centre'), hjust = NULL, vjust = NULL, rot = 0, check.overlap = FALSE, name = 'GRID.text.106', gp = structure(list(), class = 'r_gpar'), vp = NULL), .Names = c('label', 'x', 'y', 'just', 'hjust', 'vjust', 'rot', 'check.overlap', 'name', 'gp', 'vp'), class = c('r_text', 'r_grob', 'r_gDesc'))));unclass(argv[[1]]);");
     }
 
     @Test

com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/library/grid/TestGridPackage.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.library.grid;
+
+import org.junit.Test;
+
+import com.oracle.truffle.r.test.TestBase;
+
+/**
+ * Tests non-graphical functions in grid package.
+ */
+public class TestGridPackage extends TestBase {
+    @Test
+    public void testUnits() {
+        run("unit.c(unit(1,'mm'), unit(1,'mm'))");
+        run("3 * (unit(1, 'mm'));");
+        run("grid:::unit.list(3 * unit(1, 'mm'));");
+        run("unit.c(unit(1,'mm'), 42*unit(1,'mm'));");
+    }
+
+    private void run(String testCode) {
+        assertEval(String.format("{ library(grid); %s }", testCode));
+    }
+}

mx.fastr/mx_fastr.py

@@ -407,7 +407,7 @@ def _test_subpackage(name):
     return '.'.join((_test_package(), name))
 
 def _simple_generated_unit_tests():
-    return ','.join(map(_test_subpackage, ['library.base', 'library.stats', 'library.utils', 'library.fastr', 'builtins', 'functions', 'parser', 'S4', 'rng', 'runtime.data']))
+    return ','.join(map(_test_subpackage, ['library.base', 'library.grid', 'library.stats', 'library.utils', 'library.fastr', 'builtins', 'functions', 'parser', 'S4', 'rng', 'runtime.data']))
 
 def _simple_unit_tests():
     return ','.join([_simple_generated_unit_tests(), _test_subpackage('tck')])