Implement and test nqp::eqaddr.

jnthn · Jan 12, 2013 · f31ea24 · f31ea24
1 parent 3fee403
commit f31ea24
Show file tree

Hide file tree

Showing 3 changed files with 67 additions and 1 deletion.
diff --git a/lib/QAST/JASTCompiler.nqp b/lib/QAST/JASTCompiler.nqp
@@ -1110,6 +1110,7 @@ QAST::OperationsJAST.map_classlib_core_op('create', $TYPE_OPS, 'create', [$RT_OB
 QAST::OperationsJAST.map_classlib_core_op('isconcrete', $TYPE_OPS, 'isconcrete', [$RT_OBJ], $RT_INT, :tc);
 QAST::OperationsJAST.map_classlib_core_op('istrue', $TYPE_OPS, 'istrue', [$RT_OBJ], $RT_INT, :tc);
 QAST::OperationsJAST.map_classlib_core_op('isfalse', $TYPE_OPS, 'isfalse', [$RT_OBJ], $RT_INT, :tc);
+QAST::OperationsJAST.map_classlib_core_op('eqaddr', $TYPE_OPS, 'eqaddr', [$RT_OBJ, $RT_OBJ], $RT_INT);
 QAST::OperationsJAST.map_classlib_core_op('getattr', $TYPE_OPS, 'getattr', [$RT_OBJ, $RT_OBJ, $RT_STR], $RT_OBJ, :tc);
 QAST::OperationsJAST.map_classlib_core_op('getattr_i', $TYPE_OPS, 'getattr_i', [$RT_OBJ, $RT_OBJ, $RT_STR], $RT_INT, :tc);
 QAST::OperationsJAST.map_classlib_core_op('getattr_n', $TYPE_OPS, 'getattr_n', [$RT_OBJ, $RT_OBJ, $RT_STR], $RT_NUM, :tc);

diff --git a/src/org/perl6/nqp/runtime/Ops.java b/src/org/perl6/nqp/runtime/Ops.java
@@ -654,6 +654,9 @@ public static SixModelObject findmethod(ThreadContext tc, SixModelObject invocan
             throw new RuntimeException("Method '" + name + "' not found"); 
         return meth;
     }
+    public static long eqaddr(SixModelObject a, SixModelObject b) {
+        return a == b ? 1 : 0;
+    }
 
     /* Box/unbox operations. */
     public static SixModelObject box_i(long value, SixModelObject type, ThreadContext tc) {

diff --git a/t/qast_6model.t b/t/qast_6model.t
@@ -1,6 +1,6 @@
 use helper;
 
-plan(15);
+plan(16);
 
 qast_test(
     -> {
@@ -937,3 +937,65 @@ qast_test(
     },
     "0\n1\n",
     "defined works, just like isconcrete by default");
+
+qast_test(
+    -> {
+        my $block := QAST::Block.new(
+            QAST::Stmts.new(
+                QAST::Op.new(
+                    :op('say'),
+                    QAST::Op.new(
+                        :op('eqaddr'),
+                        QAST::Op.new( :op('knowhow') ),
+                        QAST::Op.new( :op('knowhow') )
+                    )),
+                QAST::Op.new(
+                    :op('say'),
+                    QAST::Op.new(
+                        :op('eqaddr'),
+                        QAST::Op.new( :op('bootint') ),
+                        QAST::Op.new( :op('bootnum') )
+                    )),
+                QAST::Op.new(
+                    :op('say'),
+                    QAST::Op.new(
+                        :op('eqaddr'),
+                        QAST::Op.new( :op('knowhow') ),
+                        QAST::Op.new(
+                            :op('create'),
+                            QAST::Op.new( :op('knowhow') )
+                        ))),
+                QAST::Op.new(
+                    :op('say'),
+                    QAST::Op.new(
+                        :op('eqaddr'),
+                        QAST::Op.new(
+                            :op('create'),
+                            QAST::Op.new( :op('knowhow') )
+                        ),
+                        QAST::Op.new(
+                            :op('create'),
+                            QAST::Op.new( :op('knowhow') )
+                        ))),
+                QAST::Op.new(
+                    :op('say'),
+                    QAST::Op.new(
+                        :op('eqaddr'),
+                        QAST::Op.new(
+                            :op('bind'),
+                            QAST::Var.new( :name('x'), :scope('local'), :decl('var') ),
+                            QAST::Op.new(
+                                :op('create'),
+                                QAST::Op.new( :op('knowhow') )
+                            )),
+                        QAST::Var.new( :name('x'), :scope('local') )
+                    ))));
+        QAST::CompUnit.new(
+            $block,
+            :main(QAST::Op.new(
+                :op('call'),
+                QAST::BVal.new( :value($block) )
+            )))
+    },
+    "1\n0\n0\n0\n1\n",
+    "eqaddr works");