Fix perform:withArguments: primitive

core-lib/TestSuite/ReflectionTests.som

@@ -1,7 +1,4 @@
-"
-
-$Id: ReflectionTest.som 30 2009-07-31 12:20:25Z michael.haupt $
-
+(*
 Copyright (c) 2007-2013 see AUTHORS file
 Software Architecture Group, Hasso Plattner Institute, Potsdam, Germany
 http://www.hpi.uni-potsdam.de/swa/
@@ -22,44 +19,50 @@ FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
 AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
 LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
 OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
-THE SOFTWARE.
-"
+THE SOFTWARE.*)
+class ReflectionTest usingPlatform: platform testFramework: minitest = (
+| private TestContext = minitest TestContext.
+  private system = platform system.
+  private platform = platform.
+  private Array     = platform kernel Array.
+  private ObjectMirror = platform mirrors ObjectMirror.
+|
+) (
+  public class FactoryMethodTest = TestContext ()(
+    public class ReflectionTarget = (| num ::= 0. |)(
+      public set: val = (num := val)
+      public get = (^ num)
+    )
+
+    (* public testResondsTo = (
+      self assert: ((ObjectMirror reflecting: Object new) respondsTo: #isNil).
+      self assert: ((ObjectMirror reflecting: 23) respondsTo: #isNil).
+      self assert: ((ObjectMirror reflecting: 23) respondsTo: #+).
+    ) *)
+
+    (*public testMethods = (
+      | o |
+      o := ReflectionTarget new.
+      (ObjectMirror reflecting: o) classMirror methods doIndexes: [ :i |
+        ('' + ((ObjectMirror reflecting: o) classMirror methods) at: i) println.
+      ]
+
+      self assert: #class equals: (Object methods at: 1) signature.
+      self assert: (Object hasMethod: #==).
+    )*)
 
-ReflectionTest = TestCase (
-  testResondsTo = (
-    self assert: (Object new respondsTo: #isNil).
-    self assert: (23 respondsTo: #isNil).
-    self assert: (23 respondsTo: #+).
-  )
-
-  testMethods = (
-    "First method in Object should be #class."
-    self assert: #class equals: (Object methods at: 1) signature.
-    self assert: (Object hasMethod: #==).
-  )
+    public testPerform = (
+      | o mirrorO mirror23 |
+      mirror23 := ObjectMirror reflecting: 23.
+      self assert: (mirror23 perform: #between:and: withArguments: (Array with: 22 with: 24)).
 
-  testPerform = (
-    | o |
-    self assert: Integer equals: (23 perform: #class).
-    self assert: (23 perform: #between:and: withArguments: (Array with: 22 with: 24)).
-
-    o := SuperTest new.
-    self assert: #super equals: (o perform: #something inSuperclass: SuperTestSuperClass).
-
-    "Trying to see whether the stack in bytecode-based SOMs works properly"
-    self assert: #a equals: ((23 perform: #class) = Integer ifTrue: [#a] ifFalse: [#b]).
+      o := ReflectionTarget new.
+      mirrorO := ObjectMirror reflecting: o.
+      assert: (mirrorO perform: #get) equals: 0.
+      mirrorO perform: #set: withArguments: (Array with: 5).
 
-    self assert: 28 equals: 5 + (23 perform: #value).
-  )
-
-  testInstVarAtAndPut = (
-    | tmp |
-    "Testing #at: and #at:put:"
-    tmp := Pair withKey: 3 andValue: 42.
-
-    self assert: tmp key equals: (tmp instVarAt: 1).
-
-    tmp instVarAt: 1 put: #foo.
-    self assert: #foo    equals: tmp key.
-  )
+      assert: (mirrorO perform: #get) equals: 5.
+      assert: 28 equals: 5 + (mirror23 perform: #value)
+    )
+  ) : ( TEST_CONTEXT = () )
 )

core-lib/TestSuite/TestRunner.som

@@ -82,7 +82,8 @@ class TestRunner usingPlatform: platform = (
 
   runAllKnownModules = (
     | modules allSuccessful allTestsDonePromise |
-    modules := 'LanguageTests',
+    modules := 'ReflectionTests',
+               'LanguageTests',
                'MixinTests',
                'CollectionTests',
                'DoubleTests',

src/som/primitives/MirrorPrims.java

@@ -6,17 +6,20 @@
 import com.oracle.truffle.api.dsl.GenerateNodeFactory;
 import com.oracle.truffle.api.dsl.Specialization;
 import com.oracle.truffle.api.frame.VirtualFrame;
+import com.oracle.truffle.api.nodes.NodeCost;
 import com.oracle.truffle.api.source.SourceSection;
 
 import som.VM;
 import som.compiler.MixinDefinition;
 import som.interpreter.Types;
 import som.interpreter.nodes.dispatch.Dispatchable;
 import som.interpreter.nodes.nary.BinaryComplexOperation;
+import som.interpreter.nodes.nary.TernaryExpressionNode;
 import som.interpreter.nodes.nary.UnaryExpressionNode;
 import som.primitives.reflection.AbstractSymbolDispatch;
 import som.primitives.reflection.AbstractSymbolDispatchNodeGen;
 import som.vm.constants.Classes;
+import som.vmobjects.SArray;
 import som.vmobjects.SArray.SImmutableArray;
 import som.vmobjects.SArray.SMutableArray;
 import som.vmobjects.SClass;
@@ -81,6 +84,27 @@ public final Object doPerform(final VirtualFrame frame, final Object rcvr,
     }
   }
 
+  @GenerateNodeFactory
+  @Primitive(primitive = "obj:perform:withArguments:")
+  public abstract static class PerformWithArgumentsPrim extends TernaryExpressionNode {
+    @Child protected AbstractSymbolDispatch dispatch;
+    public PerformWithArgumentsPrim(final boolean eagWrap, final SourceSection source) {
+      super(eagWrap, source);
+      dispatch = AbstractSymbolDispatchNodeGen.create(source);
+    }
+
+    @Specialization
+    public final Object doPerform(final VirtualFrame frame, final Object rcvr,
+        final SSymbol selector, final SArray  argsArr) {
+      return dispatch.executeDispatch(frame, rcvr, selector, argsArr);
+    }
+
+    @Override
+    public NodeCost getCost() {
+      return dispatch.getCost();
+    }
+  }
+
   @GenerateNodeFactory
   @Primitive(primitive = "classDefinition:")
   public abstract static class ClassDefinitionPrim extends UnaryExpressionNode {

tests/som/tests/SomTests.java

@@ -59,6 +59,7 @@ public static Iterable<Object[]> data() {
         {"BenchmarkHarnessTests", null },
         {"ActorTests",       null },
         {"ProcessTests",     null },
+        {"ReflectionTests",  null },
         {"RegressionTests",  null },
         {"ThreadingTests",   null },
         {"TransactionTests", null },