[GR-3021] Stricter argument validation in some stats externals.

PullRequest: fastr/1281

com.oracle.truffle.r.library/src/com/oracle/truffle/r/library/fastrGrid/graphics/R/fastrGraphics.R

@@ -25,29 +25,29 @@
 # prints a warning message instructing the user to use grid/lattice/ggplot2 instead
 
 eval(expression({
-    if (.fastr.option('IgnoreGraphicsCalls')) {
-        # we force the arguments to be evaluated, but otherwise do nothing
-        graphicsWarning <- function(name) function(...) { list(...); invisible(NULL); }
-    } else {
-        graphicsWarning <- function(name) {
-            # lookup original function and fetch signature
-            fun <- tryCatch(get(name, environment()), error=function(x) NULL)
-            if(!is.null(fun)) {
-                sig <- formals(fun)
-            } else {
-                sig <- NULL
-            }
+    graphicsWarning <- function(name) {
+        # lookup original function and fetch signature
+        fun <- tryCatch(get(name, environment()), error=function(x) NULL)
+        if(!is.null(fun)) {
+            sig <- formals(fun)
+        } else {
+            sig <- NULL
+        }
 
+        if (.fastr.option('IgnoreGraphicsCalls')) {
+            # we evaluate the arguments to simulate the function effects
+            replacementFun <- function(...) { if (is.null(sig)) list(...) else get(names(sig)); invisible(NULL); }
+        } else {
             replacementFun <- function(...) {
                 warning(paste0(name, " not supported.", " Note: FastR does not support graphics package and most of its functions. Please use grid package or grid based packages like lattice instead."))
                 NULL
             }
+        }
 
-            if(!is.null(sig)) {
-                formals(replacementFun) <- sig
-            }
-            return(replacementFun)
+        if(!is.null(sig)) {
+            formals(replacementFun) <- sig
         }
+        return(replacementFun)
     }
 
     plot.default <- function (x, y = NULL, type = "p", xlim = NULL, ylim = NULL,

com.oracle.truffle.r.library/src/com/oracle/truffle/r/library/stats/Cdist.java

@@ -26,6 +26,7 @@ import com.oracle.truffle.r.nodes.attributes.SpecialAttributesFunctions.GetDimAt
 import com.oracle.truffle.r.nodes.attributes.SpecialAttributesFunctions.SetClassAttributeNode;
 import com.oracle.truffle.r.nodes.builtin.RExternalBuiltinNode;
 import com.oracle.truffle.r.runtime.RError;
+import com.oracle.truffle.r.runtime.RError.Message;
 import com.oracle.truffle.r.runtime.RRuntime;
 import com.oracle.truffle.r.runtime.data.RDataFactory;
 import com.oracle.truffle.r.runtime.data.RDoubleVector;
@@ -58,6 +59,10 @@ public abstract class Cdist extends RExternalBuiltinNode.Arg4 {
                     @Cached("create()") SetAttributeNode setAttrNode,
                     @Cached("create()") SetClassAttributeNode setClassAttrNode,
                     @Cached("create()") GetDimAttributeNode getDimNode) {
+        if (!getDimNode.isMatrix(x)) {
+            // Note: otherwise array index out of bounds
+            throw error(Message.MUST_BE_SQUARE_MATRIX, "x");
+        }
         int nr = getDimNode.nrows(x);
         int nc = getDimNode.ncols(x);
         int n = nr * (nr - 1) / 2; /* avoid int overflow for N ~ 50,000 */

com.oracle.truffle.r.library/src/com/oracle/truffle/r/library/stats/Cutree.java

@@ -17,6 +17,7 @@ import com.oracle.truffle.api.dsl.Cached;
 import com.oracle.truffle.api.dsl.Specialization;
 import com.oracle.truffle.r.nodes.attributes.SpecialAttributesFunctions.GetDimAttributeNode;
 import com.oracle.truffle.r.nodes.builtin.RExternalBuiltinNode;
+import com.oracle.truffle.r.runtime.RError.Message;
 import com.oracle.truffle.r.runtime.data.RDataFactory;
 import com.oracle.truffle.r.runtime.data.RIntVector;
 import com.oracle.truffle.r.runtime.data.model.RAbstractIntVector;
@@ -50,6 +51,11 @@ public abstract class Cutree extends RExternalBuiltinNode.Arg2 {
         boolean foundJ;
 
         int n = getDimNode.nrows(merge) + 1;
+        if (!getDimNode.isSquareMatrix(merge)) {
+            // Note: otherwise array index out of bounds
+            throw error(Message.MUST_BE_SQUARE_MATRIX, "x");
+        }
+
         /*
          * The C code uses 1-based indices for the next three arrays and so set the int * value
          * behind the actual start of the array. To keep the logic equivalent, we call adj(k) on the

com.oracle.truffle.r.library/src/com/oracle/truffle/r/library/stats/DoubleCentre.java

@@ -34,7 +34,7 @@ public abstract class DoubleCentre extends RExternalBuiltinNode.Arg1 {
                     @Cached("createNonShared(a)") VectorReuse reuse,
                     @Cached("create()") GetDimAttributeNode getDimNode) {
         int n = getDimNode.nrows(a);
-        if (!getDimNode.isMatrix(a) || n != a.getLength() / n) {
+        if (!getDimNode.isSquareMatrix(a)) {
             // Note: otherwise array index out of bounds
             throw error(Message.MUST_BE_SQUARE_MATRIX, "x");
         }

com.oracle.truffle.r.nodes/src/com/oracle/truffle/r/nodes/attributes/SpecialAttributesFunctions.java

@@ -662,6 +662,14 @@ public final class SpecialAttributesFunctions {
             return nullDimsProfile.profile(dims == null) ? false : dims.getLength() == 2;
         }
 
+        public final boolean isSquareMatrix(RAbstractVector vector) {
+            RIntVector dims = (RIntVector) execute(vector);
+            if (nullDimsProfile.profile(dims == null) || dims.getLength() < 2) {
+                return false;
+            }
+            return dims.getDataAt(0) == dims.getDataAt(1);
+        }
+
         @Specialization(insertBefore = "getAttrFromAttributable")
         protected Object getScalarVectorDims(@SuppressWarnings("unused") RScalarVector x) {
             return null;