From: Yuval Kogman <nothingmuch@woobling.org>
Date: Wed, 13 Aug 2008 21:21:36 +0000 (+0000)
Subject: _new for Class::MOP::Class
X-Git-Tag: 0_64_01~19
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=f3938c217bb3ff340d2744a56385df03b6847c3f;p=gitmo%2FClass-MOP.git

_new for Class::MOP::Class
---

diff --git a/lib/Class/MOP/Class.pm b/lib/Class/MOP/Class.pm
index 33ed1e9..fa2c920 100644
--- a/lib/Class/MOP/Class.pm
+++ b/lib/Class/MOP/Class.pm
@@ -82,40 +82,7 @@ sub construct_class_instance {
     my $meta;
     if ($class eq 'Class::MOP::Class') {
         no strict 'refs';
-        $meta = bless {
-            # inherited from Class::MOP::Package
-            'package'             => $package_name,
-
-            # NOTE:
-            # since the following attributes will
-            # actually be loaded from the symbol
-            # table, and actually bypass the instance
-            # entirely, we can just leave these things
-            # listed here for reference, because they
-            # should not actually have a value associated
-            # with the slot.
-            'namespace'           => \undef,
-            # inherited from Class::MOP::Module
-            'version'             => \undef,
-            'authority'           => \undef,
-            # defined in Class::MOP::Class
-            'superclasses'        => \undef,
-
-            'methods'             => {},
-            'attributes'          => {},
-            'attribute_metaclass' => $options{'attribute_metaclass'} || 'Class::MOP::Attribute',
-            'method_metaclass'    => $options{'method_metaclass'}    || 'Class::MOP::Method',
-            'instance_metaclass'  => $options{'instance_metaclass'}  || 'Class::MOP::Instance',
-            
-            ## uber-private variables
-            # NOTE:
-            # this starts out as undef so that 
-            # we can tell the first time the 
-            # methods are fetched
-            # - SL
-            '_package_cache_flag'       => undef,  
-            '_meta_instance'            => undef,          
-        } => $class;
+        $meta = $class->_new(%options)
     }
     else {
         # NOTE:
@@ -138,6 +105,35 @@ sub construct_class_instance {
     $meta;
 }
 
+sub _new {
+    my ( $class, %options ) = @_;
+    bless {
+        # inherited from Class::MOP::Package
+        'package'             => $options{package},
+
+        # NOTE:
+        # since the following attributes will
+        # actually be loaded from the symbol
+        # table, and actually bypass the instance
+        # entirely, we can just leave these things
+        # listed here for reference, because they
+        # should not actually have a value associated
+        # with the slot.
+        'namespace'           => \undef,
+        # inherited from Class::MOP::Module
+        'version'             => \undef,
+        'authority'           => \undef,
+        # defined in Class::MOP::Class
+        'superclasses'        => \undef,
+
+        'methods'             => {},
+        'attributes'          => {},
+        'attribute_metaclass' => $options{'attribute_metaclass'} || 'Class::MOP::Attribute',
+        'method_metaclass'    => $options{'method_metaclass'}    || 'Class::MOP::Method',
+        'instance_metaclass'  => $options{'instance_metaclass'}  || 'Class::MOP::Instance',
+    }, $class;
+}
+
 sub reset_package_cache_flag  { (shift)->{'_package_cache_flag'} = undef } 
 sub update_package_cache_flag {
     my $self = shift;
diff --git a/lib/Class/MOP/Method/Generated.pm b/lib/Class/MOP/Method/Generated.pm
index a38a3ba..61ae408 100644
--- a/lib/Class/MOP/Method/Generated.pm
+++ b/lib/Class/MOP/Method/Generated.pm
@@ -18,7 +18,7 @@ sub new {
     ($options{package_name} && $options{name})
         || confess "You must supply the package_name and name parameters $Class::MOP::Method::UPGRADE_ERROR_TEXT";     
         
-    my $self = $self->_new(%options);
+    my $self = $class->_new(%options);
     
     $self->initialize_body;
     
@@ -26,7 +26,7 @@ sub new {
 }
 
 sub _new {
-    my ( $self, %options ) = @_;
+    my ( $class, %options ) = @_;
 
     $options{is_inline} ||= 0;
     $options{body} ||= undef;
diff --git a/lib/Class/MOP/Object.pm b/lib/Class/MOP/Object.pm
index defd47d..1b7d2c5 100644
--- a/lib/Class/MOP/Object.pm
+++ b/lib/Class/MOP/Object.pm
@@ -16,11 +16,6 @@ sub meta {
     Class::MOP::Class->initialize(blessed($_[0]) || $_[0]);
 }
 
-sub _new {
-    my ( $class, @args ) = @_;
-    Class::MOP::Class->initialize($class)->new_object(@args);
-}
-
 # RANT:
 # Cmon, how many times have you written 
 # the following code while debugging:
diff --git a/t/073_make_mutable.t b/t/073_make_mutable.t
index 1c29981..8880f27 100644
--- a/t/073_make_mutable.t
+++ b/t/073_make_mutable.t
@@ -45,7 +45,7 @@ BEGIN {
 {
     my $meta = Baz->meta;
     is($meta->name, 'Baz', '... checking the Baz metaclass');
-    my @orig_keys = sort keys %$meta;
+    my @orig_keys = sort grep { !/^_/ } keys %$meta;
 
     lives_ok {$meta->make_immutable; } '... changed Baz to be immutable';
     ok(!$meta->is_mutable,              '... our class is no longer mutable');
@@ -61,7 +61,7 @@ BEGIN {
     ok(!$meta->get_method_map->{new},   '... inlined constructor removed');
     ok(!$meta->has_method('new'),        '... inlined constructor removed for sure');    
 
-    my @new_keys = sort keys %$meta;
+    my @new_keys = sort grep { !/^_/ } keys %$meta;
     is_deeply(\@orig_keys, \@new_keys, '... no straneous hashkeys');
 
     isa_ok($meta, 'Class::MOP::Class', '... Baz->meta isa Class::MOP::Class');
@@ -132,7 +132,7 @@ BEGIN {
 
     ok(Baz->meta->is_immutable,  'Superclass is immutable');
     my $meta = Baz->meta->create_anon_class(superclasses => ['Baz']);
-    my @orig_keys  = sort keys %$meta;
+    my @orig_keys  = sort grep { !/^_/ } keys %$meta;
     my @orig_meths = sort { $a->{name} cmp $b->{name} }
       $meta->compute_all_applicable_methods;
     ok($meta->is_anon_class,                  'We have an anon metaclass');
@@ -156,7 +156,7 @@ BEGIN {
     ok($meta->is_anon_class,          '... still marked as an anon class');
     my $instance = $meta->new_object;
 
-    my @new_keys  = sort keys %$meta;
+    my @new_keys  = sort grep { !/^_/ } keys %$meta;
     my @new_meths = sort { $a->{name} cmp $b->{name} }
       $meta->compute_all_applicable_methods;
     is_deeply(\@orig_keys, \@new_keys, '... no straneous hashkeys');