cvsuser 04/04/03 11:50:10
Modified: docs/pdds pdd15_objects.pod
ops object.ops ops.num
t/pmc object-meths.t
Log:
fetchmethod op
Revision Changes Path
1.37 +2 -2 parrot/docs/pdds/pdd15_objects.pod
Index: pdd15_objects.pod
===================================================================
RCS file: /cvs/public/parrot/docs/pdds/pdd15_objects.pod,v
retrieving revision 1.36
retrieving revision 1.37
diff -u -w -r1.36 -r1.37
--- pdd15_objects.pod 3 Apr 2004 15:59:17 -0000 1.36
+++ pdd15_objects.pod 3 Apr 2004 19:49:44 -0000 1.37
@@ -1,5 +1,5 @@
# Copyright: 2001-2004 The Perl Foundation. All Rights Reserved.
-# $Id: pdd15_objects.pod,v 1.36 2004/04/03 15:59:17 leo Exp $
+# $Id: pdd15_objects.pod,v 1.37 2004/04/03 19:49:44 leo Exp $
=head1 NAME
@@ -278,7 +278,7 @@
Set the attribute of object Px with the fully qualified name Sy to Pz
-=item fetchmethod Px, Py, Sz (Unimplemented)
+=item fetchmethod Px, Py, Sz
Find the PMC for method Sz of object Py, and put it in Px. Note that how
the method PMC returned behaves if it goes out of scope or if the
1.41 +24 -4 parrot/ops/object.ops
Index: object.ops
===================================================================
RCS file: /cvs/public/parrot/ops/object.ops,v
retrieving revision 1.40
retrieving revision 1.41
diff -u -w -r1.40 -r1.41
--- object.ops 3 Apr 2004 15:59:26 -0000 1.40
+++ object.ops 3 Apr 2004 19:49:53 -0000 1.41
@@ -28,6 +28,7 @@
method name are already in their proper places. We assume that
all other registers are correctly set up, as per the Parrot
calling conventions.
+Throws a Method_Not_Found_Exception for a non-existent method.
=cut
@@ -40,6 +41,7 @@
and put it in the method slot. If a method name isn't provided then we
assume that things are already properly set up. Note that the return
continuation is placed in P1.
+Throws a Method_Not_Found_Exception for a non-existent method.
=cut
@@ -50,6 +52,13 @@
Make a tailcall to method $1. If no method name is given, we assume
everything is already set up properly.
+=item B<fetchmethod>(out PMC, in PMC, in STR)
+
+Find the method $3 for object $2 and put it in $1.
+Throws a Method_Not_Found_Exception for a non-existent method.
+The returned PMC may be outdatet, when the call is actually performed and
+changes to the underlaying classes where made.
+
=cut
op callmethod() :object_base {
@@ -57,7 +66,7 @@
opcode_t *dest;
opcode_t *next = expr NEXT();
method_pmc = VTABLE_find_method(interpreter, REG_PMC(2), REG_STR(0));
- if (NULL == method_pmc) {
+ if (!method_pmc) {
real_exception(interpreter, next, METH_NOT_FOUND,
"Method '%Ss' not found", REG_STR(0));
}
@@ -72,7 +81,7 @@
opcode_t *next = expr NEXT();
REG_STR(0) = $1;
method_pmc = VTABLE_find_method(interpreter, REG_PMC(2), REG_STR(0));
- if (NULL == method_pmc) {
+ if (!method_pmc) {
real_exception(interpreter, next, METH_NOT_FOUND,
"Method '%Ss' not found", REG_STR(0));
}
@@ -89,7 +98,7 @@
REG_PMC(1) = new_ret_continuation_pmc(interpreter, next);
method_pmc = VTABLE_find_method(interpreter, REG_PMC(2), REG_STR(0));
- if (NULL == method_pmc) {
+ if (!method_pmc) {
real_exception(interpreter, next, METH_NOT_FOUND,
"Method '%Ss' not found", REG_STR(0));
}
@@ -107,7 +116,7 @@
REG_PMC(1) = new_ret_continuation_pmc(interpreter, next);
method_pmc = VTABLE_find_method(interpreter, REG_PMC(2), REG_STR(0));
- if (NULL == method_pmc) {
+ if (!method_pmc) {
real_exception(interpreter, next, METH_NOT_FOUND,
"Method '%Ss' not found", REG_STR(0));
}
@@ -115,6 +124,17 @@
dest = (opcode_t *)REG_PMC(0)->vtable->invoke(interpreter, REG_PMC(0), next);
goto ADDRESS(dest);
}
+
+op fetchmethod(out PMC, in PMC, in STR) {
+ opcode_t *next = expr NEXT();
+ $1 = VTABLE_find_method(interpreter, $2, $3);
+ if (!$1) {
+ real_exception(interpreter, next, METH_NOT_FOUND,
+ "Method '%Ss' not found", $3);
+ }
+ goto ADDRESS(next);
+}
+
=item B<can>(out INT, in PMC, in STR)
Sets $1 to true or false, depending on whether $2 ->can the method in $3.
1.35 +2 -0 parrot/ops/ops.num
Index: ops.num
===================================================================
RCS file: /cvs/public/parrot/ops/ops.num,v
retrieving revision 1.34
retrieving revision 1.35
diff -u -w -r1.34 -r1.35
--- ops.num 3 Apr 2004 15:59:26 -0000 1.34
+++ ops.num 3 Apr 2004 19:49:53 -0000 1.35
@@ -1448,3 +1448,5 @@
getattribute_p_p_sc 1421
setattribute_p_s_p 1422
setattribute_p_sc_p 1423
+fetchmethod_p_p_s 1424
+fetchmethod_p_p_sc 1425
1.14 +42 -2 parrot/t/pmc/object-meths.t
Index: object-meths.t
===================================================================
RCS file: /cvs/public/parrot/t/pmc/object-meths.t,v
retrieving revision 1.13
retrieving revision 1.14
diff -u -w -r1.13 -r1.14
--- object-meths.t 17 Mar 2004 19:27:33 -0000 1.13
+++ object-meths.t 3 Apr 2004 19:50:10 -0000 1.14
@@ -1,6 +1,6 @@
#! perl -w
# Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-# $Id: object-meths.t,v 1.13 2004/03/17 19:27:33 scog Exp $
+# $Id: object-meths.t,v 1.14 2004/04/03 19:50:10 leo Exp $
=head1 NAME
@@ -16,7 +16,7 @@
=cut
-use Parrot::Test tests => 14;
+use Parrot::Test tests => 16;
use Test::More;
output_like(<<'CODE', <<'OUTPUT', "callmethod - unknown method");
@@ -421,5 +421,45 @@
eh!
back in __init
back in main
+OUTPUT
+
+output_is(<<'CODE', <<'OUTPUT', "fetchmethod");
+ newclass P3, "Foo"
+ find_type I0, "Foo"
+ new P2, I0
+
+ set S0, "meth"
+ fetchmethod P0, P2, S0
+ print "main\n"
+ # P2, S0 are as in callmethod
+ invokecc
+ print "back\n"
+ # check class
+ fetchmethod P0, P3, S0
+ set P2, P3
+ invokecc
+ print "back\n"
+ end
+
+.namespace ["Foo"]
+.pcc_sub meth:
+ print "in meth\n"
+ invoke P1
+CODE
+main
+in meth
+back
+in meth
+back
+OUTPUT
+
+output_like(<<'CODE', <<'OUTPUT', "fetchmethod - unknown method");
+ newclass P2, "Foo"
+ set S0, "nada"
+ fetchmethod P0, P2, S0
+ print "nope\n"
+ end
+CODE
+/Method 'nada' not found/
OUTPUT
