From: Stevan Little Date: Sun, 30 Apr 2006 21:48:46 +0000 (+0000) Subject: upload X-Git-Tag: 0_29_02~23 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=ee7c04677234b6bfa7eddc0896ef4255e713d1b2;p=gitmo%2FClass-MOP.git upload --- diff --git a/lib/Class/MOP/Instance.pm b/lib/Class/MOP/Instance.pm index 48c63ef..6cb6f0a 100644 --- a/lib/Class/MOP/Instance.pm +++ b/lib/Class/MOP/Instance.pm @@ -78,12 +78,6 @@ sub is_slot_initialized { exists $instance->{$slot_name} ? 1 : 0; } -sub set_slot_value_weak { - my ($self, $instance, $slot_name, $value) = @_; - $self->set_slot_value($instance, $slot_name, $value); - $self->weaken_slot_value($instance, $slot_name); -} - sub weaken_slot_value { my ($self, $instance, $slot_name) = @_; weaken $instance->{$slot_name}; @@ -94,6 +88,43 @@ sub strengthen_slot_value { $self->set_slot_value($instance, $slot_name, $self->get_slot_value($instance, $slot_name)); } +# inlinable operation snippets + +sub inline_slot_access { + my ($self, $instance, $slot_name) = @_; + sprintf "%s->{%s}", $instance, $slot_name; +} + +sub inline_get_slot_value { + my ($self, $instance, $slot_name) = @_; + $self->inline_slot_access($instance, $slot_name); +} + +sub inline_set_slot_value { + my ($self, $instance, $slot_name, $value) = @_; + $self->inline_slot_access($instance, $slot_name) . " = $value", +} + +sub inline_initialize_slot { + my ($self, $instance, $slot_name) = @_; + $self->inline_set_slot_value($instance, $slot_name, 'undef'), +} + +sub inline_is_slot_initialized { + my ($self, $instance, $slot_name) = @_; + "exists " . $self->inline_slot_access($instance, $slot_name) . " ? 1 : 0"; +} + +sub inline_weaken_slot_value { + my ($self, $instance, $slot_name) = @_; + sprintf "Scalar::Util::weaken( %s )", $self->inline_slot_access($instance, $slot_name); +} + +sub inline_strengthen_slot_value { + my ($self, $instance, $slot_name) = @_; + $self->inline_set_slot_value($instance, $slot_name, $self->inline_slot_access($instance, $slot_name)); +} + 1; __END__ @@ -197,11 +228,29 @@ require that the C<$instance_structure> is passed into them. =item B -=item B +=item B + +=item B + +=back + +=head2 Inlineable Instance Operations + +=over 4 + +=item B + +=item B + +=item B + +=item B + +=item B -=item B +=item B -=item B +=item B =back diff --git a/lib/Class/MOP/Instance/Inlinable.pm b/lib/Class/MOP/Instance/Inlinable.pm deleted file mode 100644 index ac0729e..0000000 --- a/lib/Class/MOP/Instance/Inlinable.pm +++ /dev/null @@ -1,88 +0,0 @@ -#!/usr/bin/perl - -package Class::MOP::Instance::Inlinable; - -use strict; -use warnings; - -# cheap ass pseudo-mixin - -# inlinable operation snippets - -sub inline_get_slot_value { - my ($self, $instance, $slot_name) = @_; - sprintf "%s->{%s}", $instance, $slot_name; -} - -sub inline_set_slot_value { - my ($self, $instance, $slot_name, $value) = @_; - $self->_inline_slot_lvalue( $instance, $slot_name ) . " = $value", -} - -sub inline_set_slot_value_with_init { - my ($self, $instance, $slot_name, $value) = @_; - - $self->_join_statements( - $self->inline_initialize_slot( $instance, $slot_name ), - $self->inline_set_slot_value( $instance, $slot_name, $value ), - ); -} - -sub inline_set_slot_value_weak { - my ($self, $instance, $slot_name, $value) = @_; - - $self->_join_statements( - $self->inline_set_slot_value( $instance, $slot_name, $value ), - $self->inline_weaken_slot_value( $instance, $slot_name ), - ); -} - -sub inline_weaken_slot_value { - my ($self, $instance, $slot_name) = @_; - sprintf "Scalar::Util::weaken( %s )", $self->_inline_slot_lvalue( $instance, $slot_name ); -} - -sub inline_initialize_slot { - return ""; -} - -sub inline_slot_initialized { - my ($self, $instance, $slot_name) = @_; - "exists " . $self->inline_get_slot_value; -} - -sub _join_statements { - my ( $self, @statements ) = @_; - my @filtered = grep { length } @statements; - return $filtered[0] if @filtered == 1; - return join("; ", @filtered); -} - -sub _inline_slot_lvalue { - my ($self, $instance, $slot_name) = @_; - $self->inline_get_slot_value( $instance, $slot_name ); -} - -__PACKAGE__; - -__END__ - -=pod - -=head1 NAME - -Class::MOP::Instance::Inlinable - Generate inline slot operations. - -=head1 SYNOPSIS - - # see Moose::Meta::Attribute for an example - -=head1 DESCRIPTION - -This pseudo-mixin class provides additional methods to work along side -L, which can be used to generate accessors with inlined -slot operations. - -=cut - - diff --git a/t/060_instance.t b/t/060_instance.t index 579cc59..9362034 100644 --- a/t/060_instance.t +++ b/t/060_instance.t @@ -3,7 +3,7 @@ use strict; use warnings; -use Test::More 'no_plan'; +use Test::More tests => 39; use Test::Exception; use Scalar::Util qw/isweak reftype/; @@ -19,12 +19,22 @@ can_ok( "Class::MOP::Instance", $_ ) for qw/ bless_instance_structure get_all_slots + + initialize_all_slots get_slot_value set_slot_value initialize_slot - initialize_all_slots is_slot_initialized + weaken_slot_value + strengthen_slot_value + + inline_get_slot_value + inline_set_slot_value + inline_initialize_slot + inline_is_slot_initialized + inline_weaken_slot_value + inline_strengthen_slot_value /; { @@ -73,16 +83,15 @@ ok(!defined($mi_foo->get_slot_value( $i_foo, "moosen" )), "... no value for slot $mi_foo->set_slot_value( $i_foo, "moosen", "the value" ); is($mi_foo->get_slot_value( $i_foo, "moosen" ), "the value", "... get slot value"); - ok(!$i_foo->can('moosen'), '... Foo cant moosen'); -can_ok( $mi_foo, "set_slot_value_weak" ); - my $ref = []; -$mi_foo->set_slot_value_weak( $i_foo, "moosen", $ref ); -is( $mi_foo->get_slot_value( $i_foo, "moosen" ), $ref, "weak value is fetchable" ); +$mi_foo->set_slot_value( $i_foo, "moosen", $ref ); +$mi_foo->weaken_slot_value( $i_foo, "moosen" ); +ok( isweak($i_foo->{moosen}), '... white box test of weaken' ); +is( $mi_foo->get_slot_value( $i_foo, "moosen" ), $ref, "weak value is fetchable" ); ok( !isweak($mi_foo->get_slot_value( $i_foo, "moosen" )), "return value not weak" ); undef $ref; @@ -101,18 +110,15 @@ $mi_foo->weaken_slot_value( $i_foo, "moosen" ); is( $mi_foo->get_slot_value( $i_foo, "moosen" ), undef, "weak value destroyed" ); - $ref = []; $mi_foo->set_slot_value( $i_foo, "moosen", $ref ); - - $mi_foo->weaken_slot_value( $i_foo, "moosen" ); - +ok( isweak($i_foo->{moosen}), '... white box test of weaken' ); $mi_foo->strengthen_slot_value( $i_foo, "moosen" ); +ok( !isweak($i_foo->{moosen}), '... white box test of weaken' ); undef $ref; is( reftype( $mi_foo->get_slot_value( $i_foo, "moosen" ) ), "ARRAY", "weak value can be strengthened" ); - diff --git a/t/061_instance_inline.t b/t/061_instance_inline.t new file mode 100644 index 0000000..3e8c89f --- /dev/null +++ b/t/061_instance_inline.t @@ -0,0 +1,108 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More tests => 16; +use Test::Exception; + +BEGIN { + use_ok('Class::MOP::Instance'); +} + +my $C = 'Class::MOP::Instance'; + +{ + my $instance = '$self'; + my $slot_name = '"foo"'; + my $value = '$value'; + + is($C->inline_get_slot_value($instance, $slot_name), + '$self->{"foo"}', + '... got the right code for get_slot_value'); + + is($C->inline_set_slot_value($instance, $slot_name, $value), + '$self->{"foo"} = $value', + '... got the right code for set_slot_value'); + + is($C->inline_initialize_slot($instance, $slot_name), + '$self->{"foo"} = undef', + '... got the right code for initialize_slot'); + + is($C->inline_is_slot_initialized($instance, $slot_name), + 'exists $self->{"foo"} ? 1 : 0', + '... got the right code for get_slot_value'); + + is($C->inline_weaken_slot_value($instance, $slot_name), + 'Scalar::Util::weaken( $self->{"foo"} )', + '... got the right code for weaken_slot_value'); + + is($C->inline_strengthen_slot_value($instance, $slot_name), + '$self->{"foo"} = $self->{"foo"}', + '... got the right code for strengthen_slot_value'); +} + +{ + my $instance = '$_[0]'; + my $slot_name = '$attr_name'; + my $value = '[]'; + + is($C->inline_get_slot_value($instance, $slot_name), + '$_[0]->{$attr_name}', + '... got the right code for get_slot_value'); + + is($C->inline_set_slot_value($instance, $slot_name, $value), + '$_[0]->{$attr_name} = []', + '... got the right code for set_slot_value'); + + is($C->inline_initialize_slot($instance, $slot_name), + '$_[0]->{$attr_name} = undef', + '... got the right code for initialize_slot'); + + is($C->inline_is_slot_initialized($instance, $slot_name), + 'exists $_[0]->{$attr_name} ? 1 : 0', + '... got the right code for get_slot_value'); + + is($C->inline_weaken_slot_value($instance, $slot_name), + 'Scalar::Util::weaken( $_[0]->{$attr_name} )', + '... got the right code for weaken_slot_value'); + + is($C->inline_strengthen_slot_value($instance, $slot_name), + '$_[0]->{$attr_name} = $_[0]->{$attr_name}', + '... got the right code for strengthen_slot_value'); +} + +my $accessor_string = "sub {\n" +. $C->inline_set_slot_value('$_[0]', '$attr_name', '$_[1]') +. " if scalar \@_ == 2;\n" +. $C->inline_get_slot_value('$_[0]', '$attr_name') +. ";\n}"; + +is($accessor_string, + q|sub { +$_[0]->{$attr_name} = $_[1] if scalar @_ == 2; +$_[0]->{$attr_name}; +}|, + '... got the right code string for accessor'); + +my $reader_string = "sub {\n" +. $C->inline_get_slot_value('$_[0]', '$attr_name') +. ";\n}"; + +is($reader_string, + q|sub { +$_[0]->{$attr_name}; +}|, + '... got the right code string for reader'); + +my $writer_string = "sub {\n" +. $C->inline_set_slot_value('$_[0]', '$attr_name', '$_[1]') +. ";\n}"; + +is($writer_string, + q|sub { +$_[0]->{$attr_name} = $_[1]; +}|, + '... got the right code string for writer'); + + \ No newline at end of file