Author: chromatic
Date: Mon Apr 16 23:27:57 2007
New Revision: 18254
Modified:
trunk/src/pmc/class.pmc
trunk/t/oo/composition.t
trunk/t/oo/metamodel.t
trunk/t/oo/mro-c3.t
trunk/t/pmc/class.t
Changes in other areas also in this revision:
Modified:
trunk/docs/pdds/pdd15_objects.pod
Log:
Implemented isa() method on Class.
Cleaned up some whitespace problems in other OO tests, while I was at it.
Modified: trunk/src/pmc/class.pmc
==============================================================================
--- trunk/src/pmc/class.pmc (original)
+++ trunk/src/pmc/class.pmc Mon Apr 16 23:27:57 2007
@@ -93,7 +93,7 @@
STRING *fq_class = string_from_cstring(interp, "", 0);
STRING *seperator = string_from_const_cstring(interp, "::", 0);
if (!PMC_IS_NULL(class_info->namespace)) {
- /* If we have a namespace name, make a key from it's name. */
+ /* If we have a namespace name, make a key from its name. */
/* XXX BAD AND WRONG! Need to call get_name method properly! */
PMC *fq_name = Parrot_NameSpace_nci_get_name(interp,
class_info->namespace);
int elements = VTABLE_elements(interp, fq_name);
@@ -1030,6 +1030,22 @@
PCCRETURN(PMC *found);
}
+
+/*
+
+=item C<void isa(STRING *class_name)>
+
+Returns true if this object is or derives from the class named in
+C<class_name>, false otherwise.
+
+=cut
+
+*/
+ PCCMETHOD void isa(STRING *class_name) {
+ INTVAL isa = VTABLE_isa(interp, SELF, class_name);
+
+ PCCRETURN(INTVAL isa);
+ }
} /* END pmclass */
/*
Modified: trunk/t/oo/composition.t
==============================================================================
--- trunk/t/oo/composition.t (original)
+++ trunk/t/oo/composition.t Mon Apr 16 23:27:57 2007
@@ -26,7 +26,7 @@
.sub 'test' :main
$P0 = new Role
$P1 = new Class
-
+
$P1.'add_role'($P0)
print "ok 1 - added role\n"
@@ -36,7 +36,7 @@
print "not "
OK_2:
print "ok 2 - roles list has the role\n"
-
+
$P2 = $P1.'new'()
print "ok 3 - instantiated class with composed role\n"
.end
@@ -54,7 +54,7 @@
$P2 = find_global "badger"
$P0.'add_method'("badger", $P2)
print "ok 1 - added method to a role\n"
-
+
$P1.'add_role'($P0)
print "ok 2 - composed role into the class\n"
@@ -64,7 +64,7 @@
print "not "
OK_3:
print "ok 3 - roles list has the role\n"
-
+
$P2 = $P1.'new'()
print "ok 4 - instantiated class with composed role\n"
@@ -355,21 +355,21 @@
pir_output_is( <<'CODE', <<'OUT', 'role that does a role' );
.sub 'test' :main
.local pmc PHB, Manage, FirePeople
-
+
FirePeople = new Role
$P0 = find_global 'fire'
FirePeople.'add_method'("fire", $P0)
-
+
Manage = new Role
$P0 = find_global 'give_payrise'
FirePeople.'add_method'("give_payrise", $P0)
Manage.'add_role'(FirePeople)
print "ok 1 - adding one role to another happens\n"
-
+
PHB = new Class
PHB.'add_role'(Manage)
print "ok 2 - added one rule that does another role to the class\n"
-
+
$P0 = PHB.'new'()
$P0.give_payrise()
print "ok 3 - called method from direct role\n"
@@ -396,16 +396,16 @@
pir_output_is( <<'CODE', <<'OUT', 'conflict from indirect role' );
.sub 'test' :main
.local pmc BurninatorBoss, Manage, FirePeople, Burninator
-
+
FirePeople = new Role
$P0 = find_global 'fire'
FirePeople.'add_method'("fire", $P0)
-
+
Manage = new Role
$P0 = find_global 'give_payrise'
FirePeople.'add_method'("give_payrise", $P0)
Manage.'add_role'(FirePeople)
-
+
Burninator = new Role
$P0 = find_global 'fire2'
Burninator.'add_method'("fire", $P0)
Modified: trunk/t/oo/metamodel.t
==============================================================================
--- trunk/t/oo/metamodel.t (original)
+++ trunk/t/oo/metamodel.t Mon Apr 16 23:27:57 2007
@@ -30,7 +30,7 @@
.local pmc class, init_args1
init_args1 = new 'Hash'
init_args1['name'] = 'Dog'
-
+
class = new "Class", init_args1
isa_ok(class, "Class", "created class isa Class")
$S1 = class.name()
@@ -105,7 +105,7 @@
unless got_value goto get_attr
setattribute self, attrib, value
get_attr:
- .local pmc rv
+ .local pmc rv
rv = getattribute self, attrib
.return(rv)
.end
Modified: trunk/t/oo/mro-c3.t
==============================================================================
--- trunk/t/oo/mro-c3.t (original)
+++ trunk/t/oo/mro-c3.t Mon Apr 16 23:27:57 2007
@@ -108,7 +108,7 @@
$P0 = find_global 'testB'
B.'add_method'("foo", $P0)
B.'add_method'("bar", $P0)
-
+
C = new .Class
C.'add_parent'(B)
C.'add_parent'(A)
@@ -159,7 +159,7 @@
$P0 = find_global 'testC'
C.'add_method'("foo", $P0)
C.'add_method'("bar", $P0)
-
+
D = new .Class
D.'add_parent'(C)
D.'add_parent'(B)
Modified: trunk/t/pmc/class.t
==============================================================================
--- trunk/t/pmc/class.t (original)
+++ trunk/t/pmc/class.t Mon Apr 16 23:27:57 2007
@@ -6,7 +6,7 @@
use warnings;
use lib qw( . lib ../lib ../../lib );
use Test::More;
-use Parrot::Test tests => 13;
+use Parrot::Test tests => 14;
=head1 NAME
@@ -106,7 +106,7 @@
print 'not '
ok_1:
say 'ok 1 - new() with no args returns an object'
-
+
push_eh ok_2
$P1 = $P0.'new'('abc' => '123' )
clear_eh
@@ -295,7 +295,7 @@
$P1 = $P0.inspect()
print "ok 1 - inspect with no args called\n"
-
+
$I0 = elements $P1
if $I0 == 6 goto ok_2
print "not "
@@ -305,7 +305,7 @@
$P1 = $P0.inspect('name')
say $P1
print "ok 3 - inspect('name')\n"
-
+
$P1 = $P0.inspect('attributes')
$I0 = elements $P1
if $I0 == 1 goto ok_4
@@ -329,7 +329,7 @@
$P1.add_attribute('banana')
$P2 = $P1.'new'()
print "ok 1 - created class Monkey and instantiated it\n"
-
+
$P3 = clone $P1
print "ok 2 - cloned class Monkey\n"
@@ -372,7 +372,7 @@
$P1.add_attribute('banana')
$P2 = $P1.'new'()
print "ok 1 - created class Monkey and instantiated it\n"
-
+
$P0 = new 'Hash'
$P0['name'] = 'Mandrill'
$P3 = clone $P1, $P0
@@ -439,7 +439,7 @@
$P3 = 5
setattribute $P2, 'y', $P3
print "ok 3 - set second attribute\n"
-
+
# Call method.
$P3 = $P2.add()
print $P3
@@ -460,6 +460,40 @@
ok 4 - called method
OUT
+# L<PDD15/Class PMC API/=item isa>
+pir_output_is( <<'CODE', <<'OUT', 'isa()' );
+.sub 'test' :main
+ new $P0, .Class
+
+ test_isa( $P0, 'Class' )
+ test_isa( $P0, 'Hash' )
+ test_isa( $P0, 'Foo' )
+.end
+
+.sub 'test_isa'
+ .param pmc obj
+ .param string class
+
+ $I0 = obj.'isa'( class )
+ if $I0 goto is_class
+ print "Not a "
+ print class
+ print "\n"
+ .return()
+
+ is_class:
+ print "Is a "
+ print class
+ print "\n"
+
+ .return()
+.end
+CODE
+Is a Class
+Not a Hash
+Not a Foo
+OUT
+
# Local Variables:
# mode: cperl
# cperl-indent-level: 4
