r73592 - in /branches/upstream/liblist-utilsby-perl/current: ./ lib/List/ t/
angelabad-guest at users.alioth.debian.org
angelabad-guest at users.alioth.debian.org
Tue Apr 26 08:19:22 UTC 2011
Author: angelabad-guest
Date: Tue Apr 26 08:18:28 2011
New Revision: 73592
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=73592
Log:
[svn-upgrade] new version liblist-utilsby-perl (0.07)
Added:
branches/upstream/liblist-utilsby-perl/current/META.json
branches/upstream/liblist-utilsby-perl/current/t/01sort_by.t
branches/upstream/liblist-utilsby-perl/current/t/02nsort_by.t
branches/upstream/liblist-utilsby-perl/current/t/03max_by.t
branches/upstream/liblist-utilsby-perl/current/t/04min_by.t
branches/upstream/liblist-utilsby-perl/current/t/05uniq_by.t
branches/upstream/liblist-utilsby-perl/current/t/06partition_by.t
branches/upstream/liblist-utilsby-perl/current/t/07count_by.t
branches/upstream/liblist-utilsby-perl/current/t/08zip_by.t
branches/upstream/liblist-utilsby-perl/current/t/09extract_by.t
branches/upstream/liblist-utilsby-perl/current/t/10weighted_shuffle_by.t
branches/upstream/liblist-utilsby-perl/current/t/11bundle_by.t
branches/upstream/liblist-utilsby-perl/current/t/TestRand.pm
Removed:
branches/upstream/liblist-utilsby-perl/current/t/01sortby.t
branches/upstream/liblist-utilsby-perl/current/t/02nsortby.t
branches/upstream/liblist-utilsby-perl/current/t/03maxby.t
branches/upstream/liblist-utilsby-perl/current/t/04minby.t
branches/upstream/liblist-utilsby-perl/current/t/05uniqby.t
branches/upstream/liblist-utilsby-perl/current/t/06partitionby.t
branches/upstream/liblist-utilsby-perl/current/t/07zipby.t
branches/upstream/liblist-utilsby-perl/current/t/08extract_by.t
Modified:
branches/upstream/liblist-utilsby-perl/current/Build.PL
branches/upstream/liblist-utilsby-perl/current/Changes
branches/upstream/liblist-utilsby-perl/current/LICENSE
branches/upstream/liblist-utilsby-perl/current/MANIFEST
branches/upstream/liblist-utilsby-perl/current/META.yml
branches/upstream/liblist-utilsby-perl/current/Makefile.PL
branches/upstream/liblist-utilsby-perl/current/README
branches/upstream/liblist-utilsby-perl/current/lib/List/UtilsBy.pm
branches/upstream/liblist-utilsby-perl/current/t/98back-compat.t
branches/upstream/liblist-utilsby-perl/current/t/99pod.t
Modified: branches/upstream/liblist-utilsby-perl/current/Build.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liblist-utilsby-perl/current/Build.PL?rev=73592&op=diff
==============================================================================
--- branches/upstream/liblist-utilsby-perl/current/Build.PL (original)
+++ branches/upstream/liblist-utilsby-perl/current/Build.PL Tue Apr 26 08:18:28 2011
@@ -6,6 +6,9 @@
my $build = Module::Build->new
(
module_name => 'List::UtilsBy',
+ requires => {
+ 'Exporter' => '5.57',
+ },
build_requires => {
'Test::More' => 0,
},
Modified: branches/upstream/liblist-utilsby-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liblist-utilsby-perl/current/Changes?rev=73592&op=diff
==============================================================================
--- branches/upstream/liblist-utilsby-perl/current/Changes (original)
+++ branches/upstream/liblist-utilsby-perl/current/Changes Tue Apr 26 08:18:28 2011
@@ -1,4 +1,7 @@
Revision history for List-UtilsBy
+
+0.07 CHANGES:
+ * Added 'count_by', 'weighted_shuffle_by', 'bundle_by'
0.06 CHANGES:
* Added 'rev_sort_by' and 'rev_nsort_by'
Modified: branches/upstream/liblist-utilsby-perl/current/LICENSE
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liblist-utilsby-perl/current/LICENSE?rev=73592&op=diff
==============================================================================
--- branches/upstream/liblist-utilsby-perl/current/LICENSE (original)
+++ branches/upstream/liblist-utilsby-perl/current/LICENSE Tue Apr 26 08:18:28 2011
@@ -1,4 +1,4 @@
-This software is copyright (c) 2010 by Paul Evans <leonerd at leonerd.org.uk>.
+This software is copyright (c) 2011 by Paul Evans <leonerd at leonerd.org.uk>.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
@@ -12,7 +12,7 @@
--- The GNU General Public License, Version 1, February 1989 ---
-This software is Copyright (c) 2010 by Paul Evans <leonerd at leonerd.org.uk>.
+This software is Copyright (c) 2011 by Paul Evans <leonerd at leonerd.org.uk>.
This is free software, licensed under:
@@ -270,7 +270,7 @@
--- The Artistic License 1.0 ---
-This software is Copyright (c) 2010 by Paul Evans <leonerd at leonerd.org.uk>.
+This software is Copyright (c) 2011 by Paul Evans <leonerd at leonerd.org.uk>.
This is free software, licensed under:
Modified: branches/upstream/liblist-utilsby-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liblist-utilsby-perl/current/MANIFEST?rev=73592&op=diff
==============================================================================
--- branches/upstream/liblist-utilsby-perl/current/MANIFEST (original)
+++ branches/upstream/liblist-utilsby-perl/current/MANIFEST Tue Apr 26 08:18:28 2011
@@ -4,16 +4,21 @@
LICENSE
Makefile.PL
MANIFEST This list of files
+META.json
META.yml
README
t/00use.t
-t/01sortby.t
-t/02nsortby.t
-t/03maxby.t
-t/04minby.t
-t/05uniqby.t
-t/06partitionby.t
-t/07zipby.t
-t/08extract_by.t
+t/01sort_by.t
+t/02nsort_by.t
+t/03max_by.t
+t/04min_by.t
+t/05uniq_by.t
+t/06partition_by.t
+t/07count_by.t
+t/08zip_by.t
+t/09extract_by.t
+t/10weighted_shuffle_by.t
+t/11bundle_by.t
t/98back-compat.t
t/99pod.t
+t/TestRand.pm
Added: branches/upstream/liblist-utilsby-perl/current/META.json
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liblist-utilsby-perl/current/META.json?rev=73592&op=file
==============================================================================
--- branches/upstream/liblist-utilsby-perl/current/META.json (added)
+++ branches/upstream/liblist-utilsby-perl/current/META.json Tue Apr 26 08:18:28 2011
@@ -1,0 +1,46 @@
+{
+ "abstract" : "higher-order list utility functions",
+ "author" : [
+ "Paul Evans <leonerd at leonerd.org.uk>"
+ ],
+ "dynamic_config" : 1,
+ "generated_by" : "Module::Build version 0.38, CPAN::Meta::Converter version 2.110930",
+ "license" : [
+ "perl_5"
+ ],
+ "meta-spec" : {
+ "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
+ "version" : "2"
+ },
+ "name" : "List-UtilsBy",
+ "prereqs" : {
+ "build" : {
+ "requires" : {
+ "Test::More" : 0
+ }
+ },
+ "configure" : {
+ "requires" : {
+ "Module::Build" : "0.38"
+ }
+ },
+ "runtime" : {
+ "requires" : {
+ "Exporter" : "5.57"
+ }
+ }
+ },
+ "provides" : {
+ "List::UtilsBy" : {
+ "file" : "lib/List/UtilsBy.pm",
+ "version" : "0.07"
+ }
+ },
+ "release_status" : "stable",
+ "resources" : {
+ "license" : [
+ "http://dev.perl.org/licenses/"
+ ]
+ },
+ "version" : "0.07"
+}
Modified: branches/upstream/liblist-utilsby-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liblist-utilsby-perl/current/META.yml?rev=73592&op=diff
==============================================================================
--- branches/upstream/liblist-utilsby-perl/current/META.yml (original)
+++ branches/upstream/liblist-utilsby-perl/current/META.yml Tue Apr 26 08:18:28 2011
@@ -5,8 +5,9 @@
build_requires:
Test::More: 0
configure_requires:
- Module::Build: 0.36
-generated_by: 'Module::Build version 0.3607'
+ Module::Build: 0.38
+dynamic_config: 1
+generated_by: 'Module::Build version 0.38, CPAN::Meta::Converter version 2.110930'
license: perl
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
@@ -15,7 +16,9 @@
provides:
List::UtilsBy:
file: lib/List/UtilsBy.pm
- version: 0.06
+ version: 0.07
+requires:
+ Exporter: 5.57
resources:
license: http://dev.perl.org/licenses/
-version: 0.06
+version: 0.07
Modified: branches/upstream/liblist-utilsby-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liblist-utilsby-perl/current/Makefile.PL?rev=73592&op=diff
==============================================================================
--- branches/upstream/liblist-utilsby-perl/current/Makefile.PL (original)
+++ branches/upstream/liblist-utilsby-perl/current/Makefile.PL Tue Apr 26 08:18:28 2011
@@ -1,10 +1,11 @@
-# Note: this file was auto-generated by Module::Build::Compat version 0.3607
+# Note: this file was auto-generated by Module::Build::Compat version 0.3800
use ExtUtils::MakeMaker;
WriteMakefile
(
'NAME' => 'List::UtilsBy',
'VERSION_FROM' => 'lib/List/UtilsBy.pm',
'PREREQ_PM' => {
+ 'Exporter' => '5.57',
'Test::More' => 0
},
'INSTALLDIRS' => 'site',
Modified: branches/upstream/liblist-utilsby-perl/current/README
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liblist-utilsby-perl/current/README?rev=73592&op=diff
==============================================================================
--- branches/upstream/liblist-utilsby-perl/current/README (original)
+++ branches/upstream/liblist-utilsby-perl/current/README Tue Apr 26 08:18:28 2011
@@ -103,6 +103,17 @@
(such as numbers, or object references which overload stringification in
a suitable manner).
+ %counts = count_by { KEYFUNC } @vals
+ Returns a hash of integers, giving the number of times the key function
+ block returned a particular result, for each value in the list.
+
+ my %count_of_balls = count_by { $_->colour } @balls;
+
+ Because the values returned by the key function are used as hash keys,
+ they ought to either be strings, or at least well-behaved as strings
+ (such as numbers, or object references which overload stringification in
+ a suitable manner).
+
@vals = zip_by { ITEMFUNC } \@arr0, \@arr1, \@arr2,...
Returns a list of each of the values returned by the function block,
when invoked with values from across each each of the given ARRAY
@@ -161,6 +172,18 @@
will strengthen them all again.
+ @vals = weighted_shuffle_by { WEIGHTFUNC } @vals
+ Returns the list of values shuffled into a random order. The
+ randomisation is not uniform, but weighted by the value returned by the
+ "WEIGHTFUNC". The probabilty of each item being returned first will be
+ distributed with the distribution of the weights, and so on recursively
+ for the remaining items.
+
+ @vals = bundle_by { BLOCKFUNC } $number, @vals
+ Similar to a regular "map" functional, returns a list of the values
+ returned by "BLOCKFUNC". Values from the input list are given to the
+ block function in bundles of $number.
+
TODO
* XS implementations
Modified: branches/upstream/liblist-utilsby-perl/current/lib/List/UtilsBy.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liblist-utilsby-perl/current/lib/List/UtilsBy.pm?rev=73592&op=diff
==============================================================================
--- branches/upstream/liblist-utilsby-perl/current/lib/List/UtilsBy.pm (original)
+++ branches/upstream/liblist-utilsby-perl/current/lib/List/UtilsBy.pm Tue Apr 26 08:18:28 2011
@@ -1,14 +1,14 @@
# You may distribute under the terms of either the GNU General Public License
# or the Artistic License (the same terms as Perl itself)
#
-# (C) Paul Evans, 2009,2010 -- leonerd at leonerd.org.uk
+# (C) Paul Evans, 2009-2011 -- leonerd at leonerd.org.uk
package List::UtilsBy;
use strict;
use warnings;
-our $VERSION = '0.06';
+our $VERSION = '0.07';
use Exporter 'import';
@@ -24,10 +24,15 @@
uniq_by
partition_by
+ count_by
zip_by
extract_by
+
+ weighted_shuffle_by
+
+ bundle_by
);
# Back-compat for old names of these functions.
@@ -280,6 +285,30 @@
return %parts;
}
+=head2 %counts = count_by { KEYFUNC } @vals
+
+Returns a hash of integers, giving the number of times the key function block
+returned a particular result, for each value in the list.
+
+ my %count_of_balls = count_by { $_->colour } @balls;
+
+Because the values returned by the key function are used as hash keys, they
+ought to either be strings, or at least well-behaved as strings (such as
+numbers, or object references which overload stringification in a suitable
+manner).
+
+=cut
+
+sub count_by(&@)
+{
+ my $code = shift;
+
+ my %counts;
+ $counts{ $code->( local $_ = $_ ) }++ for @_;
+
+ return %counts;
+}
+
=head2 @vals = zip_by { ITEMFUNC } \@arr0, \@arr1, \@arr2,...
Returns a list of each of the values returned by the function block, when
@@ -373,8 +402,59 @@
return @ret;
}
-# Keep perl happy; keep Britain tidy
-1;
+=head2 @vals = weighted_shuffle_by { WEIGHTFUNC } @vals
+
+Returns the list of values shuffled into a random order. The randomisation is
+not uniform, but weighted by the value returned by the C<WEIGHTFUNC>. The
+probabilty of each item being returned first will be distributed with the
+distribution of the weights, and so on recursively for the remaining items.
+
+=cut
+
+sub weighted_shuffle_by(&@)
+{
+ my $code = shift;
+ my @vals = @_;
+
+ my @weights = map { $code->( local $_ = $_ ) } @vals;
+
+ my @ret;
+ while( @vals > 1 ) {
+ my $total = 0; $total += $_ for @weights;
+ my $select = int rand $total;
+ my $idx = 0;
+ while( $select >= $weights[$idx] ) {
+ $select -= $weights[$idx++];
+ }
+
+ push @ret, splice @vals, $idx, 1, ();
+ splice @weights, $idx, 1, ();
+ }
+
+ push @ret, @vals if @vals;
+
+ return @ret;
+}
+
+=head2 @vals = bundle_by { BLOCKFUNC } $number, @vals
+
+Similar to a regular C<map> functional, returns a list of the values returned
+by C<BLOCKFUNC>. Values from the input list are given to the block function in
+bundles of C<$number>.
+
+=cut
+
+sub bundle_by(&@)
+{
+ my $code = shift;
+ my $n = shift;
+
+ my $n_1 = $n - 1;
+
+ map {
+ $code->( @_[$_*$n .. $_*$n+$n_1] )
+ } 0 .. $#_/$n;
+}
=head1 TODO
@@ -401,3 +481,7 @@
=head1 AUTHOR
Paul Evans <leonerd at leonerd.org.uk>
+
+=cut
+
+0x55AA;
Added: branches/upstream/liblist-utilsby-perl/current/t/01sort_by.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liblist-utilsby-perl/current/t/01sort_by.t?rev=73592&op=file
==============================================================================
--- branches/upstream/liblist-utilsby-perl/current/t/01sort_by.t (added)
+++ branches/upstream/liblist-utilsby-perl/current/t/01sort_by.t Tue Apr 26 08:18:28 2011
@@ -1,0 +1,25 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 8;
+
+use List::UtilsBy qw( sort_by rev_sort_by );
+
+is_deeply( [ sort_by { } ], [], 'empty list' );
+
+is_deeply( [ sort_by { $_ } "a" ], [ "a" ], 'unit list' );
+
+is_deeply( [ sort_by { my $ret = $_; undef $_; $ret } "a" ], [ "a" ], 'localises $_' );
+
+is_deeply( [ sort_by { $_ } "a", "b" ], [ "a", "b" ], 'identity function no-op' );
+is_deeply( [ sort_by { $_ } "b", "a" ], [ "a", "b" ], 'identity function on $_' );
+
+is_deeply( [ sort_by { $_[0] } "b", "a" ], [ "a", "b" ], 'identity function on $_[0]' );
+
+# list reverse on a single element is a no-op; scalar reverse will swap the
+# characters. This test also ensures the correct context is seen by the function
+is_deeply( [ sort_by { reverse $_ } "az", "by" ], [ "by", "az" ], 'reverse function' );
+
+is_deeply( [ rev_sort_by { $_ } "b", "a" ], [ "b", "a" ], 'reverse sort identity function on $_' );
Added: branches/upstream/liblist-utilsby-perl/current/t/02nsort_by.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liblist-utilsby-perl/current/t/02nsort_by.t?rev=73592&op=file
==============================================================================
--- branches/upstream/liblist-utilsby-perl/current/t/02nsort_by.t (added)
+++ branches/upstream/liblist-utilsby-perl/current/t/02nsort_by.t Tue Apr 26 08:18:28 2011
@@ -1,0 +1,27 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 9;
+
+use List::UtilsBy qw( nsort_by rev_nsort_by );
+
+is_deeply( [ nsort_by { } ], [], 'empty list' );
+
+is_deeply( [ nsort_by { $_ } 1 ], [ 1 ], 'unit list' );
+
+is_deeply( [ nsort_by { my $ret = $_; undef $_; $ret } 10 ], [ 10 ], 'localises $_' );
+
+is_deeply( [ nsort_by { $_ } 20, 25 ], [ 20, 25 ], 'identity function no-op' );
+is_deeply( [ nsort_by { $_ } 25, 20 ], [ 20, 25 ], 'identity function on $_' );
+
+is_deeply( [ nsort_by { $_[0] } 30, 35 ], [ 30, 35 ], 'identity function on $_[0]' );
+
+is_deeply( [ nsort_by { length $_ } "a", "bbb", "cc" ], [ "a", "cc", "bbb" ], 'length function' );
+
+# List context would yield the matches and fail, scalar context would yield
+# the count and be correct
+is_deeply( [ nsort_by { () = m/(a)/g } "apple", "hello", "armageddon" ], [ "hello", "apple", "armageddon" ], 'scalar context' );
+
+is_deeply( [ rev_nsort_by { length $_ } "a", "bbb", "cc" ], [ "bbb", "cc", "a" ], 'reverse sort length function' );
Added: branches/upstream/liblist-utilsby-perl/current/t/03max_by.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liblist-utilsby-perl/current/t/03max_by.t?rev=73592&op=file
==============================================================================
--- branches/upstream/liblist-utilsby-perl/current/t/03max_by.t (added)
+++ branches/upstream/liblist-utilsby-perl/current/t/03max_by.t Tue Apr 26 08:18:28 2011
@@ -1,0 +1,21 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 8;
+
+use List::UtilsBy qw( max_by );
+
+is_deeply( [ max_by {} ], [], 'empty list yields empty' );
+
+is_deeply( ( scalar max_by { $_ } 10 ), 10, 'unit list yields value in scalar context' );
+is_deeply( [ max_by { $_ } 10 ], [ 10 ], 'unit list yields unit list value' );
+
+is_deeply( ( scalar max_by { $_ } 10, 20 ), 20, 'identity function on $_' );
+is_deeply( ( scalar max_by { $_[0] } 10, 20 ), 20, 'identity function on $_[0]' );
+
+is_deeply( ( scalar max_by { length $_ } "a", "ccc", "bb" ), "ccc", 'length function' );
+
+is_deeply( ( scalar max_by { length $_ } "a", "ccc", "bb", "ddd" ), "ccc", 'ties yield first in scalar context' );
+is_deeply( [ max_by { length $_ } "a", "ccc", "bb", "ddd" ], [ "ccc", "ddd" ], 'ties yield all maximal in list context' );
Added: branches/upstream/liblist-utilsby-perl/current/t/04min_by.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liblist-utilsby-perl/current/t/04min_by.t?rev=73592&op=file
==============================================================================
--- branches/upstream/liblist-utilsby-perl/current/t/04min_by.t (added)
+++ branches/upstream/liblist-utilsby-perl/current/t/04min_by.t Tue Apr 26 08:18:28 2011
@@ -1,0 +1,21 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 8;
+
+use List::UtilsBy qw( min_by );
+
+is_deeply( [ min_by {} ], [], 'empty list yields empty' );
+
+is_deeply( ( scalar min_by { $_ } 10 ), 10, 'unit list yields value in scalar context' );
+is_deeply( [ min_by { $_ } 10 ], [ 10 ], 'unit list yields unit list value' );
+
+is_deeply( ( scalar min_by { $_ } 10, 20 ), 10, 'identity function on $_' );
+is_deeply( ( scalar min_by { $_[0] } 10, 20 ), 10, 'identity function on $_[0]' );
+
+is_deeply( ( scalar min_by { length $_ } "a", "ccc", "bb" ), "a", 'length function' );
+
+is_deeply( ( scalar min_by { length $_ } "a", "ccc", "bb", "e" ), "a", 'ties yield first in scalar context' );
+is_deeply( [ min_by { length $_ } "a", "ccc", "bb", "ddd", "e" ], [ "a", "e" ], 'ties yield all minimal in list context' );
Added: branches/upstream/liblist-utilsby-perl/current/t/05uniq_by.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liblist-utilsby-perl/current/t/05uniq_by.t?rev=73592&op=file
==============================================================================
--- branches/upstream/liblist-utilsby-perl/current/t/05uniq_by.t (added)
+++ branches/upstream/liblist-utilsby-perl/current/t/05uniq_by.t Tue Apr 26 08:18:28 2011
@@ -1,0 +1,21 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 7;
+
+use List::UtilsBy qw( uniq_by );
+
+is_deeply( [ uniq_by { } ], [], 'empty list' );
+
+is_deeply( [ uniq_by { $_ } "a" ], [ "a" ], 'unit list' );
+
+is_deeply( [ uniq_by { my $ret = $_; undef $_; $ret } "a" ], [ "a" ], 'localises $_' );
+
+is_deeply( [ uniq_by { $_ } "a", "b" ], [ "a", "b" ], 'identity function no-op' );
+is_deeply( [ uniq_by { $_ } "b", "a" ], [ "b", "a" ], 'identity function on $_' );
+
+is_deeply( [ uniq_by { $_[0] } "b", "a" ], [ "b", "a" ], 'identity function on $_[0]' );
+
+is_deeply( [ uniq_by { length $_ } "a", "b", "cc", "dd", "eee" ], [ "a", "cc", "eee" ], 'length function' );
Added: branches/upstream/liblist-utilsby-perl/current/t/06partition_by.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liblist-utilsby-perl/current/t/06partition_by.t?rev=73592&op=file
==============================================================================
--- branches/upstream/liblist-utilsby-perl/current/t/06partition_by.t (added)
+++ branches/upstream/liblist-utilsby-perl/current/t/06partition_by.t Tue Apr 26 08:18:28 2011
@@ -1,0 +1,22 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 7;
+
+use List::UtilsBy qw( partition_by );
+
+is_deeply( { partition_by { } }, {}, 'empty list' );
+
+is_deeply( { partition_by { $_ } "a" }, { a => [ "a" ] }, 'unit list' );
+
+is_deeply( { partition_by { my $ret = $_; undef $_; $ret } "a" }, { a => [ "a" ] }, 'localises $_' );
+
+is_deeply( { partition_by { "all" } "a", "b" }, { all => [ "a", "b" ] }, 'constant function preserves order' );
+is_deeply( { partition_by { "all" } "b", "a" }, { all => [ "b", "a" ] }, 'constant function preserves order' );
+
+is_deeply( { partition_by { $_[0] } "b", "a" }, { a => [ "a" ], b => [ "b" ] }, 'identity function on $_[0]' );
+
+is_deeply( { partition_by { length $_ } "a", "b", "cc", "dd", "eee" },
+ { 1 => [ "a", "b" ], 2 => [ "cc", "dd" ], 3 => [ "eee" ] }, 'length function' );
Added: branches/upstream/liblist-utilsby-perl/current/t/07count_by.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liblist-utilsby-perl/current/t/07count_by.t?rev=73592&op=file
==============================================================================
--- branches/upstream/liblist-utilsby-perl/current/t/07count_by.t (added)
+++ branches/upstream/liblist-utilsby-perl/current/t/07count_by.t Tue Apr 26 08:18:28 2011
@@ -1,0 +1,20 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 5;
+
+use List::UtilsBy qw( count_by );
+
+is_deeply( { count_by { } }, {}, 'empty list' );
+
+is_deeply( { count_by { $_ } "a" }, { a => 1 }, 'unit list' );
+
+is_deeply( { count_by { "all" } "a", "b" }, { all => 2 }, 'constant function' );
+
+is_deeply( { count_by { $_[0] } "b", "a" }, { a => 1, b => 1 }, 'identity function on $_[0]' );
+
+is_deeply( { count_by { length $_ } "a", "b", "cc", "dd", "eee" },
+ { 1 => 2, 2 => 2, 3 => 1 }, 'length function' );
+
Added: branches/upstream/liblist-utilsby-perl/current/t/08zip_by.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liblist-utilsby-perl/current/t/08zip_by.t?rev=73592&op=file
==============================================================================
--- branches/upstream/liblist-utilsby-perl/current/t/08zip_by.t (added)
+++ branches/upstream/liblist-utilsby-perl/current/t/08zip_by.t Tue Apr 26 08:18:28 2011
@@ -1,0 +1,22 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 7;
+
+use List::UtilsBy qw( zip_by );
+
+is_deeply( [ zip_by { } ], [], 'empty list' );
+
+is_deeply( [ zip_by { [ @_ ] } [ "a" ], [ "b" ], [ "c" ] ], [ [ "a", "b", "c" ] ], 'singleton lists' );
+
+is_deeply( [ zip_by { [ @_ ] } [ "a", "b", "c" ] ], [ [ "a" ], [ "b" ], [ "c" ] ], 'narrow lists' );
+
+is_deeply( [ zip_by { [ @_ ] } [ "a1", "a2" ], [ "b1", "b2" ] ], [ [ "a1", "b1" ], [ "a2", "b2" ] ], 'zip with []' );
+
+is_deeply( [ zip_by { join ",", @_ } [ "a1", "a2" ], [ "b1", "b2" ] ], [ "a1,b1", "a2,b2" ], 'zip with join()' );
+
+is_deeply( [ zip_by { [ @_ ] } [ 1 .. 3 ], [ 1 .. 2 ] ], [ [ 1, 1 ], [ 2, 2 ], [ 3, undef ] ], 'non-rectangular adds undef' );
+
+is_deeply( { zip_by { @_ } [qw( one two three )], [ 1, 2, 3 ] }, { one => 1, two => 2, three => 3 }, 'itemfunc can return lists' );
Added: branches/upstream/liblist-utilsby-perl/current/t/09extract_by.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liblist-utilsby-perl/current/t/09extract_by.t?rev=73592&op=file
==============================================================================
--- branches/upstream/liblist-utilsby-perl/current/t/09extract_by.t (added)
+++ branches/upstream/liblist-utilsby-perl/current/t/09extract_by.t Tue Apr 26 08:18:28 2011
@@ -1,0 +1,39 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 14;
+
+use Scalar::Util qw( weaken isweak );
+
+use List::UtilsBy qw( extract_by );
+
+# We'll need a real array to work on
+my @numbers = ( 1 .. 10 );
+
+is_deeply( [ extract_by { 0 } @numbers ], [], 'extract false returns none' );
+is_deeply( \@numbers, [ 1 .. 10 ], 'extract false leaves array unchanged' );
+
+is_deeply( [ extract_by { $_ % 3 == 0 } @numbers ], [ 3, 6, 9 ], 'extract div3 returns values' );
+is_deeply( \@numbers, [ 1, 2, 4, 5, 7, 8, 10 ], 'extract div3 removes from array' );
+
+is_deeply( [ extract_by { $_[0] < 5 } @numbers ], [ 1, 2, 4 ], 'extract $_[0] < 4 returns values' );
+is_deeply( \@numbers, [ 5, 7, 8, 10 ], 'extract $_[0] < 4 removes from array' );
+
+is_deeply( [ extract_by { 1 } @numbers ], [ 5, 7, 8, 10 ], 'extract true returns all' );
+is_deeply( \@numbers, [], 'extract true leaves nothing' );
+
+my @refs = map { {} } 1 .. 3;
+
+weaken $_ for my @weakrefs = @refs;
+
+is_deeply( [ extract_by { !defined $_ } @weakrefs ], [], 'extract undef refs returns nothing yet' );
+is( scalar @weakrefs, 3, 'extract undef refs leaves array unchanged' );
+ok( isweak $weakrefs[0], "extract_by doesn't break weakrefs" );
+
+undef $refs[0];
+
+is_deeply( [ extract_by { !defined $_ } @weakrefs ], [ undef ], 'extract undef refs yields an undef' );
+is( scalar @weakrefs, 2, 'extract undef refs removes from array' );
+ok( isweak $weakrefs[0], "extract_by still doesn't break weakrefs" );
Added: branches/upstream/liblist-utilsby-perl/current/t/10weighted_shuffle_by.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liblist-utilsby-perl/current/t/10weighted_shuffle_by.t?rev=73592&op=file
==============================================================================
--- branches/upstream/liblist-utilsby-perl/current/t/10weighted_shuffle_by.t (added)
+++ branches/upstream/liblist-utilsby-perl/current/t/10weighted_shuffle_by.t Tue Apr 26 08:18:28 2011
@@ -1,0 +1,35 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 4;
+use t::TestRand;
+
+use List::UtilsBy qw( weighted_shuffle_by );
+
+is_deeply( [ weighted_shuffle_by { } ], [], 'empty list' );
+
+is_deeply( [ weighted_shuffle_by { 1 } "a" ], [ "a" ], 'unit list' );
+
+my @vals = weighted_shuffle_by { 1 } "a", "b", "c";
+is_deeply( [ sort @vals ], [ "a", "b", "c" ], 'set of return values' );
+
+my %got;
+randomly {
+ my $order = join "",
+ weighted_shuffle_by { { a => 1, b => 2, c => 3 }->{$_} }
+ qw( a b c );
+ $got{$order}++;
+};
+
+my %expect = (
+ 'abc' => 1 * 2,
+ 'acb' => 1 * 3,
+ 'bac' => 2 * 1,
+ 'bca' => 2 * 3,
+ 'cab' => 3 * 1,
+ 'cba' => 3 * 2,
+);
+
+is_deeply( \%got, \%expect, 'Got correct distribution of ordering counts' );
Added: branches/upstream/liblist-utilsby-perl/current/t/11bundle_by.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liblist-utilsby-perl/current/t/11bundle_by.t?rev=73592&op=file
==============================================================================
--- branches/upstream/liblist-utilsby-perl/current/t/11bundle_by.t (added)
+++ branches/upstream/liblist-utilsby-perl/current/t/11bundle_by.t Tue Apr 26 08:18:28 2011
@@ -1,0 +1,16 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 5;
+
+use List::UtilsBy qw( bundle_by );
+
+is_deeply( [ bundle_by { $_[0] } 1, (1, 2, 3) ], [ 1, 2, 3 ], 'bundle_by 1' );
+
+is_deeply( [ bundle_by { $_[0] } 2, (1, 2, 3, 4) ], [ 1, 3 ], 'bundle_by 2 first' );
+is_deeply( [ bundle_by { @_ } 2, (1, 2, 3, 4) ], [ 1, 2, 3, 4 ], 'bundle_by 2 all' );
+is_deeply( [ bundle_by { [ @_ ] } 2, (1, 2, 3, 4) ], [ [ 1, 2 ], [ 3, 4 ] ], 'bundle_by 2 [all]' );
+
+is_deeply( { bundle_by { uc $_[1] => $_[0] } 2, qw( a b c d ) }, { B => "a", D => "c" }, 'bundle_by 2 constructing hash' );
Modified: branches/upstream/liblist-utilsby-perl/current/t/98back-compat.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liblist-utilsby-perl/current/t/98back-compat.t?rev=73592&op=diff
==============================================================================
--- branches/upstream/liblist-utilsby-perl/current/t/98back-compat.t (original)
+++ branches/upstream/liblist-utilsby-perl/current/t/98back-compat.t Tue Apr 26 08:18:28 2011
@@ -1,6 +1,7 @@
-#!/usr/bin/perl -w
+#!/usr/bin/perl
use strict;
+use warnings;
use Test::More tests => 2;
Modified: branches/upstream/liblist-utilsby-perl/current/t/99pod.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liblist-utilsby-perl/current/t/99pod.t?rev=73592&op=diff
==============================================================================
--- branches/upstream/liblist-utilsby-perl/current/t/99pod.t (original)
+++ branches/upstream/liblist-utilsby-perl/current/t/99pod.t Tue Apr 26 08:18:28 2011
@@ -1,4 +1,4 @@
-#!/usr/bin/perl -w
+#!/usr/bin/perl
use Test::More;
Added: branches/upstream/liblist-utilsby-perl/current/t/TestRand.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liblist-utilsby-perl/current/t/TestRand.pm?rev=73592&op=file
==============================================================================
--- branches/upstream/liblist-utilsby-perl/current/t/TestRand.pm (added)
+++ branches/upstream/liblist-utilsby-perl/current/t/TestRand.pm Tue Apr 26 08:18:28 2011
@@ -1,0 +1,55 @@
+package t::TestRand;
+
+use strict;
+use warnings;
+
+use Exporter 'import';
+our @EXPORT = qw( randomly );
+
+my $randhook;
+*CORE::GLOBAL::rand = sub { $randhook ? $randhook->( $_[0] ) : rand $_[0] };
+
+sub randomly(&)
+{
+ my $code = shift;
+
+ my @rands;
+ my $randidx;
+ $randhook = sub {
+ my ( $below ) = @_;
+ if( $randidx > $#rands ) {
+ push @rands, [ 0, $below ];
+ $randidx++;
+ return 0;
+ }
+
+ if( $below != $rands[$randidx][1] ) {
+ die "ARGH! The function under test is nondeterministic!\n";
+ }
+
+ if( $randidx < $#rands and $rands[$randidx+1][0] == $rands[$randidx+1][1]-1 ) {
+ die "Fell off the edge" if $rands[$randidx][0] == $rands[$randidx][1]-1;
+ splice @rands, $randidx+1, @rands-$randidx, ();
+ $rands[$randidx][0]++;
+ return $rands[$randidx++][0];
+ }
+ elsif( $randidx == $#rands ) {
+ $rands[$randidx][0]++;
+ return $rands[$randidx++][0];
+ }
+ else {
+ return $rands[$randidx++][0];
+ }
+ };
+
+ while(1) {
+ my $more = 0;
+ $_->[0] < $_->[1]-1 and $more = 1 for @rands;
+ last if @rands and !$more;
+
+ $randidx = 0;
+ $code->();
+ }
+}
+
+1;
More information about the Pkg-perl-cvs-commits
mailing list