From: Dave Rolsky <autarch@urth.org>
Date: Wed, 22 Sep 2010 21:58:47 +0000 (-0500)
Subject: Inline all Counter methods
X-Git-Tag: 1.15~118
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=04e054135a4818a27897805d6bdb999e9d983ca4;p=gitmo%2FMoose.git

Inline all Counter methods
---

diff --git a/lib/Moose/Meta/Attribute/Native/MethodProvider/Counter.pm b/lib/Moose/Meta/Attribute/Native/MethodProvider/Counter.pm
deleted file mode 100644
index 3199ad2..0000000
--- a/lib/Moose/Meta/Attribute/Native/MethodProvider/Counter.pm
+++ /dev/null
@@ -1,76 +0,0 @@
-
-package Moose::Meta::Attribute::Native::MethodProvider::Counter;
-use Moose::Role;
-
-our $VERSION   = '1.14';
-$VERSION = eval $VERSION;
-our $AUTHORITY = 'cpan:STEVAN';
-
-sub reset : method {
-    my ( $attr, $reader, $writer ) = @_;
-    return sub { $writer->( $_[0], $attr->default( $_[0] ) ) };
-}
-
-sub set : method {
-    my ( $attr, $reader, $writer, $value ) = @_;
-    return sub { $writer->( $_[0], $_[1] ) };
-}
-
-sub inc {
-    my ( $attr, $reader, $writer ) = @_;
-    return sub {
-        $writer->( $_[0],
-            $reader->( $_[0] ) + ( defined( $_[1] ) ? $_[1] : 1 ) );
-    };
-}
-
-sub dec {
-    my ( $attr, $reader, $writer ) = @_;
-    return sub {
-        $writer->( $_[0],
-            $reader->( $_[0] ) - ( defined( $_[1] ) ? $_[1] : 1 ) );
-    };
-}
-
-1;
-
-__END__
-
-=pod
-
-=head1 NAME
-
-Moose::Meta::Attribute::Native::MethodProvider::Counter - role providing method generators for Counter trait
-
-=head1 DESCRIPTION
-
-This is a role which provides the method generators for
-L<Moose::Meta::Attribute::Native::Trait::Counter>.  Please check there for
-documentation on what methods are provided.
-
-=head1 METHODS
-
-=over 4
-
-=item B<meta>
-
-=back
-
-=head1 BUGS
-
-See L<Moose/BUGS> for details on reporting bugs.
-
-=head1 AUTHOR
-
-Stevan Little E<lt>stevan@iinteractive.comE<gt>
-
-=head1 COPYRIGHT AND LICENSE
-
-Copyright 2007-2009 by Infinity Interactive, Inc.
-
-L<http://www.iinteractive.com>
-
-This library is free software; you can redistribute it and/or modify
-it under the same terms as Perl itself.
-
-=cut
diff --git a/lib/Moose/Meta/Attribute/Native/Trait.pm b/lib/Moose/Meta/Attribute/Native/Trait.pm
index 6727e33..28337ab 100644
--- a/lib/Moose/Meta/Attribute/Native/Trait.pm
+++ b/lib/Moose/Meta/Attribute/Native/Trait.pm
@@ -54,7 +54,7 @@ sub _check_handles_values {
         # XXX - bridge code
         ( ( $accessor_class && $accessor_class->can('new') )
                 || exists $method_constructors->{$name} )
-            || confess "$name is an unsupported method type";
+            || confess "$name is an unsupported method type - $accessor_class";
     }
 }
 
diff --git a/lib/Moose/Meta/Attribute/Native/Trait/Counter.pm b/lib/Moose/Meta/Attribute/Native/Trait/Counter.pm
index 6c1481f..c1912c0 100644
--- a/lib/Moose/Meta/Attribute/Native/Trait/Counter.pm
+++ b/lib/Moose/Meta/Attribute/Native/Trait/Counter.pm
@@ -6,20 +6,19 @@ our $VERSION   = '1.14';
 $VERSION = eval $VERSION;
 our $AUTHORITY = 'cpan:STEVAN';
 
-use Moose::Meta::Attribute::Native::MethodProvider::Counter;
+use Moose::Meta::Method::Accessor::Native::Counter::dec;
+use Moose::Meta::Method::Accessor::Native::Counter::inc;
+use Moose::Meta::Method::Accessor::Native::Counter::reset;
+use Moose::Meta::Method::Accessor::Native::Counter::set;
 
-with 'Moose::Meta::Attribute::Native::Trait';
-
-has 'method_provider' => (
-    is        => 'ro',
-    isa       => 'ClassName',
-    predicate => 'has_method_provider',
-    default   => 'Moose::Meta::Attribute::Native::MethodProvider::Counter',
-);
+with 'Moose::Meta::Attribute::Native::Trait' =>
+    { -excludes => ['_root_types'] };
 
 sub _default_default { 0 }
 sub _default_is { 'ro' }
 sub _helper_type { 'Num' }
+sub _native_type { 'Counter' }
+sub _root_types { 'Num', 'Int' }
 
 no Moose::Role;
 
diff --git a/lib/Moose/Meta/Method/Accessor/Native/Counter/Writer.pm b/lib/Moose/Meta/Method/Accessor/Native/Counter/Writer.pm
new file mode 100644
index 0000000..dd653c8
--- /dev/null
+++ b/lib/Moose/Meta/Method/Accessor/Native/Counter/Writer.pm
@@ -0,0 +1,37 @@
+package Moose::Meta::Method::Accessor::Native::Counter::Writer;
+
+use strict;
+use warnings;
+
+our $VERSION = '1.13';
+$VERSION = eval $VERSION;
+our $AUTHORITY = 'cpan:STEVAN';
+
+use base 'Moose::Meta::Method::Accessor::Native::Writer';
+
+sub _new_value {'$_[0]'}
+
+sub _constraint_must_be_checked {
+    my $self = shift;
+
+    my $attr = $self->associated_attribute;
+
+    return $attr->has_type_constraint
+        && ( $attr->type_constraint->name =~ /^(?:Num|Int)$/
+        || ( $attr->should_coerce && $attr->type_constraint->has_coercion ) );
+}
+
+sub _inline_check_coercion {
+    my ( $self, $value ) = @_;
+
+    my $attr = $self->associated_attribute;
+
+    return ''
+        unless $attr->should_coerce && $attr->type_constraint->has_coercion;
+
+    # We want to break the aliasing in @_ in case the coercion tries to make a
+    # destructive change to an array member.
+    return "$value = $attr->type_constraint->coerce($value);";
+}
+
+1;
diff --git a/lib/Moose/Meta/Method/Accessor/Native/Counter/dec.pm b/lib/Moose/Meta/Method/Accessor/Native/Counter/dec.pm
new file mode 100644
index 0000000..bc1c078
--- /dev/null
+++ b/lib/Moose/Meta/Method/Accessor/Native/Counter/dec.pm
@@ -0,0 +1,27 @@
+package Moose::Meta::Method::Accessor::Native::Counter::dec;
+
+use strict;
+use warnings;
+
+our $VERSION = '1.13';
+$VERSION = eval $VERSION;
+our $AUTHORITY = 'cpan:STEVAN';
+
+use base 'Moose::Meta::Method::Accessor::Native::Writer';
+
+sub _minimum_arguments {0}
+sub _maximum_arguments {1}
+
+sub _potential_value {
+    my ( $self, $slot_access ) = @_;
+
+    return "$slot_access - ( defined \$_[0] ? \$_[0] : 1 );";
+}
+
+sub _inline_optimized_set_new_value {
+    my ( $self, $inv, $new, $slot_access ) = @_;
+
+    return "$slot_access -= defined \$_[0] ? \$_[0] : 1;";
+}
+
+1;
diff --git a/lib/Moose/Meta/Method/Accessor/Native/Counter/inc.pm b/lib/Moose/Meta/Method/Accessor/Native/Counter/inc.pm
new file mode 100644
index 0000000..d888db9
--- /dev/null
+++ b/lib/Moose/Meta/Method/Accessor/Native/Counter/inc.pm
@@ -0,0 +1,27 @@
+package Moose::Meta::Method::Accessor::Native::Counter::inc;
+
+use strict;
+use warnings;
+
+our $VERSION = '1.13';
+$VERSION = eval $VERSION;
+our $AUTHORITY = 'cpan:STEVAN';
+
+use base 'Moose::Meta::Method::Accessor::Native::Writer';
+
+sub _minimum_arguments { 0 }
+sub _maximum_arguments { 1 }
+
+sub _potential_value {
+    my ( $self, $slot_access ) = @_;
+
+    return "$slot_access + ( defined \$_[0] ? \$_[0] : 1 );";
+}
+
+sub _inline_optimized_set_new_value {
+    my ( $self, $inv, $new, $slot_access ) = @_;
+
+    return "$slot_access += defined \$_[0] ? \$_[0] : 1;";
+}
+
+1;
diff --git a/lib/Moose/Meta/Method/Accessor/Native/Counter/reset.pm b/lib/Moose/Meta/Method/Accessor/Native/Counter/reset.pm
new file mode 100644
index 0000000..d7d949e
--- /dev/null
+++ b/lib/Moose/Meta/Method/Accessor/Native/Counter/reset.pm
@@ -0,0 +1,27 @@
+package Moose::Meta::Method::Accessor::Native::Counter::reset;
+
+use strict;
+use warnings;
+
+our $VERSION = '1.13';
+$VERSION = eval $VERSION;
+our $AUTHORITY = 'cpan:STEVAN';
+
+use base 'Moose::Meta::Method::Accessor::Native::Writer';
+
+sub _minimum_arguments { 0 }
+sub _maximum_arguments { 0 }
+
+sub _potential_value {
+    my ( $self, $slot_access ) = @_;
+
+    return "\$attr->default(\$self)"
+}
+
+sub _inline_optimized_set_new_value {
+    my ( $self, $inv, $new, $slot_access ) = @_;
+
+    return "$slot_access = \$attr->default(\$self);";
+}
+
+1;
diff --git a/lib/Moose/Meta/Method/Accessor/Native/Counter/set.pm b/lib/Moose/Meta/Method/Accessor/Native/Counter/set.pm
new file mode 100644
index 0000000..c5568a2
--- /dev/null
+++ b/lib/Moose/Meta/Method/Accessor/Native/Counter/set.pm
@@ -0,0 +1,23 @@
+package Moose::Meta::Method::Accessor::Native::Counter::set;
+
+use strict;
+use warnings;
+
+our $VERSION = '1.13';
+$VERSION = eval $VERSION;
+our $AUTHORITY = 'cpan:STEVAN';
+
+use base 'Moose::Meta::Method::Accessor::Native::Writer';
+
+sub _minimum_arguments {1}
+sub _maximum_arguments {1}
+
+sub _potential_value {'$_[0]'}
+
+sub _inline_optimized_set_new_value {
+    my ( $self, $inv, $new, $slot_access ) = @_;
+
+    return "$slot_access = \$_[0];";
+}
+
+1;