r40784 - in /branches/upstream/liblist-moreutils-perl/current: Changes META.yml MoreUtils.xs README lib/List/MoreUtils.pm t/List-MoreUtils-pp.t t/List-MoreUtils.t
ansgar-guest at users.alioth.debian.org
ansgar-guest at users.alioth.debian.org
Sun Jul 26 23:14:43 UTC 2009
Author: ansgar-guest
Date: Sun Jul 26 23:14:36 2009
New Revision: 40784
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=40784
Log:
[svn-upgrade] Integrating new upstream version, liblist-moreutils-perl (0.24)
Modified:
branches/upstream/liblist-moreutils-perl/current/Changes
branches/upstream/liblist-moreutils-perl/current/META.yml
branches/upstream/liblist-moreutils-perl/current/MoreUtils.xs
branches/upstream/liblist-moreutils-perl/current/README
branches/upstream/liblist-moreutils-perl/current/lib/List/MoreUtils.pm
branches/upstream/liblist-moreutils-perl/current/t/List-MoreUtils-pp.t
branches/upstream/liblist-moreutils-perl/current/t/List-MoreUtils.t
Modified: branches/upstream/liblist-moreutils-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liblist-moreutils-perl/current/Changes?rev=40784&op=diff
==============================================================================
--- branches/upstream/liblist-moreutils-perl/current/Changes (original)
+++ branches/upstream/liblist-moreutils-perl/current/Changes Sun Jul 26 23:14:36 2009
@@ -1,4 +1,29 @@
Revision history for Perl extension List::Any/List::MoreUtils.
+
+0.24 Sun Jul 19 08:26:35 EDT 2009
+ - List::MoreUtils was not handling the stack properly when the stack was grown
+ from inside code-references
+ - a couple of tests for each_arrayref were calling each_array
+
+0.23 Sun Apr 19 06:56:09 EDT 2009
+ - BACKWARDS INCOMPATIBLE CHANGE:
+ fixed: Returning undef when none is passed an empty array is counterintuitive
+ (http://rt.cpan.org/Ticket/Display.html?id=40905)
+ - fixed: minmax error: unpredictable results with lists of 1 element
+ (http://rt.cpan.org/Ticket/Display.html?id=39847)
+ - fixed: bug: uniq doesn't like undef values.
+ uniq warns on undef values
+ (http://rt.cpan.org/Ticket/Display.html?id=37533)
+ (http://rt.cpan.org/Ticket/Display.html?id=43214)
+ - fixed: bug in pairwise when $a and $b are lexically defined using my
+ (http://rt.cpan.org/Ticket/Display.html?id=44518)
+ - fixed: Big memory leak with XS part()
+ (http://rt.cpan.org/Ticket/Display.html?id=41097)
+ - fixed: memory leak in indexes() [XS]
+ (http://rt.cpan.org/Public/Bug/Display.html?id=41494)
+ - reduced memory-requirements for the part() tests as that was responsible
+ for a lot of unnecessary test-failures
+ - new function bsearch() which performs a binary search
0.22 Sun Jul 2 11:25:39 EDT 2006
- SvPV_nolen doesn't exist on pre 5.6 perls
Modified: branches/upstream/liblist-moreutils-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liblist-moreutils-perl/current/META.yml?rev=40784&op=diff
==============================================================================
--- branches/upstream/liblist-moreutils-perl/current/META.yml (original)
+++ branches/upstream/liblist-moreutils-perl/current/META.yml Sun Jul 26 23:14:36 2009
@@ -1,10 +1,21 @@
-# http://module-build.sourceforge.net/META-spec.html
-#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#
-name: List-MoreUtils
-version: 0.22
-version_from: lib/List/MoreUtils.pm
-installdirs: site
-requires:
-
-distribution_type: module
-generated_by: ExtUtils::MakeMaker version 6.30
+--- #YAML:1.0
+name: List-MoreUtils
+version: 0.24
+abstract: Provide the stuff missing in List::Util
+author:
+ - Tassilo von Parseval <tassilo.von.parseval at rwth-aachen.de>
+license: unknown
+distribution_type: module
+configure_requires:
+ ExtUtils::MakeMaker: 0
+build_requires:
+ ExtUtils::MakeMaker: 0
+requires: {}
+no_index:
+ directory:
+ - t
+ - inc
+generated_by: ExtUtils::MakeMaker version 6.50
+meta-spec:
+ url: http://module-build.sourceforge.net/META-spec-v1.4.html
+ version: 1.4
Modified: branches/upstream/liblist-moreutils-perl/current/MoreUtils.xs
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liblist-moreutils-perl/current/MoreUtils.xs?rev=40784&op=diff
==============================================================================
--- branches/upstream/liblist-moreutils-perl/current/MoreUtils.xs (original)
+++ branches/upstream/liblist-moreutils-perl/current/MoreUtils.xs Sun Jul 26 23:14:36 2009
@@ -153,6 +153,37 @@
#define WARN_ON \
PL_curcop->cop_warnings = oldwarn;
+#define FUNC_NAME GvNAME(GvEGV(ST(items)))
+
+inline static int
+in_pad (const char *name, SV *code) {
+
+ GV *gv;
+ HV *stash;
+ CV *cv = sv_2cv(code, &stash, &gv, 0);
+ AV *av = CvPADLIST(cv);
+ AV *pad_names = (AV*)AvARRAY(av)[0];
+
+ SV **names = AvARRAY(pad_names);
+ int len = av_len(pad_names);
+ register int i = 0;
+ for (i = 0; i <= len; ++i) {
+
+ /* perl < 5.6.0 does not yet have our */
+# if (PERL_VERSION > 5)
+ if (SvFLAGS(names[i]) & SVpad_OUR)
+ continue;
+# endif
+
+ if (!SvOK(names[i]))
+ continue;
+
+ if (strEQ(SvPV_nolen(names[i]), "$a") || strEQ(SvPV_nolen(names[i]), "$b"))
+ return 1;
+ }
+ return 0;
+}
+
#define EACH_ARRAY_BODY \
register int i; \
arrayeach_args * args; \
@@ -168,6 +199,8 @@
args->curidx = 0; \
\
for (i = 0; i < items; i++) { \
+ if (!SvROK(ST(i))) \
+ croak("Arguments to %s must be references", FUNC_NAME); \
args->avs[i] = (AV*)SvRV(ST(i)); \
SvREFCNT_inc(args->avs[i]); \
} \
@@ -224,7 +257,6 @@
GV *gv;
HV *stash;
I32 gimme = G_SCALAR;
- SV **args = &PL_stack_base[ax];
CV *cv;
if (items <= 1)
@@ -235,7 +267,7 @@
SAVESPTR(GvSV(PL_defgv));
for(i = 1 ; i < items ; ++i) {
- GvSV(PL_defgv) = args[i];
+ GvSV(PL_defgv) = PL_stack_base[ax+i];
MULTICALL;
if (SvTRUE(*PL_stack_sp)) {
POP_MULTICALL;
@@ -257,7 +289,6 @@
HV *stash;
GV *gv;
I32 gimme = G_SCALAR;
- SV **args = &PL_stack_base[ax];
CV *cv;
if (items <= 1)
@@ -268,7 +299,7 @@
SAVESPTR(GvSV(PL_defgv));
for(i = 1 ; i < items ; i++) {
- GvSV(PL_defgv) = args[i];
+ GvSV(PL_defgv) = PL_stack_base[ax+i];
MULTICALL;
if (!SvTRUE(*PL_stack_sp)) {
POP_MULTICALL;
@@ -291,18 +322,17 @@
HV *stash;
GV *gv;
I32 gimme = G_SCALAR;
- SV **args = &PL_stack_base[ax];
CV *cv;
if (items <= 1)
- XSRETURN_UNDEF;
+ XSRETURN_YES;
cv = sv_2cv(code, &stash, &gv, 0);
PUSH_MULTICALL(cv);
SAVESPTR(GvSV(PL_defgv));
for(i = 1 ; i < items ; ++i) {
- GvSV(PL_defgv) = args[i];
+ GvSV(PL_defgv) = PL_stack_base[ax+i];
MULTICALL;
if (SvTRUE(*PL_stack_sp)) {
POP_MULTICALL;
@@ -324,7 +354,6 @@
HV *stash;
GV *gv;
I32 gimme = G_SCALAR;
- SV **args = &PL_stack_base[ax];
CV *cv;
if (items <= 1)
@@ -335,7 +364,7 @@
SAVESPTR(GvSV(PL_defgv));
for(i = 1 ; i < items ; ++i) {
- GvSV(PL_defgv) = args[i];
+ GvSV(PL_defgv) = PL_stack_base[ax+i];
MULTICALL;
if (!SvTRUE(*PL_stack_sp)) {
POP_MULTICALL;
@@ -358,7 +387,6 @@
GV *gv;
I32 gimme = G_SCALAR;
I32 count = 0;
- SV **args = &PL_stack_base[ax];
CV *cv;
if (items <= 1)
@@ -369,7 +397,7 @@
SAVESPTR(GvSV(PL_defgv));
for(i = 1 ; i < items ; ++i) {
- GvSV(PL_defgv) = args[i];
+ GvSV(PL_defgv) = PL_stack_base[ax+i];
MULTICALL;
if (SvTRUE(*PL_stack_sp))
count++;
@@ -394,7 +422,6 @@
GV *gv;
I32 gimme = G_SCALAR;
I32 count = 0;
- SV **args = &PL_stack_base[ax];
CV *cv;
if (items <= 1)
@@ -405,7 +432,7 @@
SAVESPTR(GvSV(PL_defgv));
for(i = 1 ; i < items ; ++i) {
- GvSV(PL_defgv) = args[i];
+ GvSV(PL_defgv) = PL_stack_base[ax+i];
MULTICALL;
if (!SvTRUE(*PL_stack_sp))
count++;
@@ -429,7 +456,6 @@
HV *stash;
GV *gv;
I32 gimme = G_SCALAR;
- SV **args = &PL_stack_base[ax];
CV *cv;
RETVAL = -1;
@@ -440,7 +466,7 @@
SAVESPTR(GvSV(PL_defgv));
for (i = 1 ; i < items ; ++i) {
- GvSV(PL_defgv) = args[i];
+ GvSV(PL_defgv) = PL_stack_base[ax+i];
MULTICALL;
if (SvTRUE(*PL_stack_sp)) {
RETVAL = i-1;
@@ -464,7 +490,6 @@
HV *stash;
GV *gv;
I32 gimme = G_SCALAR;
- SV **args = &PL_stack_base[ax];
CV *cv;
RETVAL = -1;
@@ -475,7 +500,7 @@
SAVESPTR(GvSV(PL_defgv));
for (i = items-1 ; i > 0 ; --i) {
- GvSV(PL_defgv) = args[i];
+ GvSV(PL_defgv) = PL_stack_base[ax+i];
MULTICALL;
if (SvTRUE(*PL_stack_sp)) {
RETVAL = i-1;
@@ -586,7 +611,6 @@
GV *gv;
I32 gimme = G_SCALAR;
CV *cv;
- SV **args = &PL_stack_base[ax];
I32 count = 0;
if (items <= 1)
@@ -597,9 +621,9 @@
SAVESPTR(GvSV(PL_defgv));
for(i = 1 ; i < items ; ++i) {
- GvSV(PL_defgv) = newSVsv(args[i]);
+ GvSV(PL_defgv) = newSVsv(PL_stack_base[ax+i]);
MULTICALL;
- args[i-1] = GvSV(PL_defgv);
+ PL_stack_base[ax+i-1] = GvSV(PL_defgv);
}
POP_MULTICALL;
@@ -619,7 +643,6 @@
CV *cv;
GV *gv;
I32 gimme = G_SCALAR;
- SV **args = &PL_stack_base[ax];
if (items <= 1)
XSRETURN_EMPTY;
@@ -629,7 +652,7 @@
SAVESPTR(GvSV(PL_defgv));
for (i = 1; i < items; i++) {
- GvSV(PL_defgv) = args[i];
+ GvSV(PL_defgv) = PL_stack_base[ax+i];
MULTICALL;
if (SvTRUE(*PL_stack_sp)) {
break;
@@ -639,7 +662,7 @@
POP_MULTICALL;
for (j = i + 1; j < items; ++j)
- args[j-i-1] = args[j];
+ PL_stack_base[ax+j-i-1] = PL_stack_base[ax+j];
XSRETURN(items-i-1);
}
@@ -656,7 +679,6 @@
CV *cv;
GV *gv;
I32 gimme = G_SCALAR;
- SV **args = &PL_stack_base[ax];
if (items <= 1)
XSRETURN_EMPTY;
@@ -666,7 +688,7 @@
SAVESPTR(GvSV(PL_defgv));
for (i = 1; i < items; i++) {
- GvSV(PL_defgv) = args[i];
+ GvSV(PL_defgv) = PL_stack_base[ax+i];
MULTICALL;
if (SvTRUE(*PL_stack_sp)) {
break;
@@ -676,7 +698,7 @@
POP_MULTICALL;
for (j = i; j < items; j++)
- args[j-i] = args[j];
+ PL_stack_base[ax+j-i] = PL_stack_base[ax+j];
XSRETURN(items-i);
}
@@ -692,7 +714,6 @@
HV *stash;
GV *gv;
I32 gimme = G_SCALAR;
- SV **args = &PL_stack_base[ax];
CV *cv;
if (items <= 1)
@@ -703,12 +724,12 @@
SAVESPTR(GvSV(PL_defgv));
for (i = 1; i < items; i++) {
- GvSV(PL_defgv) = args[i];
+ GvSV(PL_defgv) = PL_stack_base[ax+i];
MULTICALL;
if (SvTRUE(*PL_stack_sp)) {
break;
}
- args[i-1] = args[i];
+ PL_stack_base[ax+i-1] = PL_stack_base[ax+i];
}
POP_MULTICALL;
@@ -727,7 +748,6 @@
HV *stash;
GV *gv;
I32 gimme = G_SCALAR;
- SV **args = &PL_stack_base[ax];
CV *cv;
if (items <= 1)
@@ -738,9 +758,9 @@
SAVESPTR(GvSV(PL_defgv));
for (i = 1; i < items; ++i) {
- GvSV(PL_defgv) = args[i];
+ GvSV(PL_defgv) = PL_stack_base[ax+i];
MULTICALL;
- args[i-1] = args[i];
+ PL_stack_base[ax+i-1] = PL_stack_base[ax+i];
if (SvTRUE(*PL_stack_sp)) {
++i;
break;
@@ -763,7 +783,6 @@
HV *stash;
GV *gv;
I32 gimme = G_SCALAR;
- SV **args = &PL_stack_base[ax];
CV *cv;
if (items <= 1)
@@ -774,19 +793,18 @@
SAVESPTR(GvSV(PL_defgv));
for (i = 1, j = 0; i < items; i++) {
- GvSV(PL_defgv) = args[i];
+ GvSV(PL_defgv) = PL_stack_base[ax+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]);
+ PL_stack_base[ax+j] = newSViv(i-1);
j++;
}
}
-
+
POP_MULTICALL;
+
+ for (i = 0; i < j; ++i)
+ sv_2mortal(PL_stack_base[ax+i]);
XSRETURN(j);
}
@@ -802,7 +820,6 @@
HV *stash;
GV *gv;
I32 gimme = G_SCALAR;
- SV **args = &PL_stack_base[ax];
CV *cv;
RETVAL = &PL_sv_undef;
@@ -813,11 +830,11 @@
SAVESPTR(GvSV(PL_defgv));
for (i = items-1 ; i > 0 ; --i) {
- GvSV(PL_defgv) = args[i];
+ GvSV(PL_defgv) = PL_stack_base[ax+i];
MULTICALL;
if (SvTRUE(*PL_stack_sp)) {
- /* see comment in indexes() */
- SvREFCNT_inc(RETVAL = args[i]);
+ /* POP_MULTICALL further down will decrement it by one */
+ SvREFCNT_inc(RETVAL = PL_stack_base[ax+i]);
break;
}
}
@@ -838,7 +855,6 @@
HV *stash;
GV *gv;
I32 gimme = G_SCALAR;
- SV **args = &PL_stack_base[ax];
CV *cv;
RETVAL = &PL_sv_undef;
@@ -849,11 +865,11 @@
SAVESPTR(GvSV(PL_defgv));
for (i = 1; i < items; ++i) {
- GvSV(PL_defgv) = args[i];
+ GvSV(PL_defgv) = PL_stack_base[ax+i];
MULTICALL;
if (SvTRUE(*PL_stack_sp)) {
- /* see comment in indexes() */
- SvREFCNT_inc(RETVAL = args[i]);
+ /* POP_MULTICALL further down will decrement it by one */
+ SvREFCNT_inc(RETVAL = PL_stack_base[ax+i]);
break;
}
}
@@ -1009,6 +1025,10 @@
int nitems = 0, maxitems = 0;
register int d;
+
+ if (in_pad("a", code) || in_pad("b", code)) {
+ croak("Can't use lexical $a or $b in pairwise code block");
+ }
/* deref AV's for convenience and
* get maximum items */
@@ -1138,8 +1158,10 @@
register int i, j, maxidx = -1;
AV **avs;
New(0, avs, items, AV*);
-
+
for (i = 0; i < items; i++) {
+ if (!SvROK(ST(i)))
+ croak("Arguments to %s must be references", FUNC_NAME);
avs[i] = (AV*)SvRV(ST(i));
if (av_len(avs[i]) > maxidx)
maxidx = av_len(avs[i]);
@@ -1163,29 +1185,34 @@
{
register int i, count = 0;
HV *hv = newHV();
+ SV *undef = newRV_noinc(newSV(0));
/* don't build return list in scalar context */
if (GIMME == G_SCALAR) {
for (i = 0; i < items; i++) {
- if (!hv_exists_ent(hv, ST(i), 0)) {
+ SV *e = SvOK(ST(i)) ? ST(i) : undef;
+ if (!hv_exists_ent(hv, e, 0)) {
count++;
- hv_store_ent(hv, ST(i), &PL_sv_yes, 0);
+ hv_store_ent(hv, e, &PL_sv_yes, 0);
}
}
SvREFCNT_dec(hv);
+ SvREFCNT_dec(undef);
ST(0) = sv_2mortal(newSViv(count));
XSRETURN(1);
}
/* list context: populate SP with mortal copies */
for (i = 0; i < items; i++) {
- if (!hv_exists_ent(hv, ST(i), 0)) {
+ SV *e = SvOK(ST(i)) ? ST(i) : undef;
+ if (!hv_exists_ent(hv, e, 0)) {
ST(count) = sv_2mortal(newSVsv(ST(i)));
count++;
- hv_store_ent(hv, ST(i), &PL_sv_yes, 0);
+ hv_store_ent(hv, e, &PL_sv_yes, 0);
}
}
SvREFCNT_dec(hv);
+ SvREFCNT_dec(undef);
XSRETURN(count);
}
@@ -1203,6 +1230,12 @@
minsv = maxsv = ST(0);
min = max = slu_sv_value(minsv);
+
+ if (items == 1) {
+ EXTEND(SP, 1);
+ ST(0) = ST(1) = minsv;
+ XSRETURN(2);
+ }
for (i = 1; i < items; i += 2) {
asv = ST(i-1);
@@ -1273,7 +1306,6 @@
GV *gv;
I32 gimme = G_SCALAR;
I32 count = 0;
- SV **args = &PL_stack_base[ax];
CV *cv;
AV **tmp = NULL;
@@ -1288,7 +1320,7 @@
for(i = 1 ; i < items ; ++i) {
int idx;
- GvSV(PL_defgv) = args[i];
+ GvSV(PL_defgv) = PL_stack_base[ax+i];
MULTICALL;
idx = SvIV(*PL_stack_sp);
@@ -1303,10 +1335,11 @@
}
if (!tmp[idx])
tmp[idx] = newAV();
- av_push(tmp[idx], args[i]);
- SvREFCNT_inc(args[i]);
+ av_push(tmp[idx], PL_stack_base[ax+i]);
+ SvREFCNT_inc(PL_stack_base[ax+i]);
}
POP_MULTICALL;
+ SPAGAIN;
EXTEND(SP, last);
for (i = 0; i < last; ++i) {
@@ -1314,9 +1347,9 @@
ST(i) = &PL_sv_undef;
continue;
}
- ST(i) = newRV_noinc((SV*)tmp[i]);
- }
-
+ ST(i) = sv_2mortal(newRV_noinc((SV*)tmp[i]));
+ }
+
Safefree(tmp);
XSRETURN(last);
}
@@ -1388,6 +1421,66 @@
}
#endif
+
+SV *
+bsearch (code, ...)
+ SV *code;
+PROTOTYPE: &@
+CODE:
+{
+ dMULTICALL;
+ HV *stash;
+ GV *gv;
+ CV *cv;
+ I32 gimme = GIMME; /* perl-5.5.4 bus-errors out later when using GIMME
+ therefore we save its value in a fresh variable */
+
+ register long long i, j;
+ int val = -1;
+
+ if (items > 1) {
+
+ cv = sv_2cv(code, &stash, &gv, 0);
+ PUSH_MULTICALL(cv);
+ SAVESPTR(GvSV(PL_defgv));
+
+ i = 0;
+ j = items - 1;
+ do {
+ long long k = ((double)(i + j)) / 2.0;
+
+ if (k >= items-1)
+ break;
+
+ GvSV(PL_defgv) = PL_stack_base[ax+1+k];
+ MULTICALL;
+ val = SvIV(*PL_stack_sp);
+
+ if (val == 0) {
+ POP_MULTICALL;
+ if (gimme == G_SCALAR)
+ XSRETURN_YES;
+ SvREFCNT_inc(RETVAL = PL_stack_base[ax+1+k]);
+ goto yes;
+ }
+ if (val < 0) {
+ i = k+1;
+ } else {
+ j = k-1;
+ }
+ } while (i <= j);
+ POP_MULTICALL;
+ }
+
+ if (gimme == G_ARRAY)
+ XSRETURN_EMPTY;
+ else
+ XSRETURN_UNDEF;
+yes:
+ ;
+}
+OUTPUT:
+ RETVAL
void
_XScompiled ()
Modified: branches/upstream/liblist-moreutils-perl/current/README
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liblist-moreutils-perl/current/README?rev=40784&op=diff
==============================================================================
--- branches/upstream/liblist-moreutils-perl/current/README (original)
+++ branches/upstream/liblist-moreutils-perl/current/README Sun Jul 26 23:14:36 2009
@@ -1,4 +1,4 @@
-List-MoreUtils version 0.22
+List-MoreUtils version 0.24
===========================
Provide the missing functionality from List::Util (see "SUGGESTED ADDITIONS" in
@@ -22,7 +22,7 @@
COPYRIGHT AND LICENCE
-Copyright (C) 2004-2006 by Tassilo von Parseval
+Copyright (C) 2004-2009 by Tassilo von Parseval
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.4 or,
Modified: branches/upstream/liblist-moreutils-perl/current/lib/List/MoreUtils.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liblist-moreutils-perl/current/lib/List/MoreUtils.pm?rev=40784&op=diff
==============================================================================
--- branches/upstream/liblist-moreutils-perl/current/lib/List/MoreUtils.pm (original)
+++ branches/upstream/liblist-moreutils-perl/current/lib/List/MoreUtils.pm Sun Jul 26 23:14:36 2009
@@ -5,6 +5,8 @@
require Exporter;
require DynaLoader;
+
+
use vars qw($VERSION @ISA @EXPORT_OK %EXPORT_TAGS);
@ISA = qw(Exporter DynaLoader);
@@ -12,12 +14,12 @@
all => [ qw(any all none notall true false firstidx first_index lastidx
last_index insert_after insert_after_string apply after after_incl before
before_incl indexes firstval first_value lastval last_value each_array
- each_arrayref pairwise natatime mesh zip uniq minmax part) ],
+ each_arrayref pairwise natatime mesh zip uniq minmax part bsearch) ],
);
@EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
-$VERSION = '0.22';
+$VERSION = '0.24';
eval {
local $ENV{PERL_DL_NONLAZY} = 0 if $ENV{PERL_DL_NONLAZY};
@@ -26,6 +28,8 @@
} if not $ENV{LIST_MOREUTILS_PP};
eval <<'EOP' if not defined &any;
+
+require POSIX;
sub any (&@) {
my $f = shift;
@@ -47,7 +51,7 @@
sub none (&@) {
my $f = shift;
- return if ! @_;
+ return 1 if ! @_;
for (@_) {
return 0 if $f->();
}
@@ -280,7 +284,8 @@
sub uniq (@) {
my %h;
- map { $h{$_}++ == 0 ? $_ : () } @_;
+ my $ref = \1;
+ map { $h{defined $_ ? $_ : $ref}++ == 0 ? $_ : () } @_;
}
sub minmax (@) {
@@ -318,11 +323,39 @@
return @parts;
}
+sub bsearch(&@) {
+ my $code = shift;
+
+ my $rc;
+ my $i = 0;
+ my $j = @_;
+ do {
+ my $k = int(($i + $j) / 2);
+
+ return if $k >= @_;
+
+ local *_ = \$_[$k];
+ $rc = $code->();
+
+ $rc == 0 and
+ return wantarray ? $_ : 1;
+
+ if ($rc < 0) {
+ $i = $k + 1;
+ } else {
+ $j = $k - 1;
+ }
+ } until $i > $j;
+
+ return;
+}
+
sub _XScompiled {
return 0;
}
EOP
+die $@ if $@;
*first_index = \&firstidx;
*last_index = \&lastidx;
@@ -663,6 +696,15 @@
my $i = 0;
my @part = part { $idx[$++ % 3] } 1 .. 8; # [1, 4, 7], [2, 3, 5, 6, 8]
+=item bsearch BLOCK LIST
+
+Performs a binary search on LIST which must be a sorted list of values. BLOCK
+must return a negative value if the current element (stored in C<$_>) is smaller,
+a positive value if it is bigger and zero if it matches.
+
+Returns a boolean value in scalar context. In list context, it returns the element
+if it was found, otherwise the empty list.
+
=back
=head1 EXPORTS
@@ -785,11 +827,11 @@
=head1 AUTHOR
-Tassilo von Parseval, E<lt>tassilo.von.parseval at rwth-aachen.deE<gt>
+Tassilo von Parseval, E<lt>vparseval at gmail.comE<gt>
=head1 COPYRIGHT AND LICENSE
-Copyright (C) 2004-2006 by Tassilo von Parseval
+Copyright (C) 2004-2009 by Tassilo von Parseval
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.4 or,
Modified: branches/upstream/liblist-moreutils-perl/current/t/List-MoreUtils-pp.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liblist-moreutils-perl/current/t/List-MoreUtils-pp.t?rev=40784&op=diff
==============================================================================
--- branches/upstream/liblist-moreutils-perl/current/t/List-MoreUtils-pp.t (original)
+++ branches/upstream/liblist-moreutils-perl/current/t/List-MoreUtils-pp.t Sun Jul 26 23:14:36 2009
@@ -8,7 +8,6 @@
sub arrayeq {
local $^W = 0;
my ($ary1, $ary2) = @_;
- #warn "(@$ary1) != (@$ary2)\n";
return 0 if @$ary1 != @$ary2;
for (0 .. $#$ary1) {
if ($ary1->[$_] ne $ary2->[$_]) {
@@ -20,12 +19,12 @@
return 1;
}
+my @bigary = (1) x 500;
+sub grow_stack { func(@bigary); };
+sub func {};
+
my $TESTS = 0;
-BEGIN { $TESTS += 1 }
-ok(1);
-
-# any(2...)
BEGIN { $TESTS += 6 }
{
my @list = (1 .. 10000);
@@ -37,7 +36,7 @@
ok(!defined(any { }));
}
-# all (8...)
+
BEGIN { $TESTS += 4 }
{
my @list = (1 .. 10000);
@@ -47,17 +46,17 @@
ok(!defined all { } );
}
-# none (12...)
+
BEGIN { $TESTS += 4 }
{
my @list = (1 .. 10000);
ok(none { !defined } @list);
ok(none { $_ > 10000 } @list);
ok(!none { defined } @list);
- ok(!defined none { });
-}
-
-# notall (16...)
+ ok(none { });
+}
+
+
BEGIN { $TESTS += 4 }
{
my @list = (1 .. 10000);
@@ -67,7 +66,7 @@
ok(!defined notall { });
}
-# true (20...)
+
BEGIN { $TESTS += 4 }
{
my @list = (1 .. 10000);
@@ -77,7 +76,7 @@
ok(!true { });
}
-# false (24...)
+
BEGIN { $TESTS += 4 }
{
my @list = (1 .. 10000);
@@ -87,7 +86,7 @@
ok(!false { });
}
-# firstidx (28...)
+
BEGIN { $TESTS += 4 }
{
my @list = (1 .. 10000);
@@ -97,7 +96,7 @@
ok(-1, firstidx { });
}
-# lastidx (32...)
+
BEGIN { $TESTS += 8 }
{
my @list = (1 .. 10000);
@@ -113,7 +112,7 @@
ok(-1, last_index { });
}
-# insert_after (40...)
+
BEGIN { $TESTS += 4 }
{
my @list = qw/This is a list/;
@@ -129,7 +128,7 @@
ok(join(' ', @list), "This is a longer list");
}
-# insert_after_string (44...)
+
BEGIN { $TESTS += 3 }
{
my @list = qw/This is a list/;
@@ -144,8 +143,8 @@
ok(join(' ', @list), "This\0 is\0 a\0 longer\0 list\0");
}
-# apply (47...)
-BEGIN { $TESTS += 6 }
+
+BEGIN { $TESTS += 8 }
{
my @list = (0 .. 9);
my @list1 = apply { $_++ } @list;
@@ -161,12 +160,19 @@
ok($item, "foobar");
ok(! defined apply {});
+
+ # RT 38630
+ # wrong results from apply() [XS]
+ @list = (1 .. 4);
+ @list1 = apply { grow_stack(); $_ = 5 } @list;
+ ok(arrayeq(\@list, [1 .. 4]));
+ ok(arrayeq(\@list1, [(5) x 4]));
}
# In the following, the @dummy variable is needed to circumvent
# a parser glitch in the 5.6.x series.
-#after (53...)
+
BEGIN { $TESTS += 3 }
{
my @x = after { $_ % 5 == 0 } 1..9;
@@ -177,7 +183,7 @@
ok(arrayeq(\@x, [ qw/baz foo/ ]));
}
-#after_incl (56...)
+
BEGIN { $TESTS += 3 }
{
my @x = after_incl {$_ % 5 == 0} 1..9;
@@ -188,7 +194,7 @@
ok(arrayeq(\@x, [ qw/bar baz foo/ ]));
}
-#before (59...)
+
BEGIN { $TESTS += 3 }
{
my @x = before {$_ % 5 == 0} 1..9;
@@ -199,7 +205,7 @@
ok(arrayeq(\@x, [ qw/bar baz/ ]));
}
-#before_incl (62...)
+
BEGIN { $TESTS += 3 }
{
my @x = before_incl {$_ % 5 == 0} 1..9;
@@ -210,7 +216,7 @@
ok(arrayeq(\@x, [ qw/bar baz foo/ ]));
}
-#indexes (65...)
+
BEGIN { $TESTS += 2 }
{
my @x = indexes {$_ > 5} 4..9;
@@ -219,7 +225,7 @@
ok(!@x);
}
-#lastval/last_value (67...)
+
BEGIN { $TESTS += 4 }
{
my $x = last_value {$_ > 5} 4..9;
@@ -233,7 +239,7 @@
ok(!defined $x);
}
-#firstval/first_value (71...)
+
BEGIN { $TESTS += 4 }
{
my $x = first_value {$_ > 5} 4..9;
@@ -248,7 +254,7 @@
}
-#each_array (75...)
+
BEGIN { $TESTS += 5 }
{
my @a = (7, 3, 'a', undef, 'r');
@@ -284,7 +290,7 @@
}
-#each_array (80...)
+
BEGIN { $TESTS += 5 }
{
my @a = (7, 3, 'a', undef, 'r');
@@ -306,8 +312,8 @@
# testing two iterators on the same arrays in parallel
@a = (1, 3, 5);
@b = (2, 4, 6);
- my $i1 = each_array @a, @b;
- my $i2 = each_array @a, @b;
+ my $i1 = each_arrayref \@a, \@b;
+ my $i2 = each_arrayref \@a, \@b;
@r = ();
while (my ($a, $b) = $i1->() and my ($c, $d) = $i2->()) {
push @r, $a, $b, $c, $d;
@@ -320,8 +326,8 @@
}
-#pairwise (85...)
-BEGIN { $TESTS += 9 }
+
+BEGIN { $TESTS += 10 }
{
my @a = (1, 2, 3, 4, 5);
my @b = (2, 4, 6, 8, 10);
@@ -381,10 +387,16 @@
@b = qw/1 2 3/;
@c = pairwise { ($a, $b) } @a, @b;
ok(arrayeq(\@c, [qw/a 1 b 2 c 3/])); # 88
-}
-
-#natatime (94...)
-BEGIN { $TESTS += 2 }
+
+ # test that a die inside the code-reference will no longer be trapped
+ eval { pairwise { die "I died\n" } @a, @b };
+ ok($@, "I died\n");
+
+
+}
+
+
+BEGIN { $TESTS += 3 }
{
my @x = ('a'..'g');
my $it = natatime 3, @x;
@@ -403,9 +415,16 @@
push @r, @vals;
}
ok(arrayeq(\@r, \@a), 1, "natatime2");
-}
-
-#mesh (96...)
+
+ $it = natatime 1, 1 .. 26;
+ @r = ();
+ while (my @vals = &$it) {
+ push @r, @vals;
+ }
+ ok(arrayeq(\@r, [1 .. 26]), 1, "natatime3");
+}
+
+
BEGIN { $TESTS += 3 }
{
my @x = qw/a b c d/;
@@ -426,7 +445,7 @@
6, undef, 7, undef, 8, undef, 9, undef, 10, undef]));
}
-#zip (just an alias for mesh) (99...)
+
BEGIN { $TESTS += 3 }
{
my @x = qw/a b c d/;
@@ -447,18 +466,26 @@
6, undef, 7, undef, 8, undef, 9, undef, 10, undef]));
}
-#uniq(102...)
-BEGIN { $TESTS += 2 }
+BEGIN { $TESTS += 4 }
{
my @a = map { (1 .. 10000) } 0 .. 1;
my @u = uniq @a;
ok(arrayeq(\@u, [1 .. 10000]));
my $u = uniq @a;
ok(10000, $u);
+
+ # RT #37533
+ # bug: uniq doesn't like undef values.
+ my $warn;
+ local $SIG{__WARN__} = sub {
+ $warn = shift;
+ };
+ $u = uniq((undef) x 3);
+ ok(not $warn);
+ ok($u, 1);
}
-#minmax(104...)
-BEGIN { $TESTS += 6 }
+BEGIN { $TESTS += 8 }
{
my @list = reverse 0 .. 100_000;
my ($min, $max) = minmax @list;
@@ -477,14 +504,24 @@
# floating-point comparison cunningly avoided
ok(sprintf("%i", $min), -3);
ok($max, 100_000);
-}
-
-#part(110...)
-BEGIN { $TESTS += 14 }
-{
+
+ ($min, $max) = minmax -1;
+ ok($min, -1);
+ ok($max, -1);
+}
+
+
+BEGIN { $TESTS += 25 }
+{
+
+ # RT #38699
+ # segv from part() on two stack grows [XS]
+ my @part = part { grow_stack(); 1024 } qw/one two/;
+ ok(scalar @part, 1025);
+
my @list = 1 .. 12;
my $i = 0;
- my @part = part { $i++ % 3 } @list;
+ @part = part { $i++ % 3 } @list;
ok(arrayeq($part[0], [ 1, 4, 7, 10 ]));
ok(arrayeq($part[1], [ 2, 5, 8, 11 ]));
ok(arrayeq($part[2], [ 3, 6, 9, 12 ]));
@@ -506,11 +543,37 @@
@part = part { undef } @list;
ok(arrayeq($part[0], [ 1 .. 12 ]));
- @part = part { 1_000_000 } @list;
- ok(arrayeq($part[1_000_000], [ @list ]));
+ @part = part { 100_000 } @list;
+ ok(arrayeq($part[100_000], [ @list ]));
ok(!defined $part[0]);
ok(!defined $part[@part/2]);
- ok(!defined $part[999_999]);
+ ok(!defined $part[99_999]);
+
+ # changing the list in place used to destroy
+ # its elements due to a wrong refcnt
+ @list = 1 .. 10;
+ @list = part { $_ } @list;
+ for (1 .. 10) {
+ ok(arrayeq($list[$_], [ $_ ]));
+ }
+}
+
+
+BEGIN { $TESTS += 2022 }
+{
+ my @list = my @in = 1 .. 1000;
+ for my $elem (@in) {
+ ok(scalar bsearch { $_ - $elem } @list);
+ }
+ for my $elem (@in) {
+ my ($e) = bsearch { $_ - $elem } @list;
+ ok($e == $elem);
+ }
+ my @out = (-10 .. 0, 1001 .. 1011);
+ for my $elem (@out) {
+ my $r = bsearch { $_ - $elem } @list;
+ ok(!defined $r);
+ }
}
BEGIN { plan tests => $TESTS }
Modified: branches/upstream/liblist-moreutils-perl/current/t/List-MoreUtils.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/liblist-moreutils-perl/current/t/List-MoreUtils.t?rev=40784&op=diff
==============================================================================
--- branches/upstream/liblist-moreutils-perl/current/t/List-MoreUtils.t (original)
+++ branches/upstream/liblist-moreutils-perl/current/t/List-MoreUtils.t Sun Jul 26 23:14:36 2009
@@ -8,15 +8,19 @@
{
local $^W = 0;
*ok = sub ($;$$) {
- if (@_ == 1) {
- skip(List::MoreUtils::_XScompiled() ? 0 : "XS portion not compiled", $_[0]);
- } elsif (@_ == 2) {
- skip(List::MoreUtils::_XScompiled() ? 0 : "XS portion not compiled", $_[0], $_[1]);
- } else {
- skip(List::MoreUtils::_XScompiled() ? 0 : "XS portion not compiled", $_[0], $_[1], $_[2]);
- }
+ if (@_ == 1) {
+ skip(List::MoreUtils::_XScompiled() ? 0 : "XS portion not compiled", $_[0]);
+ } elsif (@_ == 2) {
+ skip(List::MoreUtils::_XScompiled() ? 0 : "XS portion not compiled", $_[0], $_[1]);
+ } else {
+ skip(List::MoreUtils::_XScompiled() ? 0 : "XS portion not compiled", $_[0], $_[1], $_[2]);
+ }
};
}
+
+my @bigary = (1) x 500;
+sub grow_stack { func(@bigary); };
+sub func {};
sub arrayeq {
local $^W = 0;
@@ -34,7 +38,7 @@
my $TESTS = 0;
-# any
+
BEGIN { $TESTS += 6 }
{
my @list = (1 .. 10000);
@@ -46,7 +50,7 @@
ok(!defined(any { }));
}
-# all (7...)
+
BEGIN { $TESTS += 4 }
{
my @list = (1 .. 10000);
@@ -56,17 +60,17 @@
ok(!defined all { } );
}
-# none (11...)
+
BEGIN { $TESTS += 4 }
{
my @list = (1 .. 10000);
ok(none { !defined } @list);
ok(none { $_ > 10000 } @list);
ok(!none { defined } @list);
- ok(!defined none { });
-}
-
-# notall (15...)
+ ok(none { });
+}
+
+
BEGIN { $TESTS += 4 }
{
my @list = (1 .. 10000);
@@ -76,7 +80,7 @@
ok(!defined notall { });
}
-# true (19...)
+
BEGIN { $TESTS += 4 }
{
my @list = (1 .. 10000);
@@ -86,7 +90,7 @@
ok(!true { });
}
-# false (23...)
+
BEGIN { $TESTS += 4 }
{
my @list = (1 .. 10000);
@@ -96,7 +100,6 @@
ok(!false { });
}
-# firstidx (27...)
BEGIN { $TESTS += 4 }
{
my @list = (1 .. 10000);
@@ -106,7 +109,6 @@
ok(-1, firstidx { });
}
-# lastidx (31...)
BEGIN { $TESTS += 8 }
{
my @list = (1 .. 10000);
@@ -122,7 +124,6 @@
ok(-1, last_index { });
}
-# insert_after (39...)
BEGIN { $TESTS += 4 }
{
my @list = qw/This is a list/;
@@ -138,7 +139,6 @@
ok(join(' ', @list), "This is a longer list");
}
-# insert_after_string (43...)
BEGIN { $TESTS += 3 }
{
my @list = qw/This is a list/;
@@ -153,8 +153,7 @@
ok(join(' ', @list), "This\0 is\0 a\0 longer\0 list\0");
}
-# apply (46...)
-BEGIN { $TESTS += 6 }
+BEGIN { $TESTS += 8 }
{
my @list = (0 .. 9);
my @list1 = apply { $_++ } @list;
@@ -170,12 +169,18 @@
ok($item, "foobar");
ok(! defined apply {});
+
+ # RT 38630
+ # wrong results from apply() [XS]
+ @list = (1 .. 4);
+ @list1 = apply { grow_stack(); $_ = 5 } @list;
+ ok(arrayeq(\@list, [1 .. 4]));
+ ok(arrayeq(\@list1, [(5) x 4]));
}
# In the following, the @dummy variable is needed to circumvent
# a parser glitch in the 5.6.x series.
-#after (52...)
BEGIN { $TESTS += 3 }
{
my @x = after { $_ % 5 == 0 } 1..9;
@@ -186,7 +191,6 @@
ok(arrayeq(\@x, [ qw/baz foo/ ]));
}
-#after_incl (55...)
BEGIN { $TESTS += 3 }
{
my @x = after_incl {$_ % 5 == 0} 1..9;
@@ -197,7 +201,6 @@
ok(arrayeq(\@x, [ qw/bar baz foo/ ]));
}
-#before (58...)
BEGIN { $TESTS += 3 }
{
my @x = before {$_ % 5 == 0} 1..9;
@@ -208,7 +211,6 @@
ok(arrayeq(\@x, [ qw/bar baz/ ]));
}
-#before_incl (61...)
BEGIN { $TESTS += 3 }
{
my @x = before_incl {$_ % 5 == 0} 1..9;
@@ -219,7 +221,6 @@
ok(arrayeq(\@x, [ qw/bar baz foo/ ]));
}
-#indexes (64...)
BEGIN { $TESTS += 2 }
{
my @x = indexes {$_ > 5} 4..9;
@@ -228,7 +229,6 @@
ok(!@x);
}
-#lastval/last_value (67...)
BEGIN { $TESTS += 4 }
{
my $x = last_value {$_ > 5} 4..9;
@@ -242,7 +242,6 @@
ok(!defined $x);
}
-#firstval/first_value (71...)
BEGIN { $TESTS += 4 }
{
my $x = first_value {$_ > 5} 4..9;
@@ -257,8 +256,7 @@
}
-#each_array (75...)
-BEGIN { $TESTS += 10 }
+BEGIN { $TESTS += 12 }
{
my @a = (7, 3, 'a', undef, 'r');
my @b = qw/a 2 -1 x/;
@@ -311,9 +309,15 @@
ok(arrayeq(\@a, [1 .. 26]));
ok(arrayeq(\@a, \@nums));
ok(arrayeq(\@b, ['A' .. 'Z']));
-}
-
-#each_array (85...)
+
+ # RT #20258
+ # Core dump in each_array iterator
+ $ea = eval { &each_array(1, 2) };
+ ok($@ =~ /Arguments to each_array must be/);
+ $ea = eval { each_arrayref(1, 2) };
+ ok($@ =~ /Arguments to each_arrayref must be/);
+}
+
BEGIN { $TESTS += 5 }
{
my @a = (7, 3, 'a', undef, 'r');
@@ -335,8 +339,8 @@
# testing two iterators on the same arrays in parallel
@a = (1, 3, 5);
@b = (2, 4, 6);
- my $i1 = each_array @a, @b;
- my $i2 = each_array @a, @b;
+ my $i1 = each_arrayref \@a, \@b;
+ my $i2 = each_arrayref \@a, \@b;
@r = ();
while (my ($a, $b) = $i1->() and my ($c, $d) = $i2->()) {
push @r, $a, $b, $c, $d;
@@ -349,8 +353,7 @@
}
-#pairwise (90...)
-BEGIN { $TESTS += 10 }
+BEGIN { $TESTS += 11 }
{
my @a = (1, 2, 3, 4, 5);
my @b = (2, 4, 6, 8, 10);
@@ -414,9 +417,17 @@
# test that a die inside the code-reference will no longer be trapped
eval { pairwise { die "I died\n" } @a, @b };
ok($@, "I died\n");
-}
-
-#natatime (100...)
+
+ # RT #44518
+ # bug in pairwise when $a and $b are lexically defined using my
+ {
+ my $a;
+ eval { pairwise { $a + $b } @a, @b };
+ ok($@ =~ /^Can't use lexical \$a or \$b in pairwise code block/);
+ }
+
+}
+
BEGIN { $TESTS += 3 }
{
my @x = ('a'..'g');
@@ -445,8 +456,7 @@
ok(arrayeq(\@r, [1 .. 26]), 1, "natatime3");
}
-#mesh (103...)
-BEGIN { $TESTS += 3 }
+BEGIN { $TESTS += 4 }
{
my @x = qw/a b c d/;
my @y = qw/1 2 3 4/;
@@ -464,10 +474,14 @@
@z = mesh @a, @d;
ok(arrayeq(\@z, [1, undef, 2, undef, 3, undef, 4, undef, 5, undef,
6, undef, 7, undef, 8, undef, 9, undef, 10, undef]));
-}
-
-#zip (just an alias for mesh) (106...)
-BEGIN { $TESTS += 3 }
+
+ # RT #44011
+ # segv in zip
+ eval { &mesh(1, 1) };
+ ok($@ =~ /Arguments to mesh must be/);
+}
+
+BEGIN { $TESTS += 4 }
{
my @x = qw/a b c d/;
my @y = qw/1 2 3 4/;
@@ -485,20 +499,33 @@
@z = zip @a, @d;
ok(arrayeq(\@z, [1, undef, 2, undef, 3, undef, 4, undef, 5, undef,
6, undef, 7, undef, 8, undef, 9, undef, 10, undef]));
-}
-
-#uniq (109...)
-BEGIN { $TESTS += 2 }
+
+ # RT #44011
+ # segv in zip
+ eval { &zip(1, 1) };
+ ok($@ =~ /Arguments to zip must be/);
+}
+
+BEGIN { $TESTS += 4 }
{
my @a = map { (1 .. 10000) } 0 .. 1;
my @u = uniq @a;
ok(arrayeq(\@u, [1 .. 10000]));
my $u = uniq @a;
ok(10000, $u);
-}
-
-#minmax (111...)
-BEGIN { $TESTS += 6 }
+
+ # RT #37533
+ # bug: uniq doesn't like undef values.
+ my $warn;
+ local $SIG{__WARN__} = sub {
+ $warn = shift;
+ };
+ $u = uniq((undef) x 3);
+ ok(not $warn);
+ ok($u, 1);
+}
+
+BEGIN { $TESTS += 8 }
{
my @list = reverse 0 .. 100_000;
my ($min, $max) = minmax(@list);
@@ -517,14 +544,23 @@
# floating-point comparison cunningly avoided
ok(sprintf("%.2f", $min), "-3.33");
ok($max, 100_000);
-}
-
-#part (116...)
-BEGIN { $TESTS += 24 }
-{
+
+ ($min, $max) = minmax -1;
+ ok($min, -1);
+ ok($max, -1);
+}
+
+BEGIN { $TESTS += 25 }
+{
+
+ # RT #38699
+ # segv from part() on two stack grows [XS]
+ my @part = part { grow_stack(); 1024 } qw/one two/;
+ ok(scalar @part, 1025);
+
my @list = 1 .. 12;
my $i = 0;
- my @part = part { $i++ % 3 } @list;
+ @part = part { $i++ % 3 } @list;
ok(arrayeq($part[0], [ 1, 4, 7, 10 ]));
ok(arrayeq($part[1], [ 2, 5, 8, 11 ]));
ok(arrayeq($part[2], [ 3, 6, 9, 12 ]));
@@ -546,19 +582,38 @@
@part = part { undef } @list;
ok(arrayeq($part[0], [ 1 .. 12 ]));
- @part = part { 1_000_000 } @list;
- ok(arrayeq($part[1_000_000], [ @list ]));
+ @part = part { 100_000 } @list;
+ ok(arrayeq($part[100_000], [ @list ]));
ok(!defined $part[0]);
ok(!defined $part[@part/2]);
- ok(!defined $part[999_999]);
-
- # changing the list in place used to destroy
- # its elements due to a wrong refcnt
- @list = 1 .. 10;
- @list = part { $_ } @list;
- for (1 .. 10) {
- ok(arrayeq($list[$_], [ $_ ]));
- }
+ ok(!defined $part[99_999]);
+
+ # changing the list in place used to destroy
+ # its elements due to a wrong refcnt
+ @list = 1 .. 10;
+ @list = part { $_ } @list;
+ for (1 .. 10) {
+ ok(arrayeq($list[$_], [ $_ ]));
+ }
+
+}
+
+
+BEGIN { $TESTS += 2022 }
+{
+ my @list = my @in = 1 .. 1000;
+ for my $elem (@in) {
+ ok(scalar bsearch { $_ - $elem } @list);
+ }
+ for my $elem (@in) {
+ my ($e) = bsearch { $_ - $elem } @list;
+ ok($e == $elem);
+ }
+ my @out = (-10 .. 0, 1001 .. 1011);
+ for my $elem (@out) {
+ my $r = bsearch { $_ - $elem } @list;
+ ok(!defined $r);
+ }
}
BEGIN { plan tests => $TESTS }
More information about the Pkg-perl-cvs-commits
mailing list