upload

diff --git a/lib/Class/MOP/Instance.pm b/lib/Class/MOP/Instance.pm
index 48c63ef..6cb6f0a 100644 (file)
--- 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<is_slot_initialized ($instance_structure, $slot_name)>
 
-=item B<set_slot_value_weak ($instance_structure, $slot_name, $ref_value)>
+=item B<weaken_slot_value ($instance_structure, $slot_name)>
+
+=item B<strengthen_slot_value ($instance_structure, $slot_name)>
+
+=back
+
+=head2 Inlineable Instance Operations
+
+=over 4
+
+=item B<inline_slot_access ($instance_structure, $slot_name)>
+
+=item B<inline_get_slot_value ($instance_structure, $slot_name)>
+
+=item B<inline_set_slot_value ($instance_structure, $slot_name, $value)>
+
+=item B<inline_initialize_slot ($instance_structure, $slot_name)>
+
+=item B<inline_is_slot_initialized ($instance_structure, $slot_name)>
 
-=item B<weaken_slot_value>
+=item B<inline_weaken_slot_value ($instance_structure, $slot_name)>
 
-=item B<strengthen_slot_value>
+=item B<inline_strengthen_slot_value ($instance_structure, $slot_name)>
 
 =back
 

diff --git a/lib/Class/MOP/Instance/Inlinable.pm b/lib/Class/MOP/Instance/Inlinable.pm
deleted file mode 100644 (file)
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<Class::MOP::Instance>, 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 (file)
--- 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 (file)
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