closed
Stevan Little [Wed, 5 Jul 2006 18:02:35 +0000 (18:02 +0000)]
lib/Class/MOP.pm
lib/Class/MOP/Attribute.pm
lib/Class/MOP/Class/Immutable.pm
lib/Class/MOP/Method.pm
t/000_load.t

index afc68bc..aa78547 100644 (file)
@@ -188,6 +188,16 @@ Class::MOP::Attribute->meta->add_method('clone' => sub {
     $self->meta->clone_object($self, @_);  
 });
 
+## Try and close Class::MOP::*
+
+Class::MOP::Package  ->meta->make_immutable(inline_constructor => 0);
+Class::MOP::Module   ->meta->make_immutable(inline_constructor => 0);
+Class::MOP::Class    ->meta->make_immutable(inline_constructor => 0);
+Class::MOP::Attribute->meta->make_immutable(inline_constructor => 0);
+Class::MOP::Method   ->meta->make_immutable(inline_constructor => 0);
+Class::MOP::Instance ->meta->make_immutable(inline_constructor => 0);
+
+
 1;
 
 __END__
index c4c0d6b..5352826 100644 (file)
@@ -150,8 +150,8 @@ sub generate_accessor_method_inline {
     my $meta_instance = $self->associated_class->instance_metaclass;
 
     my $code = eval 'sub {'
-        . $meta_instance->inline_set_slot_value('$_[0]', $attr_name, '$_[1]')  . ' if scalar(@_) == 2; '
-        . $meta_instance->inline_get_slot_value('$_[0]', $attr_name)
+        . $meta_instance->inline_set_slot_value('$_[0]', "'$attr_name'", '$_[1]')  . ' if scalar(@_) == 2; '
+        . $meta_instance->inline_get_slot_value('$_[0]', "'$attr_name'")
     . '}';
     confess "Could not generate inline accessor because : $@" if $@;
 
@@ -176,7 +176,7 @@ sub generate_reader_method_inline {
 
     my $code = eval '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'")
     . '}';
     confess "Could not generate inline accessor because : $@" if $@;
 
@@ -199,7 +199,7 @@ sub generate_writer_method_inline {
     my $meta_instance = $self->associated_class->instance_metaclass;
 
     my $code = eval 'sub {'
-        . $meta_instance->inline_set_slot_value('$_[0]', $attr_name, '$_[1]')
+        . $meta_instance->inline_set_slot_value('$_[0]', "'$attr_name'", '$_[1]')
     . '}';
     confess "Could not generate inline accessor because : $@" if $@;
 
@@ -222,7 +222,7 @@ sub generate_predicate_method_inline {
     my $meta_instance = $self->associated_class->instance_metaclass;
 
     my $code = eval 'sub {'
-        . 'defined ' . $meta_instance->inline_get_slot_value('$_[0]', $attr_name) . ' ? 1 : 0'
+        . 'defined ' . $meta_instance->inline_get_slot_value('$_[0]', "'$attr_name'") . ' ? 1 : 0'
     . '}';
     confess "Could not generate inline accessor because : $@" if $@;
 
@@ -234,7 +234,7 @@ sub process_accessors {
     if (reftype($accessor)) {
         (reftype($accessor) eq 'HASH')
             || confess "bad accessor/reader/writer/predicate format, must be a HASH ref";
-        my ($name, $method) = each %{$accessor};
+        my ($name, $method) = %{$accessor};
         return ($name, Class::MOP::Attribute::Accessor->wrap($method));        
     }
     else {
index a94a12b..bbe5429 100644 (file)
@@ -45,9 +45,12 @@ sub make_immutable { () }
 sub make_metaclass_immutable {
     my ($class, $metaclass, %options) = @_;
     
-    $options{inline_accessors}   ||= 1;
-    $options{inline_constructor} ||= 1;
-    $options{constructor_name}   ||= 'new';
+    # NOTE:
+    # i really need the // (defined-or) operator here
+    $options{inline_accessors}   = 1     unless exists $options{inline_accessors};
+    $options{inline_constructor} = 1     unless exists $options{inline_constructor};
+    $options{constructor_name}   = 'new' unless exists $options{constructor_name};
+    $options{debug}              = 0     unless exists $options{debug};
     
     my $meta_instance = $metaclass->get_meta_instance;
     $metaclass->{'___class_precedence_list'}             = [ $metaclass->class_precedence_list ];
@@ -174,6 +177,32 @@ to this class.
 
 =back
 
+=head2 Introspection and Construction
+
+=over 4
+
+=item B<make_metaclass_immutable>
+
+=over 4
+
+=item I<inline_accessors (Bool)>
+
+=item I<inline_constructor (Bool)>
+
+=item I<debug (Bool)>
+
+=item I<constructor_name (Str)>
+
+=back
+
+=item B<is_immutable>
+
+=item B<is_mutable>
+
+=item B<make_immutable>
+
+=back
+
 =head2 Methods which will die if you touch them.
 
 =over 4
@@ -210,20 +239,6 @@ to this class.
 
 =back
 
-=head2 Introspection and Construction
-
-=over 4
-
-=item B<is_immutable>
-
-=item B<is_mutable>
-
-=item B<make_immutable>
-
-=item B<make_metaclass_immutable>
-
-=back
-
 =head1 AUTHOR
 
 Stevan Little E<lt>stevan@iinteractive.comE<gt>
index c07895d..e2ca21d 100644 (file)
@@ -23,7 +23,7 @@ sub wrap {
     my $class = shift;
     my $code  = shift;
     ('CODE' eq (reftype($code) || ''))
-        || confess "You must supply a CODE reference to bless";
+        || confess "You must supply a CODE reference to bless, not (" . ($code || 'undef') . ")";
     bless $code => blessed($class) || $class;
 }
 
index 8e88fc0..0dd8492 100644 (file)
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 8;
+use Test::More tests => 14;
 
 BEGIN {
     use_ok('Class::MOP');
@@ -24,6 +24,8 @@ my %METAS = (
     'Class::MOP::Instance'  => Class::MOP::Instance->meta,      
 );
 
+ok($_->is_immutable(), '... ' . $_->name . ' is immutable') for values %METAS;
+
 is_deeply(
     { Class::MOP::Class->get_all_metaclasses },
     \%METAS,