You are viewing a plain text version of this content. The canonical link for it is here.
Posted to commits@lucy.apache.org by ma...@apache.org on 2011/01/20 01:22:40 UTC
[lucy-commits] svn commit: r1061073 - in /incubator/lucy/trunk/clownfish: lib/Clownfish/
lib/Clownfish/Binding/Core/ lib/Clownfish/Binding/Perl/ t/
Author: marvin
Date: Thu Jan 20 00:22:39 2011
New Revision: 1061073
URL: http://svn.apache.org/viewvc?rev=1061073&view=rev
Log:
Change several methods in Clownfish::Class which return a list to return an
arrayref instead.
Modified:
incubator/lucy/trunk/clownfish/lib/Clownfish/Binding/Core/Class.pm
incubator/lucy/trunk/clownfish/lib/Clownfish/Binding/Perl/Class.pm
incubator/lucy/trunk/clownfish/lib/Clownfish/Binding/Perl/Constructor.pm
incubator/lucy/trunk/clownfish/lib/Clownfish/Class.pm
incubator/lucy/trunk/clownfish/lib/Clownfish/Dumpable.pm
incubator/lucy/trunk/clownfish/lib/Clownfish/Hierarchy.pm
incubator/lucy/trunk/clownfish/t/400-class.t
incubator/lucy/trunk/clownfish/t/403-file.t
Modified: incubator/lucy/trunk/clownfish/lib/Clownfish/Binding/Core/Class.pm
URL: http://svn.apache.org/viewvc/incubator/lucy/trunk/clownfish/lib/Clownfish/Binding/Core/Class.pm?rev=1061073&r1=1061072&r2=1061073&view=diff
==============================================================================
--- incubator/lucy/trunk/clownfish/lib/Clownfish/Binding/Core/Class.pm (original)
+++ incubator/lucy/trunk/clownfish/lib/Clownfish/Binding/Core/Class.pm Thu Jan 20 00:22:39 2011
@@ -65,7 +65,7 @@ sub _vtable_definition {
my $self = shift;
my $client = $self->{client};
my $parent = $client->get_parent;
- my @methods = $client->methods;
+ my $methods = $client->methods;
my $vt_type = $client->full_vtable_type;
my $cnick = $client->get_cnick;
my $vtable_var = $client->full_vtable_var;
@@ -82,7 +82,7 @@ sub _vtable_definition {
# Spec functions which implement the methods, casting to quiet compiler.
my @implementing_funcs
- = map { "(cfish_method_t)" . $_->full_func_sym } @methods;
+ = map { "(cfish_method_t)" . $_->full_func_sym } @$methods;
my $method_string = join( ",\n ", @implementing_funcs );
my $num_methods = scalar @implementing_funcs;
@@ -112,7 +112,7 @@ sub _struct_definition {
my $self = shift;
my $struct_sym = $self->{client}->full_struct_sym;
my $member_declarations = join( "\n ",
- map { $_->local_declaration } $self->{client}->member_vars );
+ map { $_->local_declaration } @{ $self->{client}->member_vars } );
return <<END_STRUCT
struct $struct_sym {
$member_declarations
@@ -124,10 +124,10 @@ sub to_c_header {
my $self = shift;
my $client = $self->{client};
my $cnick = $client->get_cnick;
- my @functions = $client->functions;
- my @methods = $client->methods;
- my @novel_methods = $client->novel_methods;
- my @inert_vars = $client->inert_vars;
+ my $functions = $client->functions;
+ my $methods = $client->methods;
+ my $novel_methods = $client->novel_methods;
+ my $inert_vars = $client->inert_vars;
my $vtable_var = $client->full_vtable_var;
my $short_vt_var = $client->short_vtable_var;
my $short_struct = $client->get_struct_sym;
@@ -144,28 +144,28 @@ sub to_c_header {
# Add a C function definition for each method and each function.
my $sub_declarations = "";
- for my $sub ( @functions, @novel_methods ) {
+ for my $sub ( @$functions, @$novel_methods ) {
$sub_declarations
.= Clownfish::Binding::Core::Function->func_declaration($sub)
. "\n\n";
}
# Declare class (a.k.a. "inert") variables.
- my $inert_vars = "";
- for my $inert_var ( $client->inert_vars ) {
- $inert_vars .= "extern " . $inert_var->global_c . ";\n";
+ my $inert_var_defs = "";
+ for my $inert_var (@$inert_vars) {
+ $inert_var_defs .= "extern " . $inert_var->global_c . ";\n";
}
# Declare typedefs for novel methods, to ease casting.
my $method_typedefs = '';
- for my $method (@novel_methods) {
+ for my $method (@$novel_methods) {
$method_typedefs
.= Clownfish::Binding::Core::Method->typedef_dec($method) . "\n";
}
# Define method invocation syntax.
my $method_defs = '';
- for my $method (@methods) {
+ for my $method (@$methods) {
$method_defs .= Clownfish::Binding::Core::Method->method_def(
method => $method,
class => $self->{client},
@@ -177,11 +177,11 @@ sub to_c_header {
my $vt = "extern struct $vt_type ${vtable_var}_vt;";
my $vtable_object
= "#define $vtable_var ((cfish_VTable*)&${vtable_var}_vt)";
- my $num_methods = scalar @methods;
+ my $num_methods = scalar @$methods;
# Declare cfish_Callback objects.
my $callback_declarations = "";
- for my $method (@novel_methods) {
+ for my $method (@$novel_methods) {
next unless $method->public || $method->abstract;
$callback_declarations
.= Clownfish::Binding::Core::Method->callback_dec($method);
@@ -190,18 +190,18 @@ sub to_c_header {
# Define short names.
my $short_names = '';
my $short_names_macro = _short_names_macro($self);
- for my $function (@functions) {
+ for my $function (@$functions) {
my $short_func_sym = $function->short_sym;
my $full_func_sym = $function->full_sym;
$short_names .= " #define $short_func_sym $full_func_sym\n";
}
- for my $inert_var (@inert_vars) {
+ for my $inert_var (@$inert_vars) {
my $short_sym = $inert_var->short_sym;
my $full_sym = $inert_var->full_sym;
$short_names .= " #define $short_sym $full_sym\n";
}
if ( !$client->inert ) {
- for my $method (@novel_methods) {
+ for my $method (@$novel_methods) {
if ( !$method->isa("Clownfish::Method::Overridden") ) {
my $short_typedef = $method->short_typedef;
my $full_typedef = $method->full_typedef;
@@ -211,7 +211,7 @@ sub to_c_header {
my $full_func_sym = $method->full_func_sym;
$short_names .= " #define $short_func_sym $full_func_sym\n";
}
- for my $method (@methods) {
+ for my $method (@$methods) {
my $short_method_sym = $method->short_method_sym($cnick);
my $full_method_sym = $method->full_method_sym($cnick);
$short_names .= " #define $short_method_sym $full_method_sym\n";
@@ -228,7 +228,7 @@ sub to_c_header {
#include "boil.h"
$parent_include
-$inert_vars
+$inert_var_defs
$sub_declarations
@@ -250,7 +250,7 @@ $parent_include
$struct_def
#endif /* $c_file_sym */
-$inert_vars
+$inert_var_defs
$sub_declarations
$callback_declarations
@@ -303,9 +303,9 @@ sub to_c {
my @class_callbacks;
# Prepare to identify novel methods.
- my %novel = map { ( $_->micro_sym => $_ ) } $client->novel_methods;
+ my %novel = map { ( $_->micro_sym => $_ ) } @{ $client->novel_methods };
- for my $method ( $client->methods ) {
+ for my $method ( @{ $client->methods } ) {
my $var_name = $method->full_offset_sym($cnick);
# Create offset in bytes for the method from the top of the VTable
Modified: incubator/lucy/trunk/clownfish/lib/Clownfish/Binding/Perl/Class.pm
URL: http://svn.apache.org/viewvc/incubator/lucy/trunk/clownfish/lib/Clownfish/Binding/Perl/Class.pm?rev=1061073&r1=1061072&r2=1061073&view=diff
==============================================================================
--- incubator/lucy/trunk/clownfish/lib/Clownfish/Binding/Perl/Class.pm (original)
+++ incubator/lucy/trunk/clownfish/lib/Clownfish/Binding/Perl/Class.pm Thu Jan 20 00:22:39 2011
@@ -99,7 +99,7 @@ sub method_bindings {
# Iterate over all this class's methods, stopping to bind each one that
# was spec'd.
- for my $method ( $client->methods ) {
+ for my $method ( @{ $client->methods } ) {
my $meth_name = $method->get_macro_sym;
my $bind_args = delete $meth_to_bind{$meth_name};
next unless $bind_args;
@@ -119,7 +119,7 @@ sub method_bindings {
# calls the implementing function, rather than invokes the method on
# the object using VTable method dispatch. Doing things this way
# allows SUPER:: invocations from Perl-space to work properly.
- for my $descendant ( $client->tree_to_ladder ) { # includes self
+ for my $descendant ( @{ $client->tree_to_ladder } ) { # includes self
my $real_method = $descendant->novel_method( lc($meth_name) );
next unless $real_method;
Modified: incubator/lucy/trunk/clownfish/lib/Clownfish/Binding/Perl/Constructor.pm
URL: http://svn.apache.org/viewvc/incubator/lucy/trunk/clownfish/lib/Clownfish/Binding/Perl/Constructor.pm?rev=1061073&r1=1061072&r2=1061073&view=diff
==============================================================================
--- incubator/lucy/trunk/clownfish/lib/Clownfish/Binding/Perl/Constructor.pm (original)
+++ incubator/lucy/trunk/clownfish/lib/Clownfish/Binding/Perl/Constructor.pm Thu Jan 20 00:22:39 2011
@@ -30,7 +30,7 @@ sub new {
# Find the implementing function.
my $func;
- for my $function ( $class->functions ) {
+ for my $function ( @{ $class->functions } ) {
next unless $function->micro_sym eq $init_func_name;
$func = $function;
last;
Modified: incubator/lucy/trunk/clownfish/lib/Clownfish/Class.pm
URL: http://svn.apache.org/viewvc/incubator/lucy/trunk/clownfish/lib/Clownfish/Class.pm?rev=1061073&r1=1061072&r2=1061073&view=diff
==============================================================================
--- incubator/lucy/trunk/clownfish/lib/Clownfish/Class.pm (original)
+++ incubator/lucy/trunk/clownfish/lib/Clownfish/Class.pm Thu Jan 20 00:22:39 2011
@@ -105,8 +105,8 @@ sub create {
$self->{cnick} ||= $self->{class_cnick};
# Make it possible to look up methods and functions by name.
- $self->{meth_by_name}{ $_->micro_sym } = $_ for $self->methods;
- $self->{func_by_name}{ $_->micro_sym } = $_ for $self->functions;
+ $self->{meth_by_name}{ $_->micro_sym } = $_ for @{ $self->methods };
+ $self->{func_by_name}{ $_->micro_sym } = $_ for @{ $self->functions };
# Derive struct name.
confess("Missing required param 'class_name'") unless $self->{class_name};
@@ -188,23 +188,26 @@ sub full_vtable_type { shift->full_vtabl
sub append_autocode { $_[0]->{autocode} .= $_[1] }
-sub functions { @{ shift->{functions} } }
-sub methods { @{ shift->{methods} } }
-sub member_vars { @{ shift->{member_vars} } }
-sub inert_vars { @{ shift->{inert_vars} } }
-sub children { @{ shift->{children} } }
+sub functions { shift->{functions} }
+sub methods { shift->{methods} }
+sub member_vars { shift->{member_vars} }
+sub inert_vars { shift->{inert_vars} }
+sub children { shift->{children} }
sub novel_methods {
my $self = shift;
- return
- grep { $_->get_class_cnick eq $self->{cnick} } @{ $self->{methods} };
+ my @methods
+ = grep { $_->get_class_cnick eq $self->{cnick} }
+ @{ $self->{methods} };
+ return \@methods;
}
sub novel_member_vars {
my $self = shift;
- return
- grep { $_->get_class_cnick eq $self->{cnick} }
+ my @member_vars
+ = grep { $_->get_class_cnick eq $self->{cnick} }
@{ $self->{member_vars} };
+ return \@member_vars;
}
sub function {
@@ -334,9 +337,9 @@ sub tree_to_ladder {
my $self = shift;
my @ladder = ($self);
for my $child ( @{ $self->{children} } ) {
- push @ladder, $child->tree_to_ladder;
+ push @ladder, @{ $child->tree_to_ladder };
}
- return @ladder;
+ return \@ladder;
}
1;
@@ -462,45 +465,45 @@ novel.
=head2 children
- my @child_classes = $class->children;
+ my $child_classes = $class->children;
-Return all child classes as a list.
+Return an array of all child classes.
=head2 functions
- my @functions = $class->functions;
+ my $functions = $class->functions;
-Return all (inert) functions as a list.
+Return an array of all (inert) functions.
=head2 methods
- my @methods = $class->methods;
+ my $methods = $class->methods;
-Return all methods as a list.
+Return an array of all methods.
=head2 inert_vars
- my @inert_vars = $class->inert_vars;
+ my $inert_vars = $class->inert_vars;
-Return all inert (shared, class) variables as a list.
+Return an array of all inert (shared, class) variables.
=head2 member_vars
- my @members = $class->member_vars;
+ my $members = $class->member_vars;
-Return all member variables as a list.
+Return an array of all member variables.
=head2 novel_methods
- my @novel_methods = $class->novel_methods;
+ my $novel_methods = $class->novel_methods;
-Return all novel methods as a list.
+Return an array of all novel methods.
=head2 novel_member_vars
- my @new_members = $class->novel_member_vars;
+ my $new_members = $class->novel_member_vars;
-Return all novel member variables as a list.
+Return an array of all novel member variables.
=head2 grow_tree
@@ -510,7 +513,7 @@ Bequeath all inherited methods and membe
=head2 tree_to_ladder
- my @ordered = $class->tree_to_ladder;
+ my $ordered = $class->tree_to_ladder;
Return this class and all its child classes as an array, where all children
appear after their parent nodes.
Modified: incubator/lucy/trunk/clownfish/lib/Clownfish/Dumpable.pm
URL: http://svn.apache.org/viewvc/incubator/lucy/trunk/clownfish/lib/Clownfish/Dumpable.pm?rev=1061073&r1=1061072&r2=1061073&view=diff
==============================================================================
--- incubator/lucy/trunk/clownfish/lib/Clownfish/Dumpable.pm (original)
+++ incubator/lucy/trunk/clownfish/lib/Clownfish/Dumpable.pm Thu Jan 20 00:22:39 2011
@@ -36,7 +36,7 @@ sub add_dumpables {
# Inherit Dump/Load from parent if no novel member vars.
my $parent = $class->get_parent;
if ( $parent and $parent->has_attribute('dumpable') ) {
- return unless scalar $class->novel_member_vars;
+ return unless scalar @{ $class->novel_member_vars };
}
if ( !$class->novel_method('Dump') ) {
@@ -116,7 +116,7 @@ $full_func_sym($full_struct *self)
{
cfish_Hash *dump = (cfish_Hash*)$super_dump(($super_type*)self);
END_STUFF
- @members = $class->novel_member_vars;
+ @members = @{ $class->novel_member_vars };
}
else {
$autocode = <<END_STUFF;
@@ -127,7 +127,7 @@ $full_func_sym($full_struct *self)
Cfish_Hash_Store_Str(dump, "_class", 6,
(cfish_Obj*)Cfish_CB_Clone(Cfish_Obj_Get_Class_Name((cfish_Obj*)self)));
END_STUFF
- @members = $class->member_vars;
+ @members = @{ $class->member_vars };
shift @members; # skip self->vtable
shift @members; # skip refcount self->ref
}
@@ -186,7 +186,7 @@ $full_func_sym($full_struct *self, cfish
= ($full_struct*)$super_load(($super_type*)self, dump);
CHY_UNUSED_VAR(self);
END_STUFF
- @members = $class->novel_member_vars;
+ @members = @{ $class->novel_member_vars };
}
else {
$autocode = <<END_STUFF;
@@ -200,7 +200,7 @@ $full_func_sym($full_struct *self, cfish
$full_struct *loaded = ($full_struct*)Cfish_VTable_Make_Obj(vtable);
CHY_UNUSED_VAR(self);
END_STUFF
- @members = $class->member_vars;
+ @members = @{ $class->member_vars };
shift @members; # skip self->vtable
shift @members; # skip refcount self->ref
}
Modified: incubator/lucy/trunk/clownfish/lib/Clownfish/Hierarchy.pm
URL: http://svn.apache.org/viewvc/incubator/lucy/trunk/clownfish/lib/Clownfish/Hierarchy.pm?rev=1061073&r1=1061072&r2=1061073&view=diff
==============================================================================
--- incubator/lucy/trunk/clownfish/lib/Clownfish/Hierarchy.pm (original)
+++ incubator/lucy/trunk/clownfish/lib/Clownfish/Hierarchy.pm Thu Jan 20 00:22:39 2011
@@ -61,7 +61,7 @@ sub ordered_classes {
my $self = shift;
my @all;
for my $tree ( values %{ $self->_get_trees } ) {
- push @all, $tree->tree_to_ladder;
+ push @all, @{ $tree->tree_to_ladder };
}
return @all;
}
@@ -164,7 +164,7 @@ sub _propagate_modified {
# Proceed to the next generation.
my $somebody_is_modified = $modified;
- for my $kid ( $class->children ) {
+ for my $kid ( @{ $class->children } ) {
if ( $class->final ) {
confess( "Attempt to inherit from final class "
. $class->get_class_name . " by "
Modified: incubator/lucy/trunk/clownfish/t/400-class.t
URL: http://svn.apache.org/viewvc/incubator/lucy/trunk/clownfish/t/400-class.t?rev=1061073&r1=1061072&r2=1061073&view=diff
==============================================================================
--- incubator/lucy/trunk/clownfish/t/400-class.t (original)
+++ incubator/lucy/trunk/clownfish/t/400-class.t Thu Jan 20 00:22:39 2011
@@ -124,23 +124,20 @@ is( $foo_jr->method("Do_Stuff"), $do_
ok( !$foo_jr->novel_method("Do_Stuff"), 'inherited method not novel' );
ok( $final_foo->method("Do_Stuff")->final, "Finalize inherited method" );
ok( !$foo_jr->method("Do_Stuff")->final, "Don't finalize method in parent" );
-is_deeply( [ $foo->inert_vars ], [$widget], "inert vars" );
-is_deeply( [ $foo->functions ], [$tread_water], "inert funcs" );
-is_deeply( [ $foo->methods ], [$do_stuff], "methods" );
-is_deeply( [ $foo->novel_methods ], [$do_stuff], "novel_methods" );
-is_deeply( [ $foo->novel_member_vars ], [$thing], "novel_member_vars" );
-is_deeply( [ $foo_jr->member_vars ], [$thing], "inherit member vars" );
-is_deeply( [ $foo_jr->functions ], [], "don't inherit inert funcs" );
-is_deeply( [ $foo_jr->novel_member_vars ], [], "novel_member_vars" );
-is_deeply( [ $foo_jr->inert_vars ], [], "don't inherit inert vars" );
-is_deeply( [ $final_foo->novel_methods ], [], "novel_methods" );
+is_deeply( $foo->inert_vars, [$widget], "inert vars" );
+is_deeply( $foo->functions, [$tread_water], "inert funcs" );
+is_deeply( $foo->methods, [$do_stuff], "methods" );
+is_deeply( $foo->novel_methods, [$do_stuff], "novel_methods" );
+is_deeply( $foo->novel_member_vars, [$thing], "novel_member_vars" );
+is_deeply( $foo_jr->member_vars, [$thing], "inherit member vars" );
+is_deeply( $foo_jr->functions, [], "don't inherit inert funcs" );
+is_deeply( $foo_jr->novel_member_vars, [], "novel_member_vars" );
+is_deeply( $foo_jr->inert_vars, [], "don't inherit inert vars" );
+is_deeply( $final_foo->novel_methods, [], "novel_methods" );
like( $foo_jr->get_autocode, qr/load/i, "autogenerate Dump/Load" );
-is_deeply(
- [ $foo->tree_to_ladder ],
- [ $foo, $foo_jr, $final_foo ],
- 'tree_to_ladder'
-);
+is_deeply( $foo->tree_to_ladder, [ $foo, $foo_jr, $final_foo ],
+ 'tree_to_ladder' );
ok( $parser->class_modifier($_), "class_modifier: $_" )
for (qw( abstract inert ));
@@ -152,7 +149,7 @@ my $class_content
= 'public class Foo::FooJr cnick FooJr inherits Foo { private int num; }';
my $class = $parser->class_declaration($class_content);
isa_ok( $class, "Clownfish::Class", "class_declaration FooJr" );
-ok( ( scalar grep { $_->micro_sym eq 'num' } $class->member_vars ),
+ok( ( scalar grep { $_->micro_sym eq 'num' } @{ $class->member_vars } ),
"parsed private member var" );
$class_content = q|
@@ -188,30 +185,30 @@ $class_content = q|
$class = $parser->class_declaration($class_content);
isa_ok( $class, "Clownfish::Class", "class_declaration Dog" );
-ok( ( scalar grep { $_->micro_sym eq 'num_dogs' } $class->inert_vars ),
+ok( ( scalar grep { $_->micro_sym eq 'num_dogs' } @{ $class->inert_vars } ),
"parsed inert var" );
-ok( ( scalar grep { $_->micro_sym eq 'mom' } $class->member_vars ),
+ok( ( scalar grep { $_->micro_sym eq 'mom' } @{ $class->member_vars } ),
"parsed public member var" );
-ok( ( scalar grep { $_->micro_sym eq 'squishy' } $class->member_vars ),
+ok( ( scalar grep { $_->micro_sym eq 'squishy' } @{ $class->member_vars } ),
"parsed parcel member var" );
-ok( ( scalar grep { $_->micro_sym eq 'init' } $class->functions ),
+ok( ( scalar grep { $_->micro_sym eq 'init' } @{ $class->functions } ),
"parsed function" );
-ok( ( scalar grep { $_->micro_sym eq 'chase_tail' } $class->methods ),
+ok( ( scalar grep { $_->micro_sym eq 'chase_tail' } @{ $class->methods } ),
"parsed private method" );
-ok( ( scalar grep { $_->micro_sym eq 'destroy' } $class->methods ),
+ok( ( scalar grep { $_->micro_sym eq 'destroy' } @{ $class->methods } ),
"parsed parcel method" );
-ok( ( scalar grep { $_->micro_sym eq 'bury' } $class->methods ),
+ok( ( scalar grep { $_->micro_sym eq 'bury' } @{ $class->methods } ),
"parsed public method" );
-ok( ( scalar grep { $_->micro_sym eq 'scratch' } $class->methods ),
+ok( ( scalar grep { $_->micro_sym eq 'scratch' } @{ $class->methods } ),
"parsed public abstract nullable method" );
-for my $method ( $class->methods ) {
+for my $method ( @{ $class->methods } ) {
if ( $method->micro_sym eq 'scratch' ) {
ok( $method->{return_type}->nullable,
"public abstract incremented nullable flagged as nullable" );
}
}
-is( ( scalar grep { $_->public } $class->methods ),
+is( ( scalar grep { $_->public } @{ $class->methods } ),
6, "pass acl to Method constructor" );
ok( $class->has_attribute('lovable'), "parsed class attribute" );
ok( $class->has_attribute('drooly'), "parsed second class attribute" );
Modified: incubator/lucy/trunk/clownfish/t/403-file.t
URL: http://svn.apache.org/viewvc/incubator/lucy/trunk/clownfish/t/403-file.t?rev=1061073&r1=1061072&r2=1061073&view=diff
==============================================================================
--- incubator/lucy/trunk/clownfish/t/403-file.t (original)
+++ incubator/lucy/trunk/clownfish/t/403-file.t Thu Jan 20 00:22:39 2011
@@ -54,7 +54,7 @@ is( $file->h_path('/path/to'), "/path/
my @classes = $file->classes;
is( scalar @classes, 1, "classes() filters blocks" );
my $class = $classes[0];
-my ( $foo, $bar ) = $class->member_vars;
+my ( $foo, $bar ) = @{ $class->member_vars };
is( $foo->get_type->get_specifier,
'stuff_Foo', 'file production picked up parcel def' );
is( $bar->get_type->get_specifier, 'stuff_Bar', 'parcel def is sticky' );
@@ -67,6 +67,6 @@ isa_ok( $blocks[2], "Clownfish::CBlock"
$file = $parser->file( $class_content, 0, source_class => 'Stuff::Thing' );
($class) = $file->classes;
-( $foo, $bar ) = $class->member_vars;
+( $foo, $bar ) = @{ $class->member_vars };
is( $foo->get_type->get_specifier, 'Foo', 'file production resets parcel' );