From: Dave Rolsky <autarch@urth.org>
Date: Wed, 15 Sep 2010 20:01:34 +0000 (-0500)
Subject: All of the non-mutating array helpers are now inlined.
X-Git-Tag: 1.15~150
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=910684ee2db21699bfff41b3b62b3728203024f9;p=gitmo%2FMoose.git

All of the non-mutating array helpers are now inlined.

Made sure we had tests for all of them, including tests for failure cases.
---

diff --git a/lib/Moose/Meta/Attribute/Native/MethodProvider/Array.pm b/lib/Moose/Meta/Attribute/Native/MethodProvider/Array.pm
index 97bb97b..d6f3538 100644
--- a/lib/Moose/Meta/Attribute/Native/MethodProvider/Array.pm
+++ b/lib/Moose/Meta/Attribute/Native/MethodProvider/Array.pm
@@ -8,98 +8,6 @@ our $VERSION = '1.14';
 $VERSION = eval $VERSION;
 our $AUTHORITY = 'cpan:STEVAN';
 
-sub reduce : method {
-    my ( $attr, $reader, $writer ) = @_;
-    return sub {
-        my ( $instance, $f ) = @_;
-        our ($a, $b);
-        List::Util::reduce { $f->($a, $b) } @{ $reader->($instance) };
-    };
-}
-
-sub sort : method {
-    my ( $attr, $reader, $writer ) = @_;
-    return sub {
-        my ( $instance, $predicate ) = @_;
-        die "Argument must be a code reference"
-          if $predicate && ref $predicate ne 'CODE';
-
-        if ($predicate) {
-            # Although it would be nice if we could support just using $a and
-            # $b like sort already does, using $a or $b once in a package
-            # triggers the 'Name "main::a" used only once' warning, and there
-            # is no good way to avoid that, since it happens when the file
-            # which defines the coderef is compiled, before we even get a
-            # chance to see it here. So, we have no real choice but to use
-            # normal parameters. --doy
-            CORE::sort { $predicate->( $a, $b ) } @{ $reader->($instance) };
-        }
-        else {
-            CORE::sort @{ $reader->($instance) };
-        }
-    };
-}
-
-sub shuffle : method {
-    my ( $attr, $reader, $writer ) = @_;
-    return sub {
-        my ( $instance ) = @_;
-        List::Util::shuffle @{ $reader->($instance) };
-    };
-}
-
-sub grep : method {
-    my ( $attr, $reader, $writer ) = @_;
-    return sub {
-        my ( $instance, $predicate ) = @_;
-        CORE::grep { $predicate->() } @{ $reader->($instance) };
-    };
-}
-
-sub uniq : method {
-    my ( $attr, $reader, $writer ) = @_;
-    return sub {
-        my ( $instance ) = @_;
-        List::MoreUtils::uniq @{ $reader->($instance) };
-    };
-}
-
-sub join : method {
-    my ( $attr, $reader, $writer ) = @_;
-    return sub {
-        my ( $instance, $separator ) = @_;
-        join $separator, @{ $reader->($instance) };
-    };
-}
-
-sub push : method {
-    my ( $attr, $reader, $writer ) = @_;
-
-    if (
-        $attr->has_type_constraint
-        && $attr->type_constraint->isa(
-            'Moose::Meta::TypeConstraint::Parameterized')
-      )
-    {
-        my $container_type_constraint = $attr->type_constraint->type_parameter;
-        return sub {
-            my $instance = CORE::shift;
-            $container_type_constraint->check($_)
-              || confess "Value "
-              . ( $_ || 'undef' )
-              . " did not pass container type constraint '$container_type_constraint'"
-              foreach @_;
-            CORE::push @{ $reader->($instance) } => @_;
-        };
-    }
-    else {
-        return sub {
-            my $instance = CORE::shift;
-            CORE::push @{ $reader->($instance) } => @_;
-        };
-    }
-}
-
 sub pop : method {
     my ( $attr, $reader, $writer ) = @_;
     return sub {
@@ -141,13 +49,6 @@ sub shift : method {
     };
 }
 
-sub get : method {
-    my ( $attr, $reader, $writer ) = @_;
-    return sub {
-        $reader->( $_[0] )->[ $_[1] ];
-    };
-}
-
 sub set : method {
     my ( $attr, $reader, $writer ) = @_;
     if (
diff --git a/lib/Moose/Meta/Attribute/Native/Trait/Array.pm b/lib/Moose/Meta/Attribute/Native/Trait/Array.pm
index 79a5e13..0defb44 100644
--- a/lib/Moose/Meta/Attribute/Native/Trait/Array.pm
+++ b/lib/Moose/Meta/Attribute/Native/Trait/Array.pm
@@ -11,9 +11,16 @@ use Moose::Meta::Attribute::Native::MethodProvider::Array;
 use Moose::Meta::Method::Accessor::Native::Array::count;
 use Moose::Meta::Method::Accessor::Native::Array::elements;
 use Moose::Meta::Method::Accessor::Native::Array::first;
+use Moose::Meta::Method::Accessor::Native::Array::get;
+use Moose::Meta::Method::Accessor::Native::Array::grep;
 use Moose::Meta::Method::Accessor::Native::Array::is_empty;
+use Moose::Meta::Method::Accessor::Native::Array::join;
 use Moose::Meta::Method::Accessor::Native::Array::map;
 use Moose::Meta::Method::Accessor::Native::Array::push;
+use Moose::Meta::Method::Accessor::Native::Array::reduce;
+use Moose::Meta::Method::Accessor::Native::Array::shuffle;
+use Moose::Meta::Method::Accessor::Native::Array::sort;
+use Moose::Meta::Method::Accessor::Native::Array::uniq;
 
 with 'Moose::Meta::Attribute::Native::Trait';
 
diff --git a/lib/Moose/Meta/Method/Accessor/Native/Array.pm b/lib/Moose/Meta/Method/Accessor/Native/Array.pm
index fb249b7..d30033b 100644
--- a/lib/Moose/Meta/Method/Accessor/Native/Array.pm
+++ b/lib/Moose/Meta/Method/Accessor/Native/Array.pm
@@ -38,4 +38,8 @@ sub _constraint_must_be_checked {
         || ( $attr->should_coerce && $attr->type_constraint->has_coercion ) );
 }
 
+sub _inline_process_arguments { q{} }
+
+sub _inline_check_arguments { q{} }
+
 1;
diff --git a/lib/Moose/Meta/Method/Accessor/Native/Array/Reader.pm b/lib/Moose/Meta/Method/Accessor/Native/Array/Reader.pm
index d92bb74..39ce6a9 100644
--- a/lib/Moose/Meta/Method/Accessor/Native/Array/Reader.pm
+++ b/lib/Moose/Meta/Method/Accessor/Native/Array/Reader.pm
@@ -20,6 +20,7 @@ sub _generate_method {
     $code .= "\n" . 'my $self = shift;';
     $code .= "\n" . $self->_inline_curried_arguments;
     $code .= "\n" . $self->_inline_process_arguments;
+    $code .= "\n" . $self->_inline_check_arguments;
 
     $code
         .= "\n"
@@ -38,6 +39,4 @@ sub _generate_method {
     return $code;
 }
 
-sub _inline_process_arguments { q{} }
-
 1;
diff --git a/lib/Moose/Meta/Method/Accessor/Native/Array/elements.pm b/lib/Moose/Meta/Method/Accessor/Native/Array/elements.pm
index 2324ac9..cc7a81e 100644
--- a/lib/Moose/Meta/Method/Accessor/Native/Array/elements.pm
+++ b/lib/Moose/Meta/Method/Accessor/Native/Array/elements.pm
@@ -10,7 +10,7 @@ our $AUTHORITY = 'cpan:STEVAN';
 use base 'Moose::Meta::Method::Accessor::Native::Array::Reader';
 
 sub _return_value {
-    my $self = shift;
+    my $self        = shift;
     my $slot_access = shift;
 
     return "\@{ $slot_access }";
diff --git a/lib/Moose/Meta/Method/Accessor/Native/Array/first.pm b/lib/Moose/Meta/Method/Accessor/Native/Array/first.pm
index 91c3369..510cd3b 100644
--- a/lib/Moose/Meta/Method/Accessor/Native/Array/first.pm
+++ b/lib/Moose/Meta/Method/Accessor/Native/Array/first.pm
@@ -15,6 +15,11 @@ sub _inline_process_arguments {
     return 'my $func = shift;';
 }
 
+sub _inline_check_arguments {
+    return
+        q{die 'Must provide a code reference as an argument' unless ( ref $func || q{} ) eq 'CODE';};
+}
+
 sub _return_value {
     my $self        = shift;
     my $slot_access = shift;
diff --git a/lib/Moose/Meta/Method/Accessor/Native/Array/get.pm b/lib/Moose/Meta/Method/Accessor/Native/Array/get.pm
new file mode 100644
index 0000000..199deb5
--- /dev/null
+++ b/lib/Moose/Meta/Method/Accessor/Native/Array/get.pm
@@ -0,0 +1,28 @@
+package Moose::Meta::Method::Accessor::Native::Array::get;
+
+use strict;
+use warnings;
+
+our $VERSION = '1.13';
+$VERSION = eval $VERSION;
+our $AUTHORITY = 'cpan:STEVAN';
+
+use base 'Moose::Meta::Method::Accessor::Native::Array::Reader';
+
+sub _inline_process_arguments {
+    return 'my $idx = shift;';
+}
+
+sub _inline_check_arguments {
+    return
+        q{die 'Must provide a valid index number as an argument' unless defined $idx && $idx =~ /^-?\d+$/;};
+}
+
+sub _return_value {
+    my $self        = shift;
+    my $slot_access = shift;
+
+    return "${slot_access}->[\$idx]";
+}
+
+1;
diff --git a/lib/Moose/Meta/Method/Accessor/Native/Array/grep.pm b/lib/Moose/Meta/Method/Accessor/Native/Array/grep.pm
new file mode 100644
index 0000000..7c9d036
--- /dev/null
+++ b/lib/Moose/Meta/Method/Accessor/Native/Array/grep.pm
@@ -0,0 +1,28 @@
+package Moose::Meta::Method::Accessor::Native::Array::grep;
+
+use strict;
+use warnings;
+
+our $VERSION = '1.13';
+$VERSION = eval $VERSION;
+our $AUTHORITY = 'cpan:STEVAN';
+
+use base 'Moose::Meta::Method::Accessor::Native::Array::Reader';
+
+sub _inline_process_arguments {
+    return 'my $func = shift;';
+}
+
+sub _inline_check_arguments {
+    return
+        q{die 'Must provide a code reference as an argument' unless ( ref $func || q{} ) eq 'CODE';};
+}
+
+sub _return_value {
+    my $self        = shift;
+    my $slot_access = shift;
+
+    return "grep { \$func->() } \@{ $slot_access }";
+}
+
+1;
diff --git a/lib/Moose/Meta/Method/Accessor/Native/Array/join.pm b/lib/Moose/Meta/Method/Accessor/Native/Array/join.pm
new file mode 100644
index 0000000..19333df
--- /dev/null
+++ b/lib/Moose/Meta/Method/Accessor/Native/Array/join.pm
@@ -0,0 +1,28 @@
+package Moose::Meta::Method::Accessor::Native::Array::join;
+
+use strict;
+use warnings;
+
+our $VERSION = '1.13';
+$VERSION = eval $VERSION;
+our $AUTHORITY = 'cpan:STEVAN';
+
+use base 'Moose::Meta::Method::Accessor::Native::Array::Reader';
+
+sub _inline_process_arguments {
+    return 'my $sep = shift;';
+}
+
+sub _inline_check_arguments {
+    return
+        q{die 'Must provide a string as an argument' unless defined $sep && ! ref $sep;};
+}
+
+sub _return_value {
+    my $self        = shift;
+    my $slot_access = shift;
+
+    return "join \$sep, \@{ $slot_access }";
+}
+
+1;
diff --git a/lib/Moose/Meta/Method/Accessor/Native/Array/map.pm b/lib/Moose/Meta/Method/Accessor/Native/Array/map.pm
index d7a46b3..435472e 100644
--- a/lib/Moose/Meta/Method/Accessor/Native/Array/map.pm
+++ b/lib/Moose/Meta/Method/Accessor/Native/Array/map.pm
@@ -13,6 +13,11 @@ sub _inline_process_arguments {
     return 'my $func = shift;';
 }
 
+sub _inline_check_arguments {
+    return
+        q{die 'Must provide a code reference as an argument' unless ( ref $func || q{} ) eq 'CODE';};
+}
+
 sub _return_value {
     my $self        = shift;
     my $slot_access = shift;
diff --git a/lib/Moose/Meta/Method/Accessor/Native/Array/push.pm b/lib/Moose/Meta/Method/Accessor/Native/Array/push.pm
index b567cac..8793b65 100644
--- a/lib/Moose/Meta/Method/Accessor/Native/Array/push.pm
+++ b/lib/Moose/Meta/Method/Accessor/Native/Array/push.pm
@@ -43,8 +43,7 @@ sub _generate_method {
     $code .= "\n" . $self->_inline_check_coercion($potential_new_val);
     $code .= "\n" . $self->_inline_check_constraint($potential_new_val);
 
-    $code .= "\n"
-        . $self->_inline_get_old_value_for_trigger( $inv, '@_' );
+    $code .= "\n" . $self->_inline_get_old_value_for_trigger( $inv, '@_' );
 
     $code .= "\n" . $self->_inline_store( $inv, $potential_new_val );
 
diff --git a/lib/Moose/Meta/Method/Accessor/Native/Array/reduce.pm b/lib/Moose/Meta/Method/Accessor/Native/Array/reduce.pm
new file mode 100644
index 0000000..94fdf1c
--- /dev/null
+++ b/lib/Moose/Meta/Method/Accessor/Native/Array/reduce.pm
@@ -0,0 +1,30 @@
+package Moose::Meta::Method::Accessor::Native::Array::reduce;
+
+use strict;
+use warnings;
+
+use List::Util ();
+
+our $VERSION = '1.13';
+$VERSION = eval $VERSION;
+our $AUTHORITY = 'cpan:STEVAN';
+
+use base 'Moose::Meta::Method::Accessor::Native::Array::Reader';
+
+sub _inline_process_arguments {
+    return 'my $func = shift;';
+}
+
+sub _inline_check_arguments {
+    return
+        q{die 'Must provide a code reference as an argument' unless ( ref $func || q{} ) eq 'CODE';};
+}
+
+sub _return_value {
+    my $self        = shift;
+    my $slot_access = shift;
+
+    return "List::Util::reduce { \$func->( \$a, \$b ) } \@{ ${slot_access} }";
+}
+
+1;
diff --git a/lib/Moose/Meta/Method/Accessor/Native/Array/shuffle.pm b/lib/Moose/Meta/Method/Accessor/Native/Array/shuffle.pm
new file mode 100644
index 0000000..ca0d67b
--- /dev/null
+++ b/lib/Moose/Meta/Method/Accessor/Native/Array/shuffle.pm
@@ -0,0 +1,21 @@
+package Moose::Meta::Method::Accessor::Native::Array::shuffle;
+
+use strict;
+use warnings;
+
+use List::Util ();
+
+our $VERSION = '1.13';
+$VERSION = eval $VERSION;
+our $AUTHORITY = 'cpan:STEVAN';
+
+use base 'Moose::Meta::Method::Accessor::Native::Array::Reader';
+
+sub _return_value {
+    my $self        = shift;
+    my $slot_access = shift;
+
+    return "List::Util::shuffle \@{ $slot_access }";
+}
+
+1;
diff --git a/lib/Moose/Meta/Method/Accessor/Native/Array/sort.pm b/lib/Moose/Meta/Method/Accessor/Native/Array/sort.pm
new file mode 100644
index 0000000..338ad1d
--- /dev/null
+++ b/lib/Moose/Meta/Method/Accessor/Native/Array/sort.pm
@@ -0,0 +1,29 @@
+package Moose::Meta::Method::Accessor::Native::Array::sort;
+
+use strict;
+use warnings;
+
+our $VERSION = '1.13';
+$VERSION = eval $VERSION;
+our $AUTHORITY = 'cpan:STEVAN';
+
+use base 'Moose::Meta::Method::Accessor::Native::Array::Reader';
+
+sub _inline_process_arguments {
+    return 'my $func = shift if @_;';
+}
+
+sub _inline_check_arguments {
+    return
+        q{die 'Argument must be a code reference' if $func && ( ref $func || q{} ) ne 'CODE';};
+}
+
+sub _return_value {
+    my $self        = shift;
+    my $slot_access = shift;
+
+    return
+        "\$func ? sort { \$func->( \$a, \$b ) } \@{ ${slot_access} } : sort \@{ $slot_access }";
+}
+
+1;
diff --git a/lib/Moose/Meta/Method/Accessor/Native/Array/uniq.pm b/lib/Moose/Meta/Method/Accessor/Native/Array/uniq.pm
new file mode 100644
index 0000000..1b6de7d
--- /dev/null
+++ b/lib/Moose/Meta/Method/Accessor/Native/Array/uniq.pm
@@ -0,0 +1,21 @@
+package Moose::Meta::Method::Accessor::Native::Array::uniq;
+
+use strict;
+use warnings;
+
+use List::MoreUtils ();
+
+our $VERSION = '1.13';
+$VERSION = eval $VERSION;
+our $AUTHORITY = 'cpan:STEVAN';
+
+use base 'Moose::Meta::Method::Accessor::Native::Array::Reader';
+
+sub _return_value {
+    my $self        = shift;
+    my $slot_access = shift;
+
+    return "List::MoreUtils::uniq \@{ $slot_access }";
+}
+
+1;
diff --git a/t/070_native_traits/202_trait_array.t b/t/070_native_traits/202_trait_array.t
index 4eb281d..b1a1268 100644
--- a/t/070_native_traits/202_trait_array.t
+++ b/t/070_native_traits/202_trait_array.t
@@ -98,6 +98,22 @@ my %handles = (
     is( $stuff->get_option_at(1), 2, '... get option at index 1' );
     is( $stuff->get_option_at(2), 3, '... get option at index 2' );
 
+    throws_ok { $stuff->get_option_at() }
+    qr/Must provide a valid index number as an argument/,
+        'throws an error when get_option_at is called without any arguments';
+
+    throws_ok { $stuff->get_option_at( {} ) }
+    qr/Must provide a valid index number as an argument/,
+        'throws an error when get_option_at is called with an invalid argument';
+
+    throws_ok { $stuff->get_option_at(2.2) }
+    qr/Must provide a valid index number as an argument/,
+        'throws an error when get_option_at is called with an invalid argument';
+
+    throws_ok { $stuff->get_option_at('foo') }
+    qr/Must provide a valid index number as an argument/,
+        'throws an error when get_option_at is called with an invalid argument';
+
     lives_ok {
         $stuff->set_option_at( 1, 100 );
     }
@@ -282,17 +298,41 @@ my %handles = (
         '... got the right filtered values'
     );
 
+    throws_ok { $stuff->filter_options() }
+    qr/Must provide a code reference as an argument/,
+        'throws an error when filter_options is called without any arguments';
+
+    throws_ok { $stuff->filter_options( {} ) }
+    qr/Must provide a code reference as an argument/,
+        'throws an error when filter_options is called with an invalid argument';
+
     is_deeply(
         [ $stuff->map_options( sub { $_ * 2 } ) ],
         [ 2, 4, 6, 8, 10, 12, 14, 16, 18, 20 ],
         '... got the right mapped values'
     );
 
+    throws_ok { $stuff->map_options() }
+    qr/Must provide a code reference as an argument/,
+        'throws an error when map_options is called without any arguments';
+
+    throws_ok { $stuff->map_options( {} ) }
+    qr/Must provide a code reference as an argument/,
+        'throws an error when map_options is called with an invalid argument';
+
     is(
         $stuff->find_option( sub { $_ % 2 == 0 } ), 2,
         '.. found the right option'
     );
 
+    throws_ok { $stuff->find_option() }
+    qr/Must provide a code reference as an argument/,
+        'throws an error when find_option is called without any arguments';
+
+    throws_ok { $stuff->find_option( {} ) }
+    qr/Must provide a code reference as an argument/,
+        'throws an error when find_option is called with an invalid argument';
+
     is_deeply(
         [ $stuff->options ], [ 1 .. 10 ],
         '... got the list of options'
@@ -303,6 +343,14 @@ my %handles = (
         '... joined the list of options by :'
     );
 
+    throws_ok { $stuff->join_options() }
+    qr/Must provide a string as an argument/,
+        'throws an error when join_options is called without any arguments';
+
+    throws_ok { $stuff->join_options( {} ) }
+    qr/Must provide a string as an argument/,
+        'throws an error when join_options is called with an invalid argument';
+
     is_deeply(
         [ $stuff->sorted_options ], [ sort ( 1 .. 10 ) ],
         '... got sorted options (default sort order)'
@@ -347,6 +395,20 @@ my %handles = (
     );
 
     is(
+        $stuff->reduce( sub { $_[0] * $_[1] } ),
+        3628800,
+        'call reducing to generate a product returns expected value'
+    );
+
+    throws_ok { $stuff->reduce() }
+    qr/Must provide a code reference as an argument/,
+        'throws an error when reduce is called without any arguments';
+
+    throws_ok { $stuff->reduce( {} ) }
+    qr/Must provide a code reference as an argument/,
+        'throws an error when reduce is called with an invalid argument';
+
+    is(
         $stuff->product, 3628800,
         'product returns expected value'
     );