Rewritten parameter casts for setS4Object builtin.

com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/base/SetS4Object.java

@@ -22,6 +22,7 @@
  */
 package com.oracle.truffle.r.nodes.builtin.base;
 
+import static com.oracle.truffle.r.nodes.builtin.CastBuilder.Predef.*;
 import static com.oracle.truffle.r.runtime.builtins.RBehavior.PURE;
 import static com.oracle.truffle.r.runtime.builtins.RBuiltinKind.INTERNAL;
 
@@ -32,14 +33,11 @@ import com.oracle.truffle.r.nodes.builtin.RBuiltinNode;
 import com.oracle.truffle.r.nodes.objects.AsS4;
 import com.oracle.truffle.r.nodes.objects.AsS4NodeGen;
 import com.oracle.truffle.r.runtime.RError;
-import com.oracle.truffle.r.runtime.RRuntime;
 import com.oracle.truffle.r.runtime.builtins.RBuiltin;
 import com.oracle.truffle.r.runtime.context.RContext;
 import com.oracle.truffle.r.runtime.data.RAttributable;
 import com.oracle.truffle.r.runtime.data.RNull;
 import com.oracle.truffle.r.runtime.data.RSequence;
-import com.oracle.truffle.r.runtime.data.model.RAbstractIntVector;
-import com.oracle.truffle.r.runtime.data.model.RAbstractLogicalVector;
 
 @RBuiltin(name = "setS4Object", kind = INTERNAL, parameterNames = {"object", "flag", "complete"}, behavior = PURE)
 public abstract class SetS4Object extends RBuiltinNode {
@@ -48,25 +46,15 @@ public abstract class SetS4Object extends RBuiltinNode {
 
     @Override
     protected void createCasts(CastBuilder casts) {
-        casts.toAttributable(0, true, true, true);
-        casts.toLogical(1);
-        casts.toInteger(2);
-    }
-
-    private boolean checkArgs(RAbstractLogicalVector flagVec, RAbstractIntVector completeVec) {
-        if (flagVec.getLength() == 0 || (flagVec.getLength() == 1 && flagVec.getDataAt(0) == RRuntime.LOGICAL_NA) || flagVec.getLength() > 1) {
-            throw RError.error(this, RError.Message.INVALID_ARGUMENT, "flag");
-        }
-        if (completeVec.getLength() == 0 || flagVec.getDataAt(0) == RRuntime.LOGICAL_NA) {
-            throw RError.error(this, RError.Message.INVALID_ARGUMENT, "complete");
-        }
-        return RRuntime.fromLogical(flagVec.getDataAt(0));
+        casts.arg("object").asAttributable(true, true, true);
+        casts.arg("flag").asLogicalVector().mustBe(singleElement(), RError.SHOW_CALLER, RError.Message.INVALID_ARGUMENT, "flag").findFirst().map(toBoolean());
+        // "complete" can be a vector, unlike "flag"
+        casts.arg("complete").asIntegerVector().findFirst(RError.SHOW_CALLER, RError.Message.INVALID_ARGUMENT, "complete");
     }
 
     @Specialization
     @TruffleBoundary
-    protected RNull asS4(RNull object, RAbstractLogicalVector flagVec, RAbstractIntVector completeVec) {
-        boolean flag = checkArgs(flagVec, completeVec);
+    protected RNull asS4(RNull object, boolean flag, @SuppressWarnings("unused") int complete) {
         if (flag) {
             RContext.getInstance().setNullS4Object(true);
         } else {
@@ -80,14 +68,13 @@ public abstract class SetS4Object extends RBuiltinNode {
     }
 
     @Specialization(guards = "!isSequence(object)")
-    protected Object asS4(RAttributable object, RAbstractLogicalVector flagVec, RAbstractIntVector completeVec) {
-        boolean flag = checkArgs(flagVec, completeVec);
-        return asS4.executeObject(object, flag, completeVec.getDataAt(0));
+    protected Object asS4(RAttributable object, boolean flag, int complete) {
+        return asS4.executeObject(object, flag, complete);
     }
 
     @Specialization
-    protected Object asS4(RSequence seq, RAbstractLogicalVector flagVec, RAbstractIntVector completeVec) {
-        return asS4(seq.materialize(), flagVec, completeVec);
+    protected Object asS4(RSequence seq, boolean flag, int complete) {
+        return asS4(seq.materialize(), flag, complete);
     }
 
     protected boolean isSequence(Object o) {

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

@@ -99,4 +99,15 @@ public class TestBuiltin_setS4Object extends TestBase {
         assertEval(Ignored.Unknown,
                         "argv <- list(structure(function (x, y, ...) UseMethod('plot'), target = structure(character(0), .Names = character(0), package = character(0), class = structure('signature', package = 'methods')), defined = structure(character(0), .Names = character(0), package = character(0), class = structure('signature', package = 'methods')), generic = character(0), class = structure('derivedDefaultMethod', package = 'methods')), TRUE, 0L); .Internal(setS4Object(argv[[1]], argv[[2]], argv[[3]]))");
     }
+
+    @Test
+    public void testSetS4Object() {
+        assertEval("{ x<-42; asS4(x, \"TRUE\") }");
+        assertEval("{ x<-42; asS4(x, logical()) }");
+        assertEval("{ x<-42; asS4(x, c(TRUE, FALSE)) }");
+        assertEval("{ x<-42; asS4(x, TRUE, \"1\") }");
+        assertEval("{ x<-42; asS4(x, TRUE, logical()) }");
+        assertEval("{ x<-42; asS4(x, TRUE, c(1,2)) }");
+    }
+
 }