From: Fuji, Goro Date: Mon, 27 Sep 2010 02:16:46 +0000 (+0900) Subject: Make get_all_attributes() sorted by their definition order X-Git-Tag: 0.75~8 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=abbcd124154fda138a43e996d4a521c79d16d72d;p=gitmo%2FMouse.git Make get_all_attributes() sorted by their definition order --- diff --git a/author/attr_order.pl b/author/attr_order.pl new file mode 100644 index 0000000..14c688b --- /dev/null +++ b/author/attr_order.pl @@ -0,0 +1,31 @@ +package Base; +use Any::Moose; + +has [qw(aaa bbb ccc)] => ( + is => 'rw', +); + +package D1; +use Any::Moose; +extends qw(Base); +has [qw(ddd eee fff)] => ( + is => 'rw', +); + +package D2; +use Any::Moose; +extends qw(D1); +has [qw(ggg hhh iii)] => ( + is => 'rw', +); + +package main; +use Test::More; +use Test::Mouse; + +with_immutable { + my $attrs_list = join ",", + map { $_->name } D2->meta->get_all_attributes; + is $attrs_list, join ",", qw(aaa bbb ccc ddd eee fff ggg hhh iii); +} qw(Base D1 D2); +done_testing; diff --git a/lib/Mouse/Meta/Class.pm b/lib/Mouse/Meta/Class.pm index 886f9cf..622f142 100644 --- a/lib/Mouse/Meta/Class.pm +++ b/lib/Mouse/Meta/Class.pm @@ -179,14 +179,12 @@ sub get_all_method_names { $self->linearized_isa; } -sub find_attribute_by_name{ +sub find_attribute_by_name { my($self, $name) = @_; - my $attr; - foreach my $class($self->linearized_isa){ - my $meta = Mouse::Util::get_metaclass_by_name($class) or next; - $attr = $meta->get_attribute($name) and last; + foreach my $attr($self->get_all_attributes) { + return $attr if $attr->name eq $name; } - return $attr; + return undef; } sub add_attribute { @@ -231,20 +229,30 @@ sub add_attribute { $attr->install_accessors(); # then register the attribute to the metaclass - $attr->{insertion_order} = keys %{ $self->{attributes} }; - $self->{attributes}{$attr->name} = $attr; + $attr->{insertion_order} = keys %{ $self->{attributes} }; + $self->{attributes}{$name} = $attr; + delete $self->{_mouse_cache}; # clears internal cache if(!$attr->{associated_methods} && ($attr->{is} || '') ne 'bare'){ Carp::carp(qq{Attribute ($name) of class }.$self->name .qq{ has no associated methods (did you mean to provide an "is" argument?)}); } + return $attr; +} - if(!Mouse::Util::MOUSE_XS) { - # in Mouse::PurePerl, attribute initialization code is cached, so it - # must be clear here. See _initialize_object() in Mouse::PurePerl. - delete $self->{_initialize_object}; +sub _calculate_all_attributes { + my($self) = @_; + my %seen; + my @all_attrs; + foreach my $class($self->linearized_isa) { + my $meta = Mouse::Util::get_metaclass_by_name($class) or next; + my @attrs = grep { !$seen{$_->name}++ } values %{$meta->{attributes}}; + @attrs = sort { + $b->{insertion_order} <=> $a->{insertion_order} + } @attrs; + push @all_attrs, @attrs; } - return $attr; + return [reverse @all_attrs]; } sub linearized_isa; diff --git a/lib/Mouse/Meta/Method/Constructor.pm b/lib/Mouse/Meta/Method/Constructor.pm index 29e1ba7..4c362f5 100644 --- a/lib/Mouse/Meta/Method/Constructor.pm +++ b/lib/Mouse/Meta/Method/Constructor.pm @@ -13,9 +13,9 @@ sub _generate_constructor { my $buildall = $class->_generate_BUILDALL($metaclass); my $buildargs = $class->_generate_BUILDARGS($metaclass); - my $initializer = $metaclass->{_initialize_object} ||= do { + my $initializer = $metaclass->{_mouse_cache}{_initialize_object} ||= $class->_generate_initialize_object($metaclass); - }; + my $source = sprintf(<<'EOT', __LINE__, __FILE__, $metaclass->name, $buildargs, $buildall); #line %d %s package %s; diff --git a/lib/Mouse/PurePerl.pm b/lib/Mouse/PurePerl.pm index a4fe59d..a5eab76 100644 --- a/lib/Mouse/PurePerl.pm +++ b/lib/Mouse/PurePerl.pm @@ -282,12 +282,6 @@ sub roles { $_[0]->{roles} } sub linearized_isa { @{ Mouse::Util::get_linear_isa($_[0]->{package}) } } -sub get_all_attributes { - my($self) = @_; - my %attrs = map { %{ $self->initialize($_)->{attributes} } } reverse $self->linearized_isa; - return values %attrs; -} - sub new_object { my $meta = shift; my %args = (@_ == 1 ? %{$_[0]} : @_); @@ -324,13 +318,18 @@ sub _initialize_object{ my($self, $object, $args, $is_cloning) = @_; # The initializer, which is used everywhere, must be clear # when an attribute is added. See Mouse::Meta::Class::add_attribute. - my $initializer = $self->{_initialize_object} ||= do { + my $initializer = $self->{_mouse_cache}{_initialize_object} ||= Mouse::Util::load_class($self->constructor_class) ->_generate_initialize_object($self); - }; goto &{$initializer}; } +sub get_all_attributes { + my($self) = @_; + return @{ $self->{_mouse_cache}{all_attributes} + ||= $self->_calculate_all_attributes }; +} + sub is_immutable { $_[0]->{is_immutable} } sub strict_constructor; diff --git a/xs-src/Mouse.xs b/xs-src/Mouse.xs index b7fd8e5..b8951c1 100644 --- a/xs-src/Mouse.xs +++ b/xs-src/Mouse.xs @@ -49,31 +49,13 @@ enum mouse_modifier_t { static MGVTBL mouse_xc_vtbl; /* for identity */ -static void -mouse_class_push_attribute_list(pTHX_ SV* const metaclass, AV* const attrall, HV* const seen){ - dSP; - I32 n; - - /* $meta->get_attribute_list */ - PUSHMARK(SP); - XPUSHs(metaclass); - PUTBACK; - - n = call_sv(mouse_get_attribute_list, G_ARRAY | G_METHOD); - for(NOOP; n > 0; n--){ - SV* name; - - SPAGAIN; - name = POPs; - PUTBACK; - - if(hv_exists_ent(seen, name, 0U)){ - continue; - } - (void)hv_store_ent(seen, name, &PL_sv_undef, 0U); - - av_push(attrall, newSVsv( mcall1(metaclass, mouse_get_attribute, name) )); +static AV* +mouse_calculate_all_attributes(pTHX_ SV* const metaclass) { + SV* const avref = mcall0s(metaclass, "_calculate_all_attributes"); + if(!(SvROK(avref) && SvTYPE(SvRV(avref)) == SVt_PVAV)) { + croak("$meta->_calculate_all_attributes did not return an ARRAY reference"); } + return (AV*)SvRV(avref); } XS(XS_Mouse__Object_BUILDARGS); /* prototype */ @@ -91,16 +73,13 @@ mouse_class_update_xc(pTHX_ SV* const metaclass PERL_UNUSED_DECL, HV* const stas I32 const len = AvFILLp(linearized_isa) + 1; I32 i; U32 flags = 0x00; - AV* const attrall = newAV(); AV* const buildall = newAV(); AV* const demolishall = newAV(); - HV* const seen = newHV(); /* for attributes */ + AV* attrall; ENTER; SAVETMPS; - sv_2mortal((SV*)seen); - /* old data will be delete at the end of the perl scope */ av_delete(xc, MOUSE_XC_DEMOLISHALL, 0x00); av_delete(xc, MOUSE_XC_BUILDALL, 0x00); @@ -111,6 +90,13 @@ mouse_class_update_xc(pTHX_ SV* const metaclass PERL_UNUSED_DECL, HV* const stas /* update */ + av_store(xc, MOUSE_XC_BUILDALL, (SV*)buildall); + av_store(xc, MOUSE_XC_DEMOLISHALL, (SV*)demolishall); + + attrall = mouse_calculate_all_attributes(aTHX_ metaclass); + SvREFCNT_inc_simple_void_NN(attrall); + av_store(xc, MOUSE_XC_ATTRALL, (SV*)attrall); + if(predicate_calls(metaclass, "is_immutable")){ flags |= MOUSEf_XC_IS_IMMUTABLE; } @@ -128,14 +114,10 @@ mouse_class_update_xc(pTHX_ SV* const metaclass PERL_UNUSED_DECL, HV* const stas } av_store(xc, MOUSE_XC_FLAGS, newSVuv(flags)); - av_store(xc, MOUSE_XC_ATTRALL, (SV*)attrall); - av_store(xc, MOUSE_XC_BUILDALL, (SV*)buildall); - av_store(xc, MOUSE_XC_DEMOLISHALL, (SV*)demolishall); for(i = 0; i < len; i++){ SV* const klass = MOUSE_av_at(linearized_isa, i); HV* const st = gv_stashsv(klass, TRUE); - SV* meta; GV* gv; gv = stash_fetchs(st, "BUILD", FALSE); @@ -148,14 +130,6 @@ mouse_class_update_xc(pTHX_ SV* const metaclass PERL_UNUSED_DECL, HV* const stas if(gv && GvCVu(gv)){ av_push(demolishall, newRV_inc((SV*)GvCV(gv))); } - - /* ATTRIBUTES */ - meta = get_metaclass(klass); - if(!SvOK(meta)){ - continue; /* skip non-Mouse classes */ - } - - mouse_class_push_attribute_list(aTHX_ meta, attrall, seen); } FREETMPS;