Author: chromatic
Date: Thu May 17 18:59:37 2007
New Revision: 18582
Modified:
trunk/src/pmc/class.pmc
trunk/src/pmc/role.pmc
trunk/t/pmc/class.t
Log:
[OO] Fix does() (RT #42974).
Note for the record that the return values of string_compare() and
string_equal() suck. That's why this bug stuck around for so long. That's my
apologia anyhow.
Modified: trunk/src/pmc/class.pmc
==============================================================================
--- trunk/src/pmc/class.pmc (original)
+++ trunk/src/pmc/class.pmc Thu May 17 18:59:37 2007
@@ -1096,26 +1096,28 @@
*/
PCCMETHOD void does(STRING *role_name) {
- INTVAL i, role_count;
- PMC *role_list = ((Parrot_Class *)PMC_data(SELF))->roles;
+ INTVAL i, role_count, isa;
+ PMC *role_list = (PMC_data_typed(SELF, Parrot_Class *))->roles;
- /* not a coding standards violation; the macro expands greatly! */
- if (!role_list) {
+ if (!role_list)
PCCRETURN(INTVAL 0);
- }
role_count = VTABLE_elements(interp, role_list);
for (i = 0; i < role_count; i++) {
- STRING *r_name;
- PMC *role = VTABLE_get_pmc_keyed_int(interp, role_list, i);
- (STRING *r_name) = PCCINVOKE(interp, role, "name");
+ INTVAL role_does;
+ PMC *role = VTABLE_get_pmc_keyed_int(interp, role_list,
i);
+
+ (INTVAL role_does) = PCCINVOKE(interp, role, "does",
+ STRING *role_name);
- if (string_compare(interp, role_name, r_name))
+ if (role_does)
PCCRETURN(INTVAL 1);
}
- PCCRETURN(INTVAL 0);
+ (INTVAL isa) = PCCINVOKE(interp, SELF, "isa", STRING *role_name);
+
+ PCCRETURN(INTVAL isa);
}
} /* END pmclass */
Modified: trunk/src/pmc/role.pmc
==============================================================================
--- trunk/src/pmc/role.pmc (original)
+++ trunk/src/pmc/role.pmc Thu May 17 18:59:37 2007
@@ -611,6 +611,11 @@
PMC* alias_method :optional :named["alias_method"],
int got_alias_method :opt_flag) {
Parrot_Role *role_info = PARROT_ROLE(SELF);
+ STRING *s_name, *r_name;
+
+ (STRING *s_name) = PCCINVOKE( interp, SELF, "name" );
+ (STRING *r_name) = PCCINVOKE( interp, role, "name" );
+
Parrot_ComposeRole(interp, role, exclude_method, got_exclude_method,
alias_method, got_alias_method,
role_info->methods, role_info->roles);
@@ -638,6 +643,42 @@
PCCRETURN(PMC *found);
}
+/*
+
+=item C<void does(STRING *role)>
+
+Returns true if this role (or any role composed into this one) performs the
+named role. This will recurse through all roles as far back as it can.
+
+=cut
+
+*/
+
+ PCCMETHOD void does(STRING *name) {
+ INTVAL i, count;
+ STRING *r_name;
+ PMC *roles, *role;
+
+ (STRING *r_name) = PCCINVOKE(interp, SELF, "name");
+
+ if (string_equal(interp, r_name, name) == 0)
+ PCCRETURN(INTVAL 1);
+
+ (PMC *roles) = PCCINVOKE(interp, SELF, "roles");
+ count = VTABLE_elements(interp, roles);
+
+ for (i = 0; i < count; i++) {
+ INTVAL does;
+ role = VTABLE_get_pmc_keyed_int(interp, roles, i);
+ (INTVAL does) = PCCINVOKE(interp, role, "does", STRING *name);
+
+ if (does)
+ PCCRETURN(INTVAL 1);
+ }
+
+ PCCRETURN(INTVAL 0);
+ }
+
} /* end pmclass Role */
Modified: trunk/t/pmc/class.t
==============================================================================
--- trunk/t/pmc/class.t (original)
+++ trunk/t/pmc/class.t Thu May 17 18:59:37 2007
@@ -6,7 +6,7 @@
use warnings;
use lib qw( . lib ../lib ../../lib );
use Test::More;
-use Parrot::Test tests => 15;
+use Parrot::Test tests => 16;
=head1 NAME
@@ -553,6 +553,52 @@
Does Class
OUT
+# L<PDD15/Class PMC API/=item does>
+pir_output_is( <<'CODE', <<'OUT', 'more does() - RT #42974' );
+.const int TESTS = 2
+
+.sub 'main' :main
+ load_bytecode 'Test/More.pir'
+ .local pmc exp, test_ns
+ test_ns = get_namespace ['Test::More']
+ exp = new 'Exporter'
+ exp.'source'(test_ns)
+ exp.'import'('plan ok is diag isa_ok' :named('globals'))
+
+ plan(TESTS)
+
+ .local pmc attrs
+ attrs = new 'Hash'
+
+ .local pmc red, green, blue
+ attrs['name'] = 'Red'
+ red = new 'Role', attrs
+
+ attrs['name'] = 'Green'
+ green = new 'Role', attrs
+
+ attrs['name'] = 'Blue'
+ blue = new 'Role', attrs
+
+ green.'add_role'( blue )
+
+ .local pmc color
+ color = new 'Class'
+
+ $S0 = 'Red'
+ $I0 = color.'does'($S0)
+ is($I0, 0, 'does not Red')
+
+ color.'add_role'( red )
+ $I0 = color.'does'($S0)
+ is($I0, 1, 'does Red')
+.end
+CODE
+1..2
+ok 1 - does not Red
+ok 2 - does Red
+OUT
+
# Local Variables:
# mode: cperl
# cperl-indent-level: 4
