ext/List/Util/t/readonly.t Scalar::Util
ext/List/Util/t/reduce.t List::Util
ext/List/Util/t/reftype.t Scalar::Util
+ext/List/Util/t/shuffle.t List::Util
ext/List/Util/t/sum.t List::Util
ext/List/Util/t/tainted.t Scalar::Util
ext/List/Util/t/weak.t Scalar::Util
+Change 636 on 2001/09/03 by <gbarr@pobox.com> (Graham Barr)
+
+ More changes to help merging with core dist
+
+Change 635 on 2001/09/03 by <gbarr@pobox.com> (Graham Barr)
+
+ Added List::Util::shuffle() similar to that described in
+ the perl FAQ except it returns a shuffled list instead of
+ modifying an array passed by reference
+
+Change 632 on 2001/09/03 by <gbarr@pobox.com> (Graham Barr)
+
+ Handle tied variables passed for the number to dualvar()
+ Preserve number type (IV/UV/NV) in dualvar()
+
+Change 631 on 2001/08/31 by <gbarr@pobox.com> (Graham Barr)
+
+ Handle eval{} inside of the code blocks for first and reduce
+
+Change 629 on 2001/08/22 by <gbarr@pobox.com> (Graham Barr)
+
+ perl5.004 does not like exit from within a BEGIN, it core dumps
+
+Change 628 on 2001/08/22 by <gbarr@pobox.com> (Graham Barr)
+
+ Fix stack problem in first() and reduce()
+ Align with core dist
+
+Change 483 on 2000/04/10 by <gbarr@pobox.com> (Graham Barr)
+
+ Release 1.02
+
Change 482 on 2000/04/10 by <gbarr@pobox.com> (Graham Barr)
Check for SvMAGICAL on argument for reftype and blessed
# define PERL_SUBVERSION SUBVERSION
#endif
+#ifndef aTHX
+# define aTHX
+#endif
+
+#if PERL_VERSION < 6
+# define NV double
+#endif
+
+#ifndef Drand01
+# define Drand01() ((rand() & 0x7FFF) / (double) ((unsigned long)1 << 15))
+#endif
+
#if PERL_VERSION < 5
# ifndef gv_stashpvn
# define gv_stashpvn(n,l,c) gv_stashpv(n,c)
HV *stash;
CV *cv;
OP *reducecop;
+ PERL_CONTEXT *cx;
+ SV** newsp;
+ I32 gimme = G_SCALAR;
+ bool oldcatch = CATCH_GET;
+
if(items <= 1) {
XSRETURN_UNDEF;
}
SAVETMPS;
SAVESPTR(PL_op);
ret = ST(1);
+ CATCH_SET(TRUE);
+ PUSHBLOCK(cx, CXt_SUB, SP);
for(index = 2 ; index < items ; index++) {
GvSV(agv) = ret;
GvSV(bgv) = ST(index);
CALLRUNOPS(aTHX);
ret = *PL_stack_sp;
}
- ST(0) = ret;
+ ST(0) = sv_mortalcopy(ret);
+ POPBLOCK(cx,PL_curpm);
+ CATCH_SET(oldcatch);
XSRETURN(1);
}
HV *stash;
CV *cv;
OP *reducecop;
+ PERL_CONTEXT *cx;
+ SV** newsp;
+ I32 gimme = G_SCALAR;
+ bool oldcatch = CATCH_GET;
+
if(items <= 1) {
XSRETURN_UNDEF;
}
PL_curpad = AvARRAY((AV*)AvARRAY(CvPADLIST(cv))[1]);
SAVETMPS;
SAVESPTR(PL_op);
+ CATCH_SET(TRUE);
+ PUSHBLOCK(cx, CXt_SUB, SP);
for(index = 1 ; index < items ; index++) {
GvSV(PL_defgv) = ST(index);
PL_op = reducecop;
CALLRUNOPS(aTHX);
if (SvTRUE(*PL_stack_sp)) {
ST(0) = ST(index);
+ POPBLOCK(cx,PL_curpm);
+ CATCH_SET(oldcatch);
XSRETURN(1);
}
}
+ POPBLOCK(cx,PL_curpm);
+ CATCH_SET(oldcatch);
XSRETURN_UNDEF;
}
+void
+shuffle(...)
+PROTOTYPE: @
+CODE:
+{
+ int index;
+ struct op dmy_op;
+ struct op *old_op = PL_op;
+ SV *my_pad[2];
+ SV **old_curpad = PL_curpad;
+
+ /* We call pp_rand here so that Drand01 get initialized if rand()
+ or srand() has not already been called
+ */
+ my_pad[1] = sv_newmortal();
+ memzero((char*)(&dmy_op), sizeof(struct op));
+ dmy_op.op_targ = 1;
+ PL_op = &dmy_op;
+ PL_curpad = (SV **)&my_pad;
+ pp_rand();
+ PL_op = old_op;
+ PL_curpad = old_curpad;
+ for (index = items ; index > 1 ; ) {
+ int swap = (int)(Drand01() * (double)(index--));
+ SV *tmp = ST(swap);
+ ST(swap) = ST(index);
+ ST(index) = tmp;
+ }
+ XSRETURN(items);
+}
+
+
MODULE=List::Util PACKAGE=Scalar::Util
void
ST(0) = sv_newmortal();
(void)SvUPGRADE(ST(0),SVt_PVNV);
sv_setpvn(ST(0),ptr,len);
- if(SvNOKp(num) || !SvIOKp(num)) {
+ if(SvNOK(num) || SvPOK(num) || SvMAGICAL(num)) {
SvNVX(ST(0)) = SvNV(num);
SvNOK_on(ST(0));
}
+#ifdef SVf_IVisUV
+ else if (SvUOK(num)) {
+ SvUVX(ST(0)) = SvUV(num);
+ SvIOK_on(ST(0));
+ SvIsUV_on(ST(0));
+ }
+#endif
else {
SvIVX(ST(0)) = SvIV(num);
SvIOK_on(ST(0));
require DynaLoader;
our @ISA = qw(Exporter DynaLoader);
-our @EXPORT_OK = qw(first min max minstr maxstr reduce sum);
-our $VERSION = "1.02_00";
+our @EXPORT_OK = qw(first min max minstr maxstr reduce sum shuffle);
+our $VERSION = "1.03_00";
bootstrap List::Util $VERSION;
$foo = reduce { $a + $b } 1 .. 10 # sum
$foo = reduce { $a . $b } @bar # concat
+=item shuffle LIST
+
+Returns the elements of LIST in a random order
+
=item sum LIST
Returns the sum of all the elements in LIST.
+#!./perl
+
BEGIN {
+ unless (-d 'blib') {
chdir 't' if -d 't';
@INC = '../lib';
require Config; import Config;
+ keys %Config; # Silence warning
if ($Config{extensions} !~ /\bList\/Util\b/) {
print "1..0 # Skip: List::Util was not built\n";
exit 0;
}
+ }
}
use Scalar::Util qw(blessed);
+#!./perl
+
BEGIN {
+ unless (-d 'blib') {
chdir 't' if -d 't';
@INC = '../lib';
require Config; import Config;
+ keys %Config; # Silence warning
if ($Config{extensions} !~ /\bList\/Util\b/) {
print "1..0 # Skip: List::Util was not built\n";
exit 0;
}
+ }
}
+use vars qw($skip);
+
BEGIN {
require Scalar::Util;
if (grep { /dualvar/ } @Scalar::Util::EXPORT_FAIL) {
print "1..0\n";
- exit;
+ $skip=1;
}
}
+eval <<'EOT' unless $skip;
use Scalar::Util qw(dualvar);
-print "1..6\n";
+print "1..11\n";
$var = dualvar 2.2,"string";
print "not " unless $var2 eq "string";
print "ok 6\n";
+
+my $numstr = "10.2";
+my $numtmp = sprintf("%d", $numstr);
+$var = dualvar $numstr, "";
+print "not " unless $var == $numstr;
+print "ok 7\n";
+
+$var = dualvar 1<<31, "";
+print "not " unless $var == 1<<31;
+print "ok 8\n";
+print "not " unless $var > 0;
+print "ok 9\n";
+
+tie my $tied, 'Tied';
+$var = dualvar $tied, "ok";
+print "not " unless $var == 7.5;
+print "ok 10\n";
+print "not " unless $var eq "ok";
+print "ok 11\n";
+
+EOT
+
+package Tied;
+
+sub TIESCALAR { bless {} }
+sub FETCH { 7.5 }
+
+#!./perl
+
BEGIN {
+ unless (-d 'blib') {
chdir 't' if -d 't';
@INC = '../lib';
require Config; import Config;
+ keys %Config; # Silence warning
if ($Config{extensions} !~ /\bList\/Util\b/) {
print "1..0 # Skip: List::Util was not built\n";
exit 0;
}
+ }
}
use List::Util qw(first);
-print "1..4\n";
+print "1..7\n";
print "not " unless defined &first;
print "ok 1\n";
print "not " if defined(first { 0 });
print "ok 4\n";
+
+my $foo = first { $_->[1] le "e" and "e" le $_->[2] }
+ [qw(a b c)], [qw(d e f)], [qw(g h i)];
+print "not " unless $foo->[0] eq 'd';
+print "ok 5\n";
+
+# Check that eval{} inside the block works correctly
+my $i = 0;
+print "not " unless 5 == first { eval { die }; ($i == 5, $i = $_)[0] } 0,1,2,3,4,5,5;
+print "ok 6\n";
+
+print "not " if defined eval { first { die if $_ } 0,0,1 };
+print "ok 7\n";
+#!./perl
+
BEGIN {
+ unless (-d 'blib') {
chdir 't' if -d 't';
@INC = '../lib';
require Config; import Config;
+ keys %Config; # Silence warning
if ($Config{extensions} !~ /\bList\/Util\b/) {
print "1..0 # Skip: List::Util was not built\n";
exit 0;
}
+ }
}
+
use List::Util qw(max);
print "1..5\n";
+#!./perl
+
BEGIN {
+ unless (-d 'blib') {
chdir 't' if -d 't';
@INC = '../lib';
require Config; import Config;
+ keys %Config; # Silence warning
if ($Config{extensions} !~ /\bList\/Util\b/) {
print "1..0 # Skip: List::Util was not built\n";
exit 0;
}
+ }
}
+
use List::Util qw(maxstr);
print "1..5\n";
+#!./perl
+
BEGIN {
+ unless (-d 'blib') {
chdir 't' if -d 't';
@INC = '../lib';
require Config; import Config;
+ keys %Config; # Silence warning
if ($Config{extensions} !~ /\bList\/Util\b/) {
print "1..0 # Skip: List::Util was not built\n";
exit 0;
}
+ }
}
+
use List::Util qw(min);
print "1..5\n";
+#!./perl
+
BEGIN {
+ unless (-d 'blib') {
chdir 't' if -d 't';
@INC = '../lib';
require Config; import Config;
+ keys %Config; # Silence warning
if ($Config{extensions} !~ /\bList\/Util\b/) {
print "1..0 # Skip: List::Util was not built\n";
exit 0;
}
+ }
}
+
use List::Util qw(minstr);
print "1..5\n";
+#!./perl
+
BEGIN {
+ unless (-d 'blib') {
chdir 't' if -d 't';
@INC = '../lib';
require Config; import Config;
+ keys %Config; # Silence warning
if ($Config{extensions} !~ /\bList\/Util\b/) {
print "1..0 # Skip: List::Util was not built\n";
exit 0;
}
+ }
}
use Scalar::Util qw(readonly);
+
print "1..9\n";
print "not " unless readonly(1);
+#!./perl
+
BEGIN {
+ unless (-d 'blib') {
chdir 't' if -d 't';
@INC = '../lib';
require Config; import Config;
+ keys %Config; # Silence warning
if ($Config{extensions} !~ /\bList\/Util\b/) {
print "1..0 # Skip: List::Util was not built\n";
exit 0;
}
+ }
}
+
use List::Util qw(reduce min);
-print "1..5\n";
+print "1..8\n";
print "not " if defined reduce {};
print "ok 1\n";
@a = map { pack("C", int(rand(256))) } 0 .. 20;
print "not " unless join("",@a) eq reduce { $a . $b } @a;
print "ok 5\n";
+
+sub add {
+ my($aa, $bb) = @_;
+ return $aa + $bb;
+}
+
+my $sum = reduce { my $t="$a $b\n"; 0+add($a, $b) } 3, 2, 1;
+print "not " unless $sum == 6;
+print "ok 6\n";
+
+# Check that eval{} inside the block works correctly
+print "not " unless 10 == reduce { eval { die }; $a + $b } 0,1,2,3,4;
+print "ok 7\n";
+
+print "not " if defined eval { reduce { die if $b > 2; $a + $b } 0,1,2,3,4 };
+print "ok 8\n";
+#!./perl
+
BEGIN {
+ unless (-d 'blib') {
chdir 't' if -d 't';
@INC = '../lib';
require Config; import Config;
+ keys %Config; # Silence warning
if ($Config{extensions} !~ /\bList\/Util\b/) {
print "1..0 # Skip: List::Util was not built\n";
exit 0;
}
+ }
}
+
use Scalar::Util qw(reftype);
use vars qw($t $y $x *F);
use Symbol qw(gensym);
--- /dev/null
+#!./perl
+
+BEGIN {
+ unless (-d 'blib') {
+ chdir 't' if -d 't';
+ @INC = '../lib';
+ require Config; import Config;
+ keys %Config; # Silence warning
+ if ($Config{extensions} !~ /\bList\/Util\b/) {
+ print "1..0 # Skip: List::Util was not built\n";
+ exit 0;
+ }
+ }
+}
+
+
+use List::Util qw(shuffle);
+
+print "1..5\n";
+
+my @r;
+
+@r = shuffle();
+print "not " if @r;
+print "ok 1\n";
+
+@r = shuffle(9);
+print "not " unless @r == 1 and $r[0] = 9;
+print "ok 2\n";
+
+my @in = 1..100;
+@r = shuffle(@in);
+print "not " unless @r == @in;
+print "ok 3\n";
+
+print "not " if join("",@r) eq join("",@in);
+print "ok 4\n";
+
+print "not " if join("",sort { $a <=> $b } @r) ne join("",@in);
+print "ok 5\n";
+#!./perl
+
BEGIN {
+ unless (-d 'blib') {
chdir 't' if -d 't';
@INC = '../lib';
require Config; import Config;
+ keys %Config; # Silence warning
if ($Config{extensions} !~ /\bList\/Util\b/) {
print "1..0 # Skip: List::Util was not built\n";
exit 0;
}
+ }
}
+
use List::Util qw(sum);
print "1..3\n";
#!./perl -T
BEGIN {
+ unless (-d 'blib') {
chdir 't' if -d 't';
@INC = '../lib';
require Config; import Config;
+ keys %Config; # Silence warning
if ($Config{extensions} !~ /\bList\/Util\b/) {
print "1..0 # Skip: List::Util was not built\n";
exit 0;
}
+ }
}
use lib qw(blib/lib blib/arch);
use Scalar::Util qw(tainted);
use Config;
-print "1..5\n";
+print "1..4\n";
print "not " if tainted(1);
print "ok 1\n";
print "not " unless tainted($ENV{$key});
print "ok 4\n";
-
-print "not " if @ARGV and not tainted($ARGV[0]);
-print "ok 5\n";
+#!./perl
+
BEGIN {
+ unless (-d 'blib') {
chdir 't' if -d 't';
@INC = '../lib';
require Config; import Config;
+ keys %Config; # Silence warning
if ($Config{extensions} !~ /\bList\/Util\b/) {
print "1..0 # Skip: List::Util was not built\n";
exit 0;
}
+ }
}
+use vars qw($skip);
+
BEGIN {
$|=1;
require Scalar::Util;
if (grep { /weaken/ } @Scalar::Util::EXPORT_FAIL) {
print("1..0\n");
- exit;
+ $skip=1;
}
$DEBUG = 0;
}
}
+eval <<'EOT' unless $skip;
use Scalar::Util qw(weaken isweak);
print "1..17\n";
print "# INCFLAG\n";
${$_[0]{Flag}} ++;
}
+EOT
https://perl5.git.perl.org / perl5.git / commitdiff