X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMoose%2FMeta%2FClass.pm;h=1cd802152d47c554494b28c7e1ec03764953c2a6;hb=ed771761c8be1e83bc1cdd26c4f763dba5ba7cd2;hp=b1c642d1609553139887dd30d82f20599b23ead1;hpb=349cda54dc7757032705b5485612b7cedfa2e2d5;p=gitmo%2FMoose.git diff --git a/lib/Moose/Meta/Class.pm b/lib/Moose/Meta/Class.pm index b1c642d..1cd8021 100644 --- a/lib/Moose/Meta/Class.pm +++ b/lib/Moose/Meta/Class.pm @@ -11,7 +11,7 @@ use List::Util qw( first ); use List::MoreUtils qw( any all uniq first_index ); use Scalar::Util 'weaken', 'blessed'; -our $VERSION = '0.77'; +our $VERSION = '0.84'; $VERSION = eval $VERSION; our $AUTHORITY = 'cpan:STEVAN'; @@ -227,26 +227,12 @@ sub new_object { return $self; } -sub _construct_instance { - my $class = shift; - my $params = @_ == 1 ? $_[0] : {@_}; - my $meta_instance = $class->get_meta_instance; - # FIXME: - # the code below is almost certainly incorrect - # but this is foreign inheritance, so we might - # have to kludge it in the end. - my $instance = $params->{'__INSTANCE__'} || $meta_instance->create_instance(); - foreach my $attr ($class->get_all_attributes()) { - $attr->initialize_instance_slot($meta_instance, $instance, $params); - } - return $instance; -} - sub superclasses { my $self = shift; my @supers = @_; foreach my $super (@supers) { - my $meta = Class::MOP::load_class($super); + Class::MOP::load_class($super); + my $meta = Class::MOP::class_of($super); Moose->throw_error("You cannot inherit from a Moose Role ($super)") if $meta && $meta->isa('Moose::Meta::Role') } @@ -257,11 +243,17 @@ sub superclasses { sub add_attribute { my $self = shift; - $self->SUPER::add_attribute( + my $attr = (blessed $_[0] && $_[0]->isa('Class::MOP::Attribute') ? $_[0] - : $self->_process_attribute(@_)) - ); + : $self->_process_attribute(@_)); + $self->SUPER::add_attribute($attr); + # it may be a Class::MOP::Attribute, theoretically, which doesn't have + # 'bare' and doesn't implement this method + if ($attr->can('_check_associated_methods')) { + $attr->_check_associated_methods; + } + return $attr; } sub add_override_method_modifier { @@ -308,18 +300,20 @@ sub _fix_metaclass_incompatibility { my $meta = Class::MOP::Class->initialize($super); my @all_supers = $meta->linearized_isa; - shift(@all_supers); # Discard self - my @super_metas_to_fix = ( $meta ); - - # We need to check&fix the imediate superclass, and if its @ISA contains - # a class without a metaclass instance, followed by a class with a - # metaclass instance, init a metaclass instance for classes without - # one and fix compat up to and including the class which was already - # initialized. + shift @all_supers; + + my @super_metas_to_fix = ($meta); + + # We need to check & fix the immediate superclass. If its @ISA + # contains a class without a metaclass instance, followed by a + # class _with_ a metaclass instance, init a metaclass instance + # for classes without one and fix compat up to and including + # the class which was already initialized. my $idx = first_index { Class::MOP::class_of($_) } @all_supers; - push(@super_metas_to_fix, - map { Class::MOP::Class->initialize($_) } @all_supers[0..$idx] - ) if ($idx >= 0); + + push @super_metas_to_fix, + map { Class::MOP::Class->initialize($_) } @all_supers[ 0 .. $idx ] + if $idx >= 0; foreach my $super_meta (@super_metas_to_fix) { $self->_fix_one_incompatible_metaclass($super_meta); @@ -338,6 +332,7 @@ sub _fix_one_incompatible_metaclass { . $self->name . ", it isn't pristine" ); } + $self->_reconcile_with_superclass_meta($meta); }