From: gfx <gfuji@cpan.org>
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?a=commitdiff_plain;h=7ca5c5fb6e084d9c57bc022b336458afc74c6847;p=gitmo%2FMouse.git

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" );