[Moose-commits] r7745 - in Class-MOP/trunk: lib/Class/MOP lib/Class/MOP/Method t

autarch at code2.0beta.co.uk autarch at code2.0beta.co.uk
Fri Feb 20 17:21:58 GMT 2009


Author: autarch
Date: 2009-02-20 09:21:58 -0800 (Fri, 20 Feb 2009)
New Revision: 7745

Modified:
   Class-MOP/trunk/lib/Class/MOP/Instance.pm
   Class-MOP/trunk/lib/Class/MOP/Method/Accessor.pm
   Class-MOP/trunk/lib/Class/MOP/Method/Constructor.pm
   Class-MOP/trunk/t/061_instance_inline.t
Log:
Make the meta-instance class take a bare attribute name when inlining
attribute-related bits.

Modified: Class-MOP/trunk/lib/Class/MOP/Instance.pm
===================================================================
--- Class-MOP/trunk/lib/Class/MOP/Instance.pm	2009-02-20 17:20:28 UTC (rev 7744)
+++ Class-MOP/trunk/lib/Class/MOP/Instance.pm	2009-02-20 17:21:58 UTC (rev 7745)
@@ -172,7 +172,7 @@
 
 sub inline_slot_access {
     my ($self, $instance, $slot_name) = @_;
-    sprintf "%s->{%s}", $instance, $slot_name;
+    sprintf q[%s->{"%s"}], $instance, quotemeta($slot_name);
 }
 
 sub inline_get_slot_value {

Modified: Class-MOP/trunk/lib/Class/MOP/Method/Accessor.pm
===================================================================
--- Class-MOP/trunk/lib/Class/MOP/Method/Accessor.pm	2009-02-20 17:20:28 UTC (rev 7744)
+++ Class-MOP/trunk/lib/Class/MOP/Method/Accessor.pm	2009-02-20 17:21:58 UTC (rev 7745)
@@ -138,7 +138,7 @@
          {},
         'sub {'
         . 'confess "Cannot assign a value to a read-only accessor" if @_ > 1;'
-        . $meta_instance->inline_get_slot_value('$_[0]', "'$attr_name'")
+        . $meta_instance->inline_get_slot_value('$_[0]', $attr_name)
         . '}'
     );
 }
@@ -152,7 +152,7 @@
     return $self->_eval_closure(
         {},
         'sub {'
-        . $meta_instance->inline_set_slot_value('$_[0]', "'$attr_name'", '$_[1]')
+        . $meta_instance->inline_set_slot_value('$_[0]', $attr_name, '$_[1]')
         . '}'
     );
 }
@@ -167,7 +167,7 @@
     return $self->_eval_closure(
         {},
        'sub {'
-       . $meta_instance->inline_is_slot_initialized('$_[0]', "'$attr_name'")
+       . $meta_instance->inline_is_slot_initialized('$_[0]', $attr_name)
        . '}'
     );
 }
@@ -181,7 +181,7 @@
     return $self->_eval_closure(
         {},
         'sub {'
-        . $meta_instance->inline_deinitialize_slot('$_[0]', "'$attr_name'")
+        . $meta_instance->inline_deinitialize_slot('$_[0]', $attr_name)
         . '}'
     );
 }

Modified: Class-MOP/trunk/lib/Class/MOP/Method/Constructor.pm
===================================================================
--- Class-MOP/trunk/lib/Class/MOP/Method/Constructor.pm	2009-02-20 17:20:28 UTC (rev 7744)
+++ Class-MOP/trunk/lib/Class/MOP/Method/Constructor.pm	2009-02-20 17:21:58 UTC (rev 7745)
@@ -149,12 +149,12 @@
           'if(exists $params->{\'' . $attr->init_arg . '\'}){' . "\n" .
                 $self->meta_instance->inline_set_slot_value(
                     '$instance',
-                    ("'" . $attr->name . "'"),
+                    $attr->name,
                     '$params->{\'' . $attr->init_arg . '\'}' ) . "\n" .
            '} ' . (!defined $default ? '' : 'else {' . "\n" .
                 $self->meta_instance->inline_set_slot_value(
                     '$instance',
-                    ("'" . $attr->name . "'"),
+                    $attr->name,
                      $default ) . "\n" .
            '}')
         );
@@ -162,7 +162,7 @@
         return (
             $self->meta_instance->inline_set_slot_value(
                 '$instance',
-                ("'" . $attr->name . "'"),
+                $attr->name,
                  $default ) . "\n"
         );
     } else { return '' }

Modified: Class-MOP/trunk/t/061_instance_inline.t
===================================================================
--- Class-MOP/trunk/t/061_instance_inline.t	2009-02-20 17:20:28 UTC (rev 7744)
+++ Class-MOP/trunk/t/061_instance_inline.t	2009-02-20 17:21:58 UTC (rev 7745)
@@ -1,7 +1,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 15;
+use Test::More tests => 6;
 use Test::Exception;
 
 use Class::MOP::Instance;
@@ -10,7 +10,7 @@
 
 {
     my $instance  = '$self';
-    my $slot_name = '"foo"';
+    my $slot_name = 'foo';
     my $value     = '$value';
 
     is($C->inline_get_slot_value($instance, $slot_name),
@@ -38,67 +38,4 @@
       '... 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),
-      '',
-      '... got the right code for initialize_slot');
-
-    is($C->inline_is_slot_initialized($instance, $slot_name),
-      'exists $_[0]->{$attr_name}',
-      '... 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');
-
-




More information about the Moose-commits mailing list