cvsuser 03/12/05 08:41:02
Modified: classes parrotclass.pmc parrotobject.pmc
src objects.c
t/pmc object-meths.t
Log:
objects-7
* can method for classes and objects
Revision Changes Path
1.13 +6 -3 parrot/classes/parrotclass.pmc
Index: parrotclass.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/parrotclass.pmc,v
retrieving revision 1.12
retrieving revision 1.13
diff -u -w -r1.12 -r1.13
--- parrotclass.pmc 5 Dec 2003 14:37:06 -0000 1.12
+++ parrotclass.pmc 5 Dec 2003 16:40:55 -0000 1.13
@@ -1,7 +1,7 @@
/* parrotclass.pmc
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: parrotclass.pmc,v 1.12 2003/12/05 14:37:06 leo Exp $
+ * $Id: parrotclass.pmc,v 1.13 2003/12/05 16:40:55 leo Exp $
* Overview:
* These are the vtable functions for the ParrotClass base class
* Data Structure and Algorithms:
@@ -51,8 +51,11 @@
* system method lookup code
*/
PMC* find_method(STRING* name) {
- PMC *class = VTABLE_get_pmc_keyed_int(INTERP, (PMC *)PMC_data(SELF), 0);
- return Parrot_find_method_with_cache(INTERP, class, name);
+ return Parrot_find_method_with_cache(INTERP, SELF, name);
+ }
+
+ INTVAL can(STRING* method) {
+ return VTABLE_find_method(interpreter, SELF, method) != NULL;
}
/*
1.14 +6 -1 parrot/classes/parrotobject.pmc
Index: parrotobject.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/parrotobject.pmc,v
retrieving revision 1.13
retrieving revision 1.14
diff -u -w -r1.13 -r1.14
--- parrotobject.pmc 5 Dec 2003 15:08:44 -0000 1.13
+++ parrotobject.pmc 5 Dec 2003 16:40:55 -0000 1.14
@@ -1,7 +1,7 @@
/* parrotobject.pmc
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: parrotobject.pmc,v 1.13 2003/12/05 15:08:44 leo Exp $
+ * $Id: parrotobject.pmc,v 1.14 2003/12/05 16:40:55 leo Exp $
* Overview:
* These are the vtable functions for the ParrotObject base class
* Data Structure and Algorithms:
@@ -47,6 +47,11 @@
void init_pmc_props(PMC* init, PMC* props) {
SELF.init();
+ }
+
+ PMC* find_method(STRING* name) {
+ PMC *class = VTABLE_get_pmc_keyed_int(INTERP, (PMC *)PMC_data(SELF), 0);
+ return Parrot_find_method_with_cache(INTERP, class, name);
}
/*
1.26 +1 -9 parrot/src/objects.c
Index: objects.c
===================================================================
RCS file: /cvs/public/parrot/src/objects.c,v
retrieving revision 1.25
retrieving revision 1.26
diff -u -w -r1.25 -r1.26
--- objects.c 5 Dec 2003 14:37:09 -0000 1.25
+++ objects.c 5 Dec 2003 16:41:00 -0000 1.26
@@ -1,7 +1,7 @@
/* objects.c
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: objects.c,v 1.25 2003/12/05 14:37:09 leo Exp $
+ * $Id: objects.c,v 1.26 2003/12/05 16:41:00 leo Exp $
* Overview:
* Handles class and object manipulation
* Data Structure and Algorithms:
@@ -407,14 +407,6 @@
(PMC *)PMC_data(curclass), PCD_CLASS_NAME)),
shortcut_name, 0);
method = find_global(interpreter, FQ_method);
- }
-
-
- /* Ultimately, if we've failed, pitch an exception */
- if (NULL == method) {
- real_exception(interpreter, NULL, METH_NOT_FOUND,
- "Method '%s' not found\n",
- string_to_cstring(interpreter, method_name));
}
return method;
}
1.2 +44 -1 parrot/t/pmc/object-meths.t
Index: object-meths.t
===================================================================
RCS file: /cvs/public/parrot/t/pmc/object-meths.t,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -w -r1.1 -r1.2
--- object-meths.t 5 Dec 2003 15:54:45 -0000 1.1
+++ object-meths.t 5 Dec 2003 16:41:02 -0000 1.2
@@ -1,6 +1,6 @@
#! perl -w
-use Parrot::Test tests => 2;
+use Parrot::Test tests => 4;
use Test::More;
output_like(<<'CODE', <<'OUTPUT', "callmeth - unknown");
@@ -38,5 +38,48 @@
main
in meth
back
+OUTPUT
+
+output_is(<<'CODE', <<'OUTPUT', "can class");
+ newclass P2, "Foo"
+ set S0, "meth"
+
+ new P3, .Sub
+ # store the sub with the real name
+ store_global "Foo\x0meth", P3
+
+ can I0, P2, "meth"
+ print I0
+ print "\n"
+ can I0, P2, "no_such_meth"
+ print I0
+ print "\n"
+ end
+CODE
+1
+0
+OUTPUT
+
+output_is(<<'CODE', <<'OUTPUT', "can object");
+ newclass P2, "Foo"
+ find_type I0, "Foo"
+ new P2, I0
+
+ set S0, "meth"
+
+ new P3, .Sub
+ # store the sub with the real name
+ store_global "Foo\x0meth", P3
+
+ can I0, P2, "meth"
+ print I0
+ print "\n"
+ can I0, P2, "no_such_meth"
+ print I0
+ print "\n"
+ end
+CODE
+1
+0
OUTPUT
