Permalink
Browse files

Merge branch 'master' of github.com:scrottie/autobox-Core

Conflicts:
	t/grep.t
  • Loading branch information...
scrottie committed Mar 8, 2010
2 parents 7e78e21 + 1a99dcc commit af5739bb8a8162015584820f62eb28f69445e663
Showing with 679 additions and 18 deletions.
  1. +13 −0 .gitignore
  2. +20 −10 Core.pm
  3. +9 −1 t/added.t
  4. +31 −0 t/bless.t
  5. +10 −0 t/chomp.t
  6. +26 −0 t/chop.t
  7. +7 −0 t/chr.t
  8. +14 −0 t/curry.t
  9. +19 −0 t/each.t
  10. +16 −0 t/elements.t
  11. +9 −0 t/elems.t
  12. +15 −0 t/flatten.t
  13. +12 −0 t/for.t
  14. +12 −0 t/foreach.t
  15. +25 −7 t/grep.t
  16. +11 −0 t/index.t
  17. +10 −0 t/join.t
  18. +13 −0 t/keys.t
  19. +9 −0 t/lc.t
  20. +10 −0 t/lcfirst.t
  21. +14 −0 t/length.t
  22. +33 −0 t/map.t
  23. +21 −0 t/numeric.t
  24. +7 −0 t/ord.t
  25. +8 −0 t/pack.t
  26. +11 −0 t/pop.t
  27. +23 −0 t/print.t
  28. +22 −0 t/push.t
  29. +29 −0 t/ref.t
  30. +16 −0 t/reverse.t
  31. +11 −0 t/rindex.t
  32. +10 −0 t/s.t
  33. +22 −0 t/say.t
  34. +11 −0 t/shift.t
  35. +9 −0 t/size.t
  36. +19 −0 t/sort.t
  37. +12 −0 t/split.t
  38. +10 −0 t/sprintf.t
  39. +24 −0 t/substr.t
  40. +10 −0 t/uc.t
  41. +10 −0 t/ucfirst.t
  42. +7 −0 t/unpack.t
  43. +23 −0 t/unshift.t
  44. +14 −0 t/values.t
  45. +12 −0 t/vec.t
View
@@ -0,0 +1,13 @@
+*.swp
+*.swo
+*.tmp
+*.bak
+blib/
+Makefile
+pm_to_blib
+cover_db
+*.gz
+nytprof/
+.prove
+autobox-Core*
+.build
View
30 Core.pm
@@ -653,11 +653,21 @@ sub lc ($) { CORE::lc($_[0]); }
sub lcfirst ($) { CORE::lcfirst($_[0]); }
sub length ($) { CORE::length($_[0]); }
sub ord ($) { CORE::ord($_[0]); }
-sub pack ($;@) { CORE::pack(@_); }
+sub pack ($;@) { CORE::pack(shift, @_); }
sub reverse ($) { CORE::reverse($_[0]); }
-sub rindex ($@) { CORE::rindex($_[0], $_[1], @_[2.. $#_]); }
+
+sub rindex ($@) {
+ return CORE::rindex($_[0], $_[1]) if @_ == 2;
+ return CORE::rindex($_[0], $_[1], @_[2.. $#_]);
+}
+
sub sprintf ($@) { CORE::sprintf($_[0], $_[1], @_[2.. $#_]); }
-sub substr ($@) { CORE::substr($_[0], $_[1], @_[2 .. $#_]); }
+
+sub substr ($@) {
+ return CORE::substr($_[0], $_[1]) if @_ == 2;
+ return CORE::substr($_[0], $_[1], @_[2 .. $#_]);
+}
+
sub uc ($) { CORE::uc($_[0]); }
sub ucfirst ($) { CORE::ucfirst($_[0]); }
sub unpack ($;@) { CORE::unpack($_[0], @_[1..$#_]); }
@@ -667,7 +677,7 @@ sub undef ($) { $_[0] = undef }
sub m ($$) { [ $_[0] =~ m{$_[1]} ] }
sub nm ($$) { [ $_[0] !~ m{$_[1]} ] }
sub s ($$$) { $_[0] =~ s{$_[1]}{$_[2]} }
-sub split ($$) { [ split $_[1], $_[0] ] }
+sub split ($$) { wantarray ? split $_[1], $_[0] : [ split $_[1], $_[0] ] }
sub eval ($) { CORE::eval "$_[0]"; }
sub system ($;@) { CORE::system @_; }
@@ -849,8 +859,8 @@ use Carp 'croak';
sub delete (\%@) { my $hash = CORE::shift; my @res = (); CORE::foreach(@_) { push @res, CORE::delete $hash->{$_}; } CORE::wantarray ? @res : \@res }
sub exists (\%$) { my $hash = CORE::shift; CORE::exists $hash->{$_[0]}; }
-sub keys (\%) { [ CORE::keys %{$_[0]} ] }
-sub values (\%) { [ CORE::values %{$_[0]} ] }
+sub keys (\%) { wantarray ? CORE::keys %{$_[0]} : [ CORE::keys %{$_[0]} ] }
+sub values (\%) { wantarray ? CORE::values %{$_[0]} : [ CORE::values %{$_[0]} ] }
sub at (\%@) { $_[0]->{@_[1..$#_]}; }
sub get(\%@) { $_[0]->{@_[1..$#_]}; }
@@ -1004,17 +1014,17 @@ sub min(\@) { my $arr = CORE::shift; my $min = $arr->[0]; foreach (@$arr) {$min
# Functions for real @ARRAYs
# "pop", "push", "shift", "splice", "unshift"
-sub pop (\@) { CORE::pop @{$_[0]}; wantarray ? @{$_[0]} : $_[0] }
+sub pop (\@) { CORE::pop @{$_[0]}; }
-sub push (\@;@) { my $arr = CORE::shift; CORE::push @$arr, @_; $arr; }
+sub push (\@;@) { my $arr = CORE::shift; CORE::push @$arr, @_; wantarray ? return @$arr : $arr; }
sub unshift (\@;@) { my $a = CORE::shift; CORE::unshift(@$a, @_); wantarray ? @$a : $a; }
sub delete (\@$) { my $arr = CORE::shift; CORE::delete $arr->[$_[0]]; wantarray ? @$arr : $arr }
sub vdelete(\@$) { my $arr = CORE::shift; @$arr = CORE::grep {$_ ne $_[0]} @$arr; wantarray ? @$arr : $arr }
-sub shift (\@;@) { my $arr = CORE::shift; CORE::shift @$arr; wantarray ? @$arr : $arr} # last to prevent having to prefix normal shift calls with CORE::
+sub shift (\@;@) { my $arr = CORE::shift; CORE::shift @$arr; } # last to prevent having to prefix normal shift calls with CORE::
sub undef ($) { $_[0] = [] }
@@ -1102,7 +1112,7 @@ sub foreach {
sub for {
my $arr = CORE::shift; my $sub = CORE::shift;
- for(my $i = 0; $i < $#$arr; $i++) {
+ for(my $i = 0; $i <= $#$arr; $i++) {
$sub->($i, $arr->[$i], $arr);
}
}
View
@@ -1,5 +1,5 @@
use Test::More;
-BEGIN { plan tests => 69 };
+BEGIN { plan tests => 72 };
use autobox::Core;
#####################################################################
@@ -87,13 +87,21 @@ my $a = 1->to(10);
ok($a->[0] == 1 && $a->[@$a-1] == 10);
$a = 10->to(1);
ok($a->[0] == 10 && $a->[@$a-1] == 1);
+my @a = 1->to(10);
+is_deeply \@a, [ 1 .. 10 ];
$a = 1->upto(10);
ok($a->[0] == 1 && $a->[@$a-1] == 10);
+@a = 1->upto(10);
+is_deeply \@a, [ 1 .. 10 ];
+
$a = 10->downto(1);
ok($a->[0] == 10 && $a->[@$a-1] == 1);
+@a = 10->downto(1);
+is_deeply \@a, [ reverse 1 .. 10 ];
+
$a = 1;
ok(10->times(sub {$a++}) == 10);
ok($a == 11);
View
@@ -0,0 +1,31 @@
+use Test::More qw(no_plan);
+use strict;
+use warnings;
+
+use autobox::Core;
+
+my %struct = (
+ ARRAY => [ 'foo' ],
+ HASH => { 'foo' => 1 },
+ CODE => sub { 'foo' },
+);
+
+foreach my $reftype ( keys %struct ) {
+ $struct{$reftype}->bless("Object");
+ is ref $struct{$reftype}, "Object";
+}
+
+TODO: {
+ todo_skip "Make it work for Regexp, Scalar and Glob", 3;
+ my %todo = (
+ Regexp => qr/foo/,
+ SCALAR => \'foo',
+ GLOB => \*STDIN,
+ );
+
+ foreach my $reftype ( keys %todo ) {
+ $todo{$reftype}->bless("Object");
+ is ref $todo{$reftype}, "Object";
+ }
+}
+
View
@@ -0,0 +1,10 @@
+use Test::More qw(no_plan);
+
+use autobox::Core;
+
+my $line = "This has a new line\n";
+
+$line->chomp;
+
+is $line, "This has a new line";
+
View
@@ -0,0 +1,26 @@
+use Test::More qw(no_plan);
+use strict;
+use warnings;
+
+use autobox::Core;
+
+my $string = "This is a string";
+
+my $char = $string->chop;
+
+is $string, "This is a strin", "Chop modifies the string";
+is $char, "g", "... and returns the last character";
+
+TODO: {
+
+ todo_skip "Chop should work on lists too", 2;
+
+ my @list = qw(foo bar baz);
+
+ my $char = @list->chop;
+
+ is $char, 'z';
+
+ is_deeply \@list, [ 'fo', 'ba', 'ba' ];
+}
+
View
@@ -0,0 +1,7 @@
+use Test::More qw(no_plan);
+use strict;
+use warnings;
+
+use autobox::Core;
+
+is 65->chr, chr(65);
View
@@ -0,0 +1,14 @@
+use Test::More qw(no_plan);
+use strict;
+use warnings;
+
+use autobox::Core;
+
+
+my $times = sub { $_[0] * $_[1] };
+
+my $times_two = $times->curry(2);
+my $times_four = $times->curry(4);
+
+is $times_two->(5), 10;
+is $times_four->(5), 20;
View
@@ -0,0 +1,19 @@
+use Test::More qw(no_plan);
+use strict;
+use warnings;
+
+use autobox::Core;
+
+my %hash = ( foo => 1, bar => 2, baz => 3 );
+
+my @glued;
+%hash->each( sub { push @glued, $_[0] . $_[1] } );
+
+is_deeply [ sort @glued ], [ qw(bar2 baz3 foo1) ];
+
+my @array = values %hash;
+
+my @added;
+@array->each( sub { push @added, $_[0] + 1 } );
+
+is_deeply [ sort @added ], [ qw(2 3 4) ];
View
@@ -0,0 +1,16 @@
+use Test::More qw(no_plan);
+use strict;
+use warnings;
+
+use autobox::Core;
+
+my @array = qw(foo bar baz);
+
+my @returned = @array->elements;
+
+is_deeply \@returned, \@array;
+
+my $count = @array->elements;
+
+is $count, 3;
+
View
@@ -0,0 +1,9 @@
+use Test::More qw(no_plan);
+use strict;
+use warnings;
+
+use autobox::Core;
+
+my @array = qw(foo bar baz);
+
+is @array->elems, 3;
View
@@ -0,0 +1,15 @@
+use Test::More qw(no_plan);
+use strict;
+use warnings;
+
+use autobox::Core;
+
+my @array = qw(foo bar baz);
+
+my @returned = @array->flatten;
+
+is_deeply \@returned, \@array;
+
+my $count = @array->flatten;
+
+is $count, 3;
View
12 t/for.t
@@ -0,0 +1,12 @@
+use Test::More qw(no_plan);
+use strict;
+use warnings;
+
+use autobox::Core;
+
+my @array = qw(1 2 3);
+
+my @added;
+@array->for( sub { my ($i, $v, $arr) = @_; push @added, $i + $v + @$arr } );
+
+is_deeply [ @added ], [ qw(4 6 8) ];
View
@@ -0,0 +1,12 @@
+use Test::More qw(no_plan);
+use strict;
+use warnings;
+
+use autobox::Core;
+
+my @array = qw(1 2 3);
+
+my @added;
+@array->foreach( sub { push @added, $_[0] + 1 } );
+
+is_deeply [ sort @added ], [ qw(2 3 4) ];
View
@@ -1,9 +1,22 @@
#!/usr/bin/env perl
-use autobox::Core;
use Test::More 'no_plan';
+use strict;
+use warnings;
+
+use autobox::Core;
+
+my @array = qw(1 2 3);
+
+my @odd = @array->grep(sub { $_ % 2 });
-my @array = qw( foo bar baz );
+is_deeply \@odd, [qw(1 3)], "Expected coderef grep results";
+
+my $arrayref = @array->grep( sub { 'foo' } );
+
+is ref $arrayref, 'ARRAY', "Returns arrayref in scalar context";
+
+@array = qw( foo bar baz );
my $d;
ok ( eval { @array->grep( sub { 42 } || 1) }, "Should accept code refs" );
@@ -12,15 +25,20 @@ ok ( eval { @array->grep( qr/foo/ ) || 1 }, "Should accept Regexps" );
is_deeply( $d = @array->grep('foo'), [qw( foo )], "Works with SCALAR" );
is_deeply( $d = @array->grep('zar'), [], "Works with SCALAR" );
is_deeply( $d = @array->grep(qr/^ba/), [qw( bar baz )], "Works with Regexp" );
-if( $] >= 5.010 ) {
- is_deeply( $d = @array->grep(+{ boo => 'boy' }), [], "Works with HASH" );
- is_deeply( $d = @array->grep([qw(boo boy)]), [], "Works with ARRAY" );
- is_deeply( $d = @array->grep([qw(foo baz)]), [qw(foo baz)], "Works with ARRAY" );
-}
is_deeply( $d = @array->grep(sub { /^ba/ }), [qw( bar baz )], "... as with Code refs" );
# context
my @d = @array->grep(qr/^ba/);
is scalar @d, 2, "Returns an array in list context";
+SKIP: {
+ skip "Only for 5.10", 1, if $] < 5.010;
+
+ my @names = qw(barney booey moe);
+
+ is_deeply( [ @names->grep(qr/^b/) ], [ qw(barney booey) ] );
+ is_deeply( $d = @array->grep(+{ boo => 'boy' }), [], "Works with HASH" );
+ is_deeply( $d = @array->grep([qw(boo boy)]), [], "Works with ARRAY" );
+ is_deeply( $d = @array->grep([qw(foo baz)]), [qw(foo baz)], "Works with ARRAY" );
+}
View
@@ -0,0 +1,11 @@
+use Test::More qw(no_plan);
+use strict;
+use warnings;
+use autobox::Core;
+
+my $string = "I like pie";
+my $substr = "pie";
+
+is $string->index($substr), 7;
+is $string->index($substr, 8), -1;
+
View
@@ -0,0 +1,10 @@
+use Test::More qw(no_plan);
+use strict;
+use warnings;
+
+use autobox::Core;
+
+my @list = qw(h i t h e r e);
+
+is @list->join(''), 'hithere';
+is @list->join(' '), 'h i t h e r e';
View
@@ -0,0 +1,13 @@
+use Test::More qw(no_plan);
+use strict;
+use warnings;
+
+use autobox::Core;
+
+my %hash = ( foo => 1, bar => 2, baz => 3 );
+
+is_deeply [ sort %hash->keys ], [ qw( bar baz foo ) ];
+
+my $arrayref = %hash->keys;
+
+is ref $arrayref, 'ARRAY', "Returns arrayref in scalar context";
View
9 t/lc.t
@@ -0,0 +1,9 @@
+use Test::More qw(no_plan);
+use strict;
+use warnings;
+
+use autobox::Core;
+
+my $string = "THIS IS A STRING";
+
+is $string->lc, "this is a string";
Oops, something went wrong.

0 comments on commit af5739b

Please sign in to comment.