Hello community,
here is the log from the commit of package perl-List-MoreUtils for
openSUSE:Factory
checked in at Tue May 31 13:06:57 CEST 2011.
--------
--- perl-List-MoreUtils/perl-List-MoreUtils.changes 2011-04-01
13:08:35.000000000 +0200
+++
/mounts/work_src_done/STABLE/perl-List-MoreUtils/perl-List-MoreUtils.changes
2011-05-23 00:30:43.000000000 +0200
@@ -1,0 +2,6 @@
+Sun May 22 22:28:00 UTC 2011 - [email protected]
+
+- update to 0.32:
+ * ore accurate detection of XS support
+
+-------------------------------------------------------------------
calling whatdependson for head-i586
Old:
----
List-MoreUtils-0.30.tar.gz
New:
----
List-MoreUtils-0.32.tar.gz
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Other differences:
------------------
++++++ perl-List-MoreUtils.spec ++++++
--- /var/tmp/diff_new_pack.FGhKO6/_old 2011-05-31 13:06:39.000000000 +0200
+++ /var/tmp/diff_new_pack.FGhKO6/_new 2011-05-31 13:06:39.000000000 +0200
@@ -18,7 +18,7 @@
Name: perl-List-MoreUtils
-Version: 0.30
+Version: 0.32
Release: 1
License: GPL+ or Artistic
%define cpan_name List-MoreUtils
++++++ List-MoreUtils-0.30.tar.gz -> List-MoreUtils-0.32.tar.gz ++++++
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/List-MoreUtils-0.30/Changes
new/List-MoreUtils-0.32/Changes
--- old/List-MoreUtils-0.30/Changes 2010-12-16 04:03:00.000000000 +0100
+++ new/List-MoreUtils-0.32/Changes 2011-05-20 02:51:37.000000000 +0200
@@ -1,4 +1,17 @@
-Revision history for Perl extension List-Any/List-MoreUtils
+Revision history for Perl extension List-MoreUtils
+
+0.32 Fri May 20 2011
+ - Production release, no other changes
+
+0.31_02 Mon 21 Mar 2011
+ - More accurate detection of XS support (ADAMK)
+
+0.31_01 Mon 21 Mar 2011
+ - Updating copyright year (ADAMK)
+ - Teak documentation of all() and none() (WYANT)
+ - Memory leak fixed for apply() and XS version restored (ARC)
+ - Memory leak fixed for indexes() and XS version restored (ARC)
+ - Memory leak fixed for part() and XS version restored (ARC)
0.30 Thu 16 Dec 2010
- Change the way we localise PERL_DL_NONLAZY to false to remove
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/List-MoreUtils-0.30/MANIFEST
new/List-MoreUtils-0.32/MANIFEST
--- old/List-MoreUtils-0.30/MANIFEST 2010-12-16 04:03:31.000000000 +0100
+++ new/List-MoreUtils-0.32/MANIFEST 2011-05-20 02:52:13.000000000 +0200
@@ -7,6 +7,7 @@
MoreUtils.xs
multicall.h
README
+sanexs.c
t/01_compile.t
t/02_perl.t
t/03_xs.t
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/List-MoreUtils-0.30/META.yml
new/List-MoreUtils-0.32/META.yml
--- old/List-MoreUtils-0.30/META.yml 2010-12-16 04:03:31.000000000 +0100
+++ new/List-MoreUtils-0.32/META.yml 2011-05-20 02:52:13.000000000 +0200
@@ -1,16 +1,18 @@
--- #YAML:1.0
name: List-MoreUtils
-version: 0.30
+version: 0.32
abstract: Provide the stuff missing in List::Util
author:
- Tassilo von Parseval <[email protected]>
license: perl
distribution_type: module
configure_requires:
- ExtUtils::MakeMaker: 0
+ ExtUtils::CBuilder: 0.27
+ ExtUtils::MakeMaker: 6.52
build_requires:
- ExtUtils::MakeMaker: 0
+ Test::More: 0.42
requires:
+ perl: 5.00503
Test::More: 0.82
no_index:
directory:
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/List-MoreUtils-0.30/Makefile.PL
new/List-MoreUtils-0.32/Makefile.PL
--- old/List-MoreUtils-0.30/Makefile.PL 2010-12-16 04:03:00.000000000 +0100
+++ new/List-MoreUtils-0.32/Makefile.PL 2011-05-20 02:51:37.000000000 +0200
@@ -12,19 +12,29 @@
/^-xs/ and $make_xs = 1;
}
unless ( defined $make_xs ) {
- $make_xs = can_cc();
+ $make_xs = can_xs();
}
WriteMakefile(
- NAME => 'List::MoreUtils',
- ABSTRACT => 'Provide the stuff missing in List::Util',
- VERSION_FROM => 'lib/List/MoreUtils.pm',
- AUTHOR => 'Tassilo von Parseval
<[email protected]>',
- LICENSE => 'perl',
- PREREQ_PM => {
+ NAME => 'List::MoreUtils',
+ ABSTRACT => 'Provide the stuff missing in List::Util',
+ VERSION_FROM => 'lib/List/MoreUtils.pm',
+ AUTHOR => 'Tassilo von Parseval
<[email protected]>',
+ LICENSE => 'perl',
+ MIN_PERL_VERSION => '5.00503',
+ CONFIGURE_REQUIRES => {
+ 'ExtUtils::MakeMaker' => '6.52',
+ 'ExtUtils::CBuilder' => '0.27',
+ },
+ BUILD_REQUIRES => {
+ 'Test::More' => '0.42',
+ },
+ PREREQ_PM => {
'Test::More' => '0.82',
},
- CONFIGURE => sub {
+
+ # Special stuff
+ CONFIGURE => sub {
my $hash = $_[1];
unless ( $make_xs ) {
$hash->{XS} = { };
@@ -44,28 +54,80 @@
######################################################################
# Support Functions
+# Modified from eumm-upgrade by Alexandr Ciornii.
sub WriteMakefile {
- my %params = @_;
- my $eumm_version = $ExtUtils::MakeMaker::VERSION;
- $eumm_version = eval $eumm_version;
+ my %params=@_;
+ my $eumm_version=$ExtUtils::MakeMaker::VERSION;
+ $eumm_version=eval $eumm_version;
die "EXTRA_META is deprecated" if exists $params{EXTRA_META};
die "License not specified" unless exists $params{LICENSE};
- if ($params{BUILD_REQUIRES} and $eumm_version < 6.5503) {
- # EUMM 6.5502 has problems with BUILD_REQUIRES
- $params{PREREQ_PM} = {
- %{ $params{PREREQ_PM} || {} },
- %{ $params{BUILD_REQUIRES} }
- };
+ if ( $params{BUILD_REQUIRES} and $eumm_version < 6.5503 ) {
+ #EUMM 6.5502 has problems with BUILD_REQUIRES
+ $params{PREREQ_PM}={ %{$params{PREREQ_PM} || {}} ,
%{$params{BUILD_REQUIRES}} };
delete $params{BUILD_REQUIRES};
}
delete $params{CONFIGURE_REQUIRES} if $eumm_version < 6.52;
delete $params{MIN_PERL_VERSION} if $eumm_version < 6.48;
delete $params{META_MERGE} if $eumm_version < 6.46;
+ delete $params{META_ADD} if $eumm_version < 6.46;
delete $params{LICENSE} if $eumm_version < 6.31;
delete $params{AUTHOR} if $] < 5.005;
+ delete $params{ABSTRACT_FROM} if $] < 5.005;
+ delete $params{BINARY_LOCATION} if $] < 5.005;
ExtUtils::MakeMaker::WriteMakefile(%params);
}
+# Secondary compile testing via ExtUtils::CBuilder
+sub can_xs {
+ # Do we have the configure_requires checker?
+ local $@;
+ eval "require ExtUtils::CBuilder;";
+ if ( $@ ) {
+ # They don't obey configure_requires, so it is
+ # someone old and delicate. Try to avoid hurting
+ # them by falling back to an older simpler test.
+ return can_cc();
+ }
+
+ # Do a simple compile that consumes the headers we need
+ my $object = undef;
+ my @libs = ();
+ eval {
+ my $builder = ExtUtils::CBuilder->new( quiet => 1 );
+ unless ( $builder->have_compiler ) {
+ # Simple lack of a compiler at all
+ return 0;
+ }
+ $object = $builder->compile(
+ source => 'sanexs.c',
+ );
+ @libs = $builder->link(
+ objects => $object,
+ module_name => 'sanexs',
+ );
+ };
+ my $broken = !! $@;
+ foreach ( $object, @libs ) {
+ next unless defined $_;
+ 1 while unlink $_;
+ }
+
+ if ( $broken ) {
+ ### NOTE: Don't do this in a production release.
+ # Compiler is officially screwed, you don't deserve
+ # to do any of our downstream depedencies as you'll
+ # probably end up choking on them as well.
+ # Trigger an NA for their own protection.
+ print "Unresolvable broken external dependency.\n";
+ print "This package requires a C compiler with full perl
headers.\n";
+ print "Trivial test code using them failed to compile.\n";
+ print STDERR "NA: Unable to build distribution on this
platform.\n";
+ exit(0);
+ }
+
+ return 1;
+}
+
sub can_cc {
my @chunks = split(/ /, $Config::Config{cc}) or return;
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/List-MoreUtils-0.30/MoreUtils.xs
new/List-MoreUtils-0.32/MoreUtils.xs
--- old/List-MoreUtils-0.30/MoreUtils.xs 2010-12-16 04:03:00.000000000
+0100
+++ new/List-MoreUtils-0.32/MoreUtils.xs 2011-05-20 02:51:37.000000000
+0200
@@ -573,7 +573,6 @@
OUTPUT:
RETVAL
-#if 0
void
apply (code, ...)
SV *code;
@@ -603,12 +602,13 @@
}
POP_MULTICALL;
+ for(i = 1 ; i < items ; ++i)
+ sv_2mortal(args[i-1]);
+
done:
XSRETURN(items-1);
}
-#endif
-
void
after (code, ...)
SV *code;
@@ -754,7 +754,6 @@
XSRETURN(i-1);
}
-#if 0
void
indexes (code, ...)
SV *code;
@@ -779,23 +778,21 @@
for (i = 1, j = 0; i < items; i++) {
GvSV(PL_defgv) = args[i];
MULTICALL;
- if (SvTRUE(*PL_stack_sp)) {
- args[j] = sv_2mortal(newSViv(i-1));
- /* need to artificially increase ref-count here
- * because POPBLOCK further below would otherwise
- * free the items in SP */
- SvREFCNT_inc(args[j]);
- j++;
- }
+ if (SvTRUE(*PL_stack_sp))
+ /* POP_MULTICALL can free mortal temporaries, so we defer
+ * mortalising the returned values till after that's been
+ * done */
+ args[j++] = newSViv(i-1);
}
POP_MULTICALL;
-
+
+ for (i = 0; i < j; i++)
+ sv_2mortal(args[i]);
+
XSRETURN(j);
}
-#endif
-
SV *
lastval (code, ...)
SV *code;
@@ -895,7 +892,6 @@
AV *av = args->avs[i];
if (args->curidx <= av_len(av)) {
ST(i) = sv_2mortal(newSVsv(*av_fetch(av, args->curidx, FALSE)));
- SvREFCNT_inc(ST(i));
exhausted = 0;
continue;
}
@@ -1055,7 +1051,6 @@
for (j = nret-1; j >= 0; j--) {
/* POPs would return elements in reverse order */
buf[d] = sp[-j];
- SvREFCNT_inc(buf[d]);
d++;
}
sp -= nret;
@@ -1089,9 +1084,8 @@
EXTEND(SP, nret);
for (i = 0; i < args->natatime; i++) {
- if (args->nsvs) {
+ if (args->curidx < args->nsvs) {
ST(i) = sv_2mortal(newSVsv(args->svs[args->curidx++]));
- args->nsvs--;
}
else {
XSRETURN(i);
@@ -1168,7 +1162,8 @@
{
register int i, count = 0;
HV *hv = newHV();
-
+ sv_2mortal(newRV_noinc((SV*)hv));
+
/* don't build return list in scalar context */
if (GIMME == G_SCALAR) {
for (i = 0; i < items; i++) {
@@ -1177,7 +1172,6 @@
hv_store_ent(hv, ST(i), &PL_sv_yes, 0);
}
}
- SvREFCNT_dec(hv);
ST(0) = sv_2mortal(newSViv(count));
XSRETURN(1);
}
@@ -1190,7 +1184,6 @@
hv_store_ent(hv, ST(i), &PL_sv_yes, 0);
}
}
- SvREFCNT_dec(hv);
XSRETURN(count);
}
@@ -1272,7 +1265,6 @@
XSRETURN(2);
}
-#if 0
void
part (code, ...)
SV *code;
@@ -1322,19 +1314,16 @@
EXTEND(SP, last);
for (i = 0; i < last; ++i) {
- if (!tmp[i]) {
- ST(i) = &PL_sv_undef;
- continue;
- }
- ST(i) = newRV_noinc((SV*)tmp[i]);
+ if (tmp[i])
+ ST(i) = sv_2mortal(newRV_noinc((SV*)tmp[i]));
+ else
+ ST(i) = &PL_sv_undef;
}
Safefree(tmp);
XSRETURN(last);
}
-#endif
-
#if 0
void
part_dhash (code, ...)
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/List-MoreUtils-0.30/README
new/List-MoreUtils-0.32/README
--- old/List-MoreUtils-0.30/README 2010-12-16 04:03:00.000000000 +0100
+++ new/List-MoreUtils-0.32/README 2011-05-20 02:51:37.000000000 +0200
@@ -35,22 +35,23 @@
all BLOCK LIST
Returns a true value if all items in LIST meet the criterion given
- through BLOCK. Sets $_ for each item in LIST in turn:
+ through BLOCK, or if LIST is empty. Sets $_ for each item in LIST in
+ turn:
print "All items defined"
if all { defined($_) } @list;
- Returns false otherwise, or if LIST is empty.
+ Returns false otherwise.
none BLOCK LIST
Logically the negation of "any". Returns a true value if no item in
- LIST meets the criterion given through BLOCK. Sets $_ for each item
- in LIST in turn:
+ LIST meets the criterion given through BLOCK, or if LIST is empty.
+ Sets $_ for each item in LIST in turn:
print "No value defined"
if none { defined($_) } @list;
- Returns false otherwise, or if LIST is empty.
+ Returns false otherwise.
notall BLOCK LIST
Logically the negation of "all". Returns a true value if not all
@@ -220,7 +221,7 @@
Like each_array, but the arguments are references to arrays, not the
plain arrays.
- natatime BLOCK LIST
+ natatime EXPR, LIST
Creates an array iterator, for looping over an array in chunks of $n
items at a time. (n at a time, get it?). An example is probably a
better explanation than I could give in words.
@@ -428,9 +429,13 @@
List::Util
AUTHOR
+ Adam Kennedy <[email protected]>
+
Tassilo von Parseval <[email protected]>
COPYRIGHT AND LICENSE
+ Some parts copyright 2011 Aaron Crane.
+
Copyright 2004 - 2010 by Tassilo von Parseval
This library is free software; you can redistribute it and/or modify it
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/List-MoreUtils-0.30/lib/List/MoreUtils.pm
new/List-MoreUtils-0.32/lib/List/MoreUtils.pm
--- old/List-MoreUtils-0.30/lib/List/MoreUtils.pm 2010-12-16
04:03:00.000000000 +0100
+++ new/List-MoreUtils-0.32/lib/List/MoreUtils.pm 2011-05-20
02:51:37.000000000 +0200
@@ -7,7 +7,8 @@
use vars qw{ $VERSION @ISA @EXPORT_OK %EXPORT_TAGS };
BEGIN {
- $VERSION = '0.30';
+ $VERSION = '0.32';
+ # $VERSION = eval $VERSION;
@ISA = qw{ Exporter DynaLoader };
@EXPORT_OK = qw{
any all none notall true false
@@ -38,31 +39,6 @@
} unless $ENV{LIST_MOREUTILS_PP};
}
-# Always use Perl apply() until memory leaks are resolved.
-sub apply (&@) {
- my $action = shift;
- &$action foreach my @values = @_;
- wantarray ? @values : $values[-1];
-}
-
-# Always use Perl part() until memory leaks are resolved.
-sub part (&@) {
- my ($code, @list) = @_;
- my @parts;
- push @{ $parts[ $code->($_) ] }, $_ foreach @list;
- return @parts;
-}
-
-# Always use Perl indexes() until memory leaks are resolved.
-sub indexes (&@) {
- my $test = shift;
- grep {
- local *_ = \$_[$_];
- $test->()
- } 0 .. $#_;
-}
-
-# Load the pure-Perl versions of the other functions if needed
eval <<'END_PERL' unless defined &any;
# Use pure scalar boolean return values for compatibility with XS
@@ -168,6 +144,12 @@
return 0;
}
+sub apply (&@) {
+ my $action = shift;
+ &$action foreach my @values = @_;
+ wantarray ? @values : $values[-1];
+}
+
sub after (&@) {
my $test = shift;
my $started;
@@ -202,6 +184,14 @@
}, @_;
}
+sub indexes (&@) {
+ my $test = shift;
+ grep {
+ local *_ = \$_[$_];
+ $test->()
+ } 0 .. $#_;
+}
+
sub lastval (&@) {
my $test = shift;
my $ix;
@@ -343,6 +333,13 @@
return ($min, $max);
}
+sub part (&@) {
+ my ($code, @list) = @_;
+ my @parts;
+ push @{ $parts[ $code->($_) ] }, $_ foreach @list;
+ return @parts;
+}
+
sub _XScompiled {
return 0;
}
@@ -408,22 +405,23 @@
=item all BLOCK LIST
Returns a true value if all items in LIST meet the criterion given through
-BLOCK. Sets C<$_> for each item in LIST in turn:
+BLOCK, or if LIST is empty. Sets C<$_> for each item in LIST in turn:
print "All items defined"
if all { defined($_) } @list;
-Returns false otherwise, or if LIST is empty.
+Returns false otherwise.
=item none BLOCK LIST
Logically the negation of C<any>. Returns a true value if no item in LIST meets
-the criterion given through BLOCK. Sets C<$_> for each item in LIST in turn:
+the criterion given through BLOCK, or if LIST is empty. Sets C<$_> for each
item
+in LIST in turn:
print "No value defined"
if none { defined($_) } @list;
-Returns false otherwise, or if LIST is empty.
+Returns false otherwise.
=item notall BLOCK LIST
@@ -608,7 +606,7 @@
Like each_array, but the arguments are references to arrays, not the
plain arrays.
-=item natatime BLOCK LIST
+=item natatime EXPR, LIST
Creates an array iterator, for looping over an array in chunks of
C<$n> items at a time. (n at a time, get it?). An example is
@@ -834,10 +832,14 @@
=head1 AUTHOR
+Adam Kennedy E<lt>[email protected]<gt>
+
Tassilo von Parseval E<lt>[email protected]<gt>
=head1 COPYRIGHT AND LICENSE
+Some parts copyright 2011 Aaron Crane.
+
Copyright 2004 - 2010 by Tassilo von Parseval
This library is free software; you can redistribute it and/or modify
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/List-MoreUtils-0.30/sanexs.c
new/List-MoreUtils-0.32/sanexs.c
--- old/List-MoreUtils-0.30/sanexs.c 1970-01-01 01:00:00.000000000 +0100
+++ new/List-MoreUtils-0.32/sanexs.c 2011-05-20 02:51:37.000000000 +0200
@@ -0,0 +1,11 @@
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+int main(int argc, char **argv) {
+ return 0;
+}
+
+int boot_sanexs() {
+ return 1;
+}
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/List-MoreUtils-0.30/t/lib/Test.pm
new/List-MoreUtils-0.32/t/lib/Test.pm
--- old/List-MoreUtils-0.30/t/lib/Test.pm 2010-12-16 04:03:00.000000000
+0100
+++ new/List-MoreUtils-0.32/t/lib/Test.pm 2011-05-20 02:51:37.000000000
+0200
@@ -7,7 +7,7 @@
# Run all tests
sub run {
- plan tests => 154;
+ plan tests => 184;
test_any();
test_all();
@@ -55,6 +55,15 @@
is_false( any { not defined } @list );
is_true( any { not defined } undef );
is_false( any { } );
+
+ leak_free_ok(any => sub {
+ my $ok = any { $_ == 5000 } @list;
+ my $ok2 = any { $_ == 5000 } 1 .. 10000;
+ });
+ leak_free_ok('any with a coderef that dies' => sub {
+ # This test is from Kevin Ryde; see RT#48669
+ eval { my $ok = any { die } 1 };
+ });
}
sub test_all {
@@ -64,6 +73,11 @@
is_true( all { $_ > 0 } @list );
is_false( all { $_ < 5000 } @list );
is_true( all { } );
+
+ leak_free_ok(all => sub {
+ my $ok = all { $_ == 5000 } @list;
+ my $ok2 = all { $_ == 5000 } 1 .. 10000;
+ });
}
sub test_none {
@@ -73,6 +87,11 @@
is_true( none { $_ > 10000 } @list );
is_false( none { defined } @list );
is_true( none { } );
+
+ leak_free_ok(none => sub {
+ my $ok = none { $_ == 5000 } @list;
+ my $ok2 = none { $_ == 5000 } 1 .. 10000;
+ });
}
sub test_notall {
@@ -82,6 +101,11 @@
is_true( notall { $_ < 10000 } @list );
is_false( notall { $_ <= 10000 } @list );
is_false( notall { } );
+
+ leak_free_ok(notall => sub {
+ my $ok = notall { $_ == 5000 } @list;
+ my $ok2 = notall { $_ == 5000 } 1 .. 10000;
+ });
}
sub test_true {
@@ -96,6 +120,11 @@
is( 10000, true { defined } @list );
is( 0, true { not defined } @list );
is( 1, true { $_ == 5000 } @list );
+
+ leak_free_ok(true => sub {
+ my $n = true { $_ == 5000 } @list;
+ my $n2 = true { $_ == 5000 } 1 .. 10000;
+ });
}
sub test_false {
@@ -110,6 +139,11 @@
is( 10000, false { not defined } @list );
is( 0, false { defined } @list );
is( 1, false { $_ > 1 } @list );
+
+ leak_free_ok(false => sub {
+ my $n = false { $_ == 5000 } @list;
+ my $n2 = false { $_ == 5000 } 1 .. 10000;
+ });
}
sub test_firstidx {
@@ -124,6 +158,11 @@
is( -1, first_index { not defined } @list );
is( 0, first_index { defined } @list );
is( -1, first_index { } );
+
+ leak_free_ok(firstidx => sub {
+ my $i = firstidx { $_ >= 5000 } @list;
+ my $i2 = firstidx { $_ >= 5000 } 1 .. 10000;
+ });
}
sub test_lastidx {
@@ -138,6 +177,11 @@
is( -1, last_index { not defined } @list );
is( 9999, last_index { defined } @list );
is( -1, last_index { } );
+
+ leak_free_ok(lastidx => sub {
+ my $i = lastidx { $_ >= 5000 } @list;
+ my $i2 = lastidx { $_ >= 5000 } 1 .. 10000;
+ });
}
sub test_insert_after {
@@ -152,6 +196,11 @@
insert_after { not defined($_) } "longer" => @list;
$list[2] = "a";
is( join(' ', @list), "This is a longer list" );
+
+ leak_free_ok(insert_after => sub {
+ @list = qw{This is a list};
+ insert_after { $_ eq 'a' } "longer" => @list;
+ });
}
sub test_insert_after_string {
@@ -165,6 +214,11 @@
@list = ( "This\0", "is\0", "a\0", "list\0" );
insert_after_string "a\0", "longer\0", @list;
is( join(' ', @list), "This\0 is\0 a\0 longer\0 list\0" );
+
+ leak_free_ok(insert_after_string => sub {
+ @list = qw{This is a list};
+ insert_after_string "a", "longer", @list;
+ });
}
sub test_apply {
@@ -197,6 +251,14 @@
ok( arrayeq( \@list, [ 1 .. 4 ] ) );
ok( arrayeq( \@list1, [ ( 5 ) x 4 ] ) );
}
+
+ leak_free_ok(apply => sub {
+ @list = ( 1 .. 4 );
+ @list1 = apply {
+ grow_stack();
+ $_ = 5;
+ } @list;
+ });
}
sub test_indexes {
@@ -204,6 +266,11 @@
ok( arrayeq( \@x, [ 2..5 ] ) );
@x = indexes { $_ > 5 } ( 1 .. 4 );
is_deeply( \@x, [ ], 'Got the null list' );
+
+ leak_free_ok(indexes => sub {
+ @x = indexes { $_ > 5 } ( 4 .. 9 );
+ @x = indexes { $_ > 5 } ( 1 .. 4 );
+ });
}
# In the following, the @dummy variable is needed to circumvent
@@ -215,6 +282,10 @@
is_deeply( \@x, [ ], 'Got the null list' );
@x = before { /f/ } @dummy = qw{ bar baz foo };
ok( arrayeq( \@x, [ qw{ bar baz } ] ) );
+
+ leak_free_ok(before => sub {
+ @x = before { /f/ } @dummy = qw{ bar baz foo };
+ });
}
# In the following, the @dummy variable is needed to circumvent
@@ -226,6 +297,10 @@
ok( arrayeq( \@x, [ qw{ bar baz } ] ) );
@x = before_incl { /f/ } @dummy = qw{ bar baz foo };
ok( arrayeq( \@x, [ qw{ bar baz foo } ] ) );
+
+ leak_free_ok(before_incl => sub {
+ @x = before_incl { /z/ } @dummy = qw{ bar baz foo };
+ });
}
# In the following, the @dummy variable is needed to circumvent
@@ -237,6 +312,10 @@
is_deeply( \@x, [ ], 'Got the null list' );
@x = after { /b/ } @dummy = qw{ bar baz foo };
ok( arrayeq( \@x, [ qw{ baz foo } ] ) );
+
+ leak_free_ok(after => sub {
+ @x = after { /z/ } @dummy = qw{ bar baz foo };
+ });
}
# In the following, the @dummy variable is needed to circumvent
@@ -248,6 +327,10 @@
is_deeply( \@x, [ ], 'Got the null list' );
@x = after_incl { /b/ } @dummy = qw{ bar baz foo };
ok( arrayeq( \@x, [ qw{ bar baz foo } ] ) );
+
+ leak_free_ok(after_incl => sub {
+ @x = after_incl { /z/ } @dummy = qw{ bar baz foo };
+ });
}
sub test_firstval {
@@ -261,6 +344,10 @@
is( $x, 6 );
$x = first_value { $_ > 5 } 1..4;
is( $x, undef );
+
+ leak_free_ok(firstval => sub {
+ $x = firstval { $_ > 5 } 4 .. 9;
+ });
}
sub test_lastval {
@@ -274,6 +361,10 @@
is( $x, 9 );
$x = last_value { $_ > 5 } 1..4;
is( $x, undef );
+
+ leak_free_ok(lastval => sub {
+ $x = lastval { $_ > 5 } 4 .. 9;
+ });
}
sub test_each_array {
@@ -362,6 +453,24 @@
ok( arrayeq( \@a, [ 1, 3, 5 ] ) );
ok( arrayeq( \@b, [ 2, 4, 6 ] ) );
}
+
+ # Note that the leak_free_ok tests for each_array and each_arrayref
+ # should not be run until either of them has been called at least once
+ # in the current perl. That's because calling them the first time
+ # causes the runtime to allocate some memory used for the OO structures
+ # that their implementation uses internally.
+ leak_free_ok(each_array => sub {
+ my @a = (1);
+ my $it = each_array @a;
+ while ( my ($a) = $it->() ) {
+ }
+ });
+ leak_free_ok(each_arrayref => sub {
+ my @a = (1);
+ my $it = each_arrayref \@a;
+ while ( my ($a) = $it->() ) {
+ }
+ });
}
sub test_pairwise {
@@ -425,6 +534,12 @@
# Test that a die inside the code-reference will not be trapped
eval { pairwise { die "I died\n" } @a, @b };
is( $@, "I died\n" );
+
+ leak_free_ok(pairwise => sub {
+ @a = (1);
+ @b = (2);
+ @c = pairwise { $a + $b } @a, @b;
+ });
}
sub test_natatime {
@@ -444,6 +559,14 @@
push @r, @vals;
}
is( arrayeq( \@r, \@a ), 1, "natatime2" );
+
+ leak_free_ok(natatime => sub {
+ my @y = 1;
+ my $it = natatime 2, @y;
+ while ( my @vals = $it->() ) {
+ # do nothing
+ }
+ });
}
sub test_zip {
@@ -475,6 +598,12 @@
] )
);
}
+
+ leak_free_ok(zip => sub {
+ my @x = qw/a b c d/;
+ my @y = qw/1 2 3 4/;
+ my @z = zip @x, @y;
+ });
}
sub test_mesh {
@@ -506,6 +635,12 @@
] )
);
}
+
+ leak_free_ok(mesh => sub {
+ my @x = qw/a b c d/;
+ my @y = qw/1 2 3 4/;
+ my @z = mesh @x, @y;
+ });
}
sub test_uniq {
@@ -536,6 +671,23 @@
# is_deeply( [ uniq @foo ], \@foo, 'undef is supported correctly' );
# is_deeply( \@warnings, [ ], 'No warnings during uniq check' );
# }
+
+ leak_free_ok(uniq => sub {
+ my @a = map { ( 1 .. 1000 ) } 0 .. 1;
+ my @u = uniq @a;
+ });
+
+ # This test (and the associated fix) are from Kevin Ryde; see RT#49796
+ leak_free_ok('uniq with exception in overloading stringify', sub {
+ eval {
+ my $obj = DieOnStringify->new;
+ my @u = uniq $obj, $obj;
+ };
+ eval {
+ my $obj = DieOnStringify->new;
+ my $u = uniq $obj, $obj;
+ };
+ });
}
sub test_part {
@@ -578,6 +730,17 @@
foreach ( 1 .. 10 ) {
ok( arrayeq($list[$_], [ $_ ]) );
}
+
+ leak_free_ok(part => sub {
+ my @list = 1 .. 12;
+ my $i = 0;
+ my @part = part { $i++ % 3 } @list;
+ });
+
+ leak_free_ok('part with stack-growing' => sub {
+ # This test is from Kevin Ryde; see RT#38699
+ my @part = part { grow_stack(); 1024 } 'one', 'two';
+ });
}
sub test_minmax {
@@ -612,6 +775,11 @@
is( $max, -1 );
$min = 2;
is( $max, -1 );
+
+ leak_free_ok(minmax => sub {
+ @list = ( 0, -1.1, 3.14, 1 / 7, 10000, -10 / 3 );
+ ($min, $max) = minmax @list;
+ });
}
@@ -654,4 +822,21 @@
return 1;
}
+sub leak_free_ok {
+ my $name = shift;
+ my $code = shift;
+ SKIP: {
+ skip 'Test::LeakTrace not installed', 1
+ unless eval { require Test::LeakTrace; 1 };
+ &Test::LeakTrace::no_leaks_ok($code, "No memory leaks in $name");
+ }
+}
+
+{
+ package DieOnStringify;
+ use overload '""' => \&stringify;
+ sub new { bless {}, shift }
+ sub stringify { die 'DieOnStringify exception' }
+}
+
1;
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/List-MoreUtils-0.30/xt/pmv.t
new/List-MoreUtils-0.32/xt/pmv.t
--- old/List-MoreUtils-0.30/xt/pmv.t 2010-12-16 04:03:00.000000000 +0100
+++ new/List-MoreUtils-0.32/xt/pmv.t 2011-05-20 02:51:37.000000000 +0200
@@ -9,7 +9,7 @@
}
my @MODULES = (
- 'Perl::MinimumVersion 1.25',
+ 'Perl::MinimumVersion 1.27',
'Test::MinimumVersion 0.101080',
);
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Remember to have fun...
--
To unsubscribe, e-mail: [email protected]
For additional commands, e-mail: [email protected]
