From: gfx Date: Fri, 25 Sep 2009 10:21:21 +0000 (+0900) Subject: Tidy X-Git-Tag: 0.35~14 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FMouse.git;a=commitdiff_plain;h=7ca5c5fb6e084d9c57bc022b336458afc74c6847 Tidy --- diff --git a/Changes b/Changes index 77fd27e..d068913 100644 --- a/Changes +++ b/Changes @@ -3,6 +3,8 @@ Revision history for Mouse 0.33_02 * Make sure to work on 5.6.2 + * Remove Class::Method::Modifiers dependency + * Remove testing modules from inc/ 0.33_01 Thu Sep 24 16:16:57 2009 diff --git a/author/generate-mouse-tiny.pl b/author/generate-mouse-tiny.pl index 469032a..0484cdb 100755 --- a/author/generate-mouse-tiny.pl +++ b/author/generate-mouse-tiny.pl @@ -16,6 +16,7 @@ find({ push @files, $_ if -f $_ && !/Squirrel/ + && !/TypeRegistory/ && !/\bouse/ && !/\.sw[po]$/ }, diff --git a/lib/Mouse/Meta/Attribute.pm b/lib/Mouse/Meta/Attribute.pm index 67889db..7d6d68e 100644 --- a/lib/Mouse/Meta/Attribute.pm +++ b/lib/Mouse/Meta/Attribute.pm @@ -203,8 +203,6 @@ sub _create_args { $_[0]->{_create_args} } -sub accessor_metaclass { 'Mouse::Meta::Method::Accessor' } - sub interpolate_class{ my($class, $name, $args) = @_; @@ -277,7 +275,7 @@ sub verify_type_constraint_error { sub coerce_constraint { ## my($self, $value) = @_; my $type = $_[0]->{type_constraint} or return $_[1]; - return Mouse::Util::TypeConstraints->typecast_constraints($_[0]->associated_class->name, $_[0]->type_constraint, $_[1]); + return Mouse::Util::TypeConstraints->typecast_constraints($_[0]->associated_class->name, $type, $_[1]); } sub _canonicalize_handles { @@ -299,7 +297,7 @@ sub clone_and_inherit_options{ my $self = shift; my $name = shift; - return ref($self)->new($name, %{$self}, @_ == 1 ? %{$_[0]} : @_); + return ref($self)->new($name, %{$self}, (@_ == 1) ? %{$_[0]} : @_); } sub clone_parent { @@ -312,7 +310,7 @@ sub clone_parent { . "Use \$meta->add_attribute and \$attr->install_accessors instead."); - $self->create($class, $name, %args); + $self->clone_and_inherited_args($class, $name, %args); } sub get_parent_args { @@ -333,17 +331,19 @@ sub install_accessors{ my($attribute) = @_; my $metaclass = $attribute->{associated_class}; - my $generator_class = $attribute->accessor_metaclass; foreach my $type(qw(accessor reader writer predicate clearer handles)){ if(exists $attribute->{$type}){ my $installer = '_install_' . $type; - $generator_class->$installer($attribute, $attribute->{$type}, $metaclass); + + Mouse::Meta::Method::Accessor->$installer($attribute, $attribute->{$type}, $metaclass); + $attribute->{associated_methods}++; } } if($attribute->can('create') != \&create){ + # backword compatibility $attribute->create($metaclass, $attribute->name, %{$attribute}); } diff --git a/lib/Mouse/Meta/Class.pm b/lib/Mouse/Meta/Class.pm index b991ab2..97d5ee3 100644 --- a/lib/Mouse/Meta/Class.pm +++ b/lib/Mouse/Meta/Class.pm @@ -352,7 +352,7 @@ sub _install_modifier { my ( $self, $into, $type, $name, $code ) = @_; # load Class::Method::Modifiers first - my $no_cmm_fast = $ENV{MOUSE_NO_CMM_FAST} || do{ + my $no_cmm_fast = do{ local $@; eval q{ require Class::Method::Modifiers::Fast }; $@; diff --git a/lib/Mouse/Meta/Method/Constructor.pm b/lib/Mouse/Meta/Method/Constructor.pm index d8d8ab5..ea37419 100644 --- a/lib/Mouse/Meta/Method/Constructor.pm +++ b/lib/Mouse/Meta/Method/Constructor.pm @@ -6,17 +6,19 @@ sub generate_constructor_method_inline { my ($class, $metaclass) = @_; my $associated_metaclass_name = $metaclass->name; - my @attrs = $metaclass->get_all_attributes; - my $buildall = $class->_generate_BUILDALL($metaclass); - my $buildargs = $class->_generate_BUILDARGS($metaclass); - my $processattrs = $class->_generate_processattrs($metaclass, \@attrs); + my @attrs = $metaclass->get_all_attributes; + + my $buildall = $class->_generate_BUILDALL($metaclass); + my $buildargs = $class->_generate_BUILDARGS($metaclass); + my $processattrs = $class->_generate_processattrs($metaclass, \@attrs); + my @compiled_constraints = map { $_ ? $_->{_compiled_type_constraint} : undef } map { $_->{type_constraint} } @attrs; my $code = <<"..."; sub { my \$class = shift; return \$class->Mouse::Object::new(\@_) - if \$class ne '$associated_metaclass_name'; + if \$class ne q{$associated_metaclass_name}; $buildargs; my \$instance = bless {}, \$class; $processattrs; @@ -26,7 +28,6 @@ sub generate_constructor_method_inline { ... local $@; - #warn $code; my $res = eval $code; die $@ if $@; $res; @@ -156,7 +157,7 @@ sub _generate_processattrs { sub _generate_BUILDARGS { my($self, $metaclass) = @_; - if ($metaclass->name->can('BUILDARGS') && $metaclass->name->can('BUILDARGS') != Mouse::Object->can('BUILDARGS')) { + if ($metaclass->name->can('BUILDARGS') && $metaclass->name->can('BUILDARGS') != \&Mouse::Object::BUILDARGS) { return 'my $args = $class->BUILDARGS(@_)'; } @@ -175,16 +176,15 @@ sub _generate_BUILDARGS { sub _generate_BUILDALL { my ($class, $metaclass) = @_; + return '' unless $metaclass->name->can('BUILD'); - my @code = (); - push @code, q{no strict 'refs';}; - push @code, q{no warnings 'once';}; - no strict 'refs'; - no warnings 'once'; - for my $klass ($metaclass->linearized_isa) { - if (*{ $klass . '::BUILD' }{CODE}) { - unshift @code, qq{${klass}::BUILD(\$instance, \$args);}; + my @code; + for my $class ($metaclass->linearized_isa) { + no strict 'refs'; + + if (*{ $class . '::BUILD' }{CODE}) { + unshift @code, qq{${class}::BUILD(\$instance, \$args);}; } } return join "\n", @code; diff --git a/lib/Mouse/Meta/Method/Destructor.pm b/lib/Mouse/Meta/Method/Destructor.pm index 904b413..fa0d025 100644 --- a/lib/Mouse/Meta/Method/Destructor.pm +++ b/lib/Mouse/Meta/Method/Destructor.pm @@ -8,10 +8,10 @@ sub generate_destructor_method_inline { my $demolishall = do { if ($meta->name->can('DEMOLISH')) { my @code = (); - no strict 'refs'; - for my $klass ($meta->linearized_isa) { - if (*{$klass . '::DEMOLISH'}{CODE}) { - push @code, "${klass}::DEMOLISH(\$self);"; + for my $class ($meta->linearized_isa) { + no strict 'refs'; + if (*{$class . '::DEMOLISH'}{CODE}) { + push @code, "${class}::DEMOLISH(\$self);"; } } join "\n", @code; diff --git a/lib/Mouse/Object.pm b/lib/Mouse/Object.pm index 4abc0d6..f68f390 100644 --- a/lib/Mouse/Object.pm +++ b/lib/Mouse/Object.pm @@ -22,6 +22,7 @@ sub BUILDARGS { if (scalar @_ == 1) { (ref($_[0]) eq 'HASH') || $class->meta->throw_error("Single parameters to new() must be a HASH ref"); + return {%{$_[0]}}; } else { @@ -29,7 +30,11 @@ sub BUILDARGS { } } -sub DESTROY { shift->DEMOLISHALL } +sub DESTROY { + my $self = shift; + + $self->DEMOLISHALL(); +} sub BUILDALL { my $self = shift; @@ -38,11 +43,10 @@ sub BUILDALL { return unless $self->can('BUILD'); for my $class (reverse $self->meta->linearized_isa) { - no strict 'refs'; - no warnings 'once'; - my $code = *{ $class . '::BUILD' }{CODE} + my $build = do{ no strict 'refs'; *{ $class . '::BUILD' }{CODE} } or next; - $code->($self, @_); + + $self->$build(@_); } return; } @@ -59,9 +63,10 @@ sub DEMOLISHALL { # that time (at least tests suggest so ;) foreach my $class (@{ Mouse::Util::get_linear_isa(ref $self) }) { - my $demolish = do{ no strict 'refs'; *{"${class}::DEMOLISH"}{CODE} }; - $self->$demolish() - if defined $demolish; + my $demolish = do{ no strict 'refs'; *{ $class . '::DEMOLISH'}{CODE} } + or next; + + $self->$demolish(); } return; } diff --git a/lib/Mouse/Util.pm b/lib/Mouse/Util.pm index 0e4d865..fa06423 100644 --- a/lib/Mouse/Util.pm +++ b/lib/Mouse/Util.pm @@ -4,7 +4,6 @@ use warnings; use base qw/Exporter/; use Carp qw(confess); -use B (); our @EXPORT_OK = qw( find_meta @@ -95,6 +94,8 @@ BEGIN { my ($coderef) = @_; ref($coderef) or return; + require B; + my $cv = B::svref_2object($coderef); $cv->isa('B::CV') or return; @@ -247,7 +248,7 @@ sub apply_all_roles { if ($i + 1 < $max && ref($_[$i + 1])) { push @roles, [ $_[$i++] => $_[$i] ]; } else { - push @roles, [ $_[$i] => {} ]; + push @roles, [ $_[$i] => undef ]; } my $role_name = $roles[-1][0]; load_class($role_name); diff --git a/t/030_roles/002_role.t b/t/030_roles/002_role.t index 577c2ef..2501185 100755 --- a/t/030_roles/002_role.t +++ b/t/030_roles/002_role.t @@ -82,28 +82,32 @@ is_deeply( ok($foo_role->has_attribute('bar'), '... FooRole does have the bar attribute'); -{ -local $TODO = 'definition_context is not yet implemented'; my $bar_attr = $foo_role->get_attribute('bar'); is($bar_attr->{is}, 'rw', 'bar attribute is rw'); is($bar_attr->{isa}, 'Foo', 'bar attribute isa Foo'); -is(ref($bar_attr->{definition_context}), 'HASH', - 'bar\'s definition context is a hash'); -is($bar_attr->{definition_context}->{package}, 'FooRole', - 'bar was defined in FooRole'); +{ + local $TODO = 'definition_context is not yet implemented'; + is(ref($bar_attr->{definition_context}), 'HASH', + 'bar\'s definition context is a hash'); + is($bar_attr->{definition_context}->{package}, 'FooRole', + 'bar was defined in FooRole'); +} ok($foo_role->has_attribute('baz'), '... FooRole does have the baz attribute'); my $baz_attr = $foo_role->get_attribute('baz'); is($baz_attr->{is}, 'ro', 'baz attribute is ro'); -is(ref($baz_attr->{definition_context}), 'HASH', - 'bar\'s definition context is a hash'); -is($baz_attr->{definition_context}->{package}, 'FooRole', - 'baz was defined in FooRole'); -} # end of TODO (definition_context) + +{ + local $TODO = 'definition_context is not yet implemented'; + is(ref($baz_attr->{definition_context}), 'HASH', + 'bar\'s definition context is a hash'); + is($baz_attr->{definition_context}->{package}, 'FooRole', + 'baz was defined in FooRole'); +} # method modifiers diff --git a/t/300_immutable/001_immutable_moose.t b/t/300_immutable/001_immutable_moose.t index 2e1f74c..1c561ae 100644 --- a/t/300_immutable/001_immutable_moose.t +++ b/t/300_immutable/001_immutable_moose.t @@ -41,11 +41,10 @@ use Mouse::Meta::Role; is( Foo->new->bazes, 'many bazes', "correct value for 'bazes' before inlining constructor" ); lives_ok { $meta->make_immutable } "Foo is imutable"; - SKIP: { - skip "Mouse doesn't supports ->identifier, add_role", 2; - lives_ok { $meta->identifier } "->identifier on metaclass lives"; - dies_ok { $meta->add_role($foo_role) } "Add Role is locked"; - }; + + lives_ok { $meta->identifier } "->identifier on metaclass lives"; + dies_ok { $meta->add_role($foo_role) } "Add Role is locked"; + lives_ok { Foo->new } "Inlined constructor works with lazy_build"; is( Foo->new->foos, 'many foos', "correct value for 'foos' after inlining constructor" );