Change 18076 by gbarr@monty on 2002/11/03 10:11:18 Update to Scalar-List-Utils 1.08
Affected files ... .... //depot/perl/MANIFEST#949 edit .... //depot/perl/ext/List/Util/ChangeLog#7 edit .... //depot/perl/ext/List/Util/README#3 edit .... //depot/perl/ext/List/Util/Util.xs#15 edit .... //depot/perl/ext/List/Util/lib/List/Util.pm#11 edit .... //depot/perl/ext/List/Util/lib/Scalar/Util.pm#8 edit .... //depot/perl/ext/List/Util/t/first.t#3 edit .... //depot/perl/ext/List/Util/t/isvstring.t#1 add .... //depot/perl/ext/List/Util/t/reduce.t#3 edit .... //depot/perl/ext/List/Util/t/refaddr.t#1 add Differences ... ==== //depot/perl/MANIFEST#949 (text) ==== Index: perl/MANIFEST --- perl/MANIFEST#948~18061~ Thu Oct 24 17:13:07 2002 +++ perl/MANIFEST Sun Nov 3 02:11:18 2002 @@ -477,6 +477,7 @@ ext/List/Util/t/blessed.t Scalar::Util ext/List/Util/t/dualvar.t Scalar::Util ext/List/Util/t/first.t List::Util +ext/List/Util/t/isvstring.t Scalar::Util ext/List/Util/t/max.t List::Util ext/List/Util/t/maxstr.t List::Util ext/List/Util/t/min.t List::Util @@ -484,6 +485,7 @@ ext/List/Util/t/openhan.t Scalar::Util ext/List/Util/t/readonly.t Scalar::Util ext/List/Util/t/reduce.t List::Util +ext/List/Util/t/refaddr.t Scalar::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 ==== //depot/perl/ext/List/Util/ChangeLog#7 (text) ==== Index: perl/ext/List/Util/ChangeLog --- perl/ext/List/Util/ChangeLog#6~15283~ Mon Mar 18 02:10:55 2002 +++ perl/ext/List/Util/ChangeLog Sun Nov 3 02:11:18 2002 @@ -1,3 +1,39 @@ +Change 757 on 2002/11/03 by <[EMAIL PROTECTED]> (Graham Barr) + + Add XS_VERSION + +Change 756 on 2002/11/03 by <[EMAIL PROTECTED]> (Graham Barr) + + Use PAD_* macros in 5.9 + Reuse our own target when calling pp_rand in shuffle() so we dont need to +create a fake pad + +Change 751 on 2002/10/18 by <[EMAIL PROTECTED]> (Graham Barr) + + Fix context so that sub for reduce/first is always in a scalar context + Fix sum/min/max so that they dont upgrade thier argumetns to NVs + if they are IV or UV + +Change 750 on 2002/10/14 by <[EMAIL PROTECTED]> (Graham Barr) + + Add isvstring() + +Change 745 on 2002/09/23 by <[EMAIL PROTECTED]> (Graham Barr) + + Scalar::Util + - Add refaddr() + +Change 722 on 2002/04/29 by <[EMAIL PROTECTED]> (Graham Barr) + + Release 1.0701 + +Change 721 on 2002/04/29 by <[EMAIL PROTECTED]> (Graham Barr) + + Add comment to README about failing tests on perl5.6.0 + +Change 714 on 2002/03/18 by <[EMAIL PROTECTED]> (Graham Barr) + + Release 1.07 + Change 713 on 2002/03/18 by <[EMAIL PROTECTED]> (Graham Barr) Add Scalar::Util::openhandle() ==== //depot/perl/ext/List/Util/README#3 (text) ==== Index: perl/ext/List/Util/README --- perl/ext/List/Util/README#2~11885~ Wed Sep 5 08:26:18 2001 +++ perl/ext/List/Util/README Sun Nov 3 02:11:18 2002 @@ -27,6 +27,12 @@ dualvar shuffle -Copyright (c) 1997-2001 Graham Barr <[EMAIL PROTECTED]>. All rights reserved. +KNOWN BUGS + +There is a bug in perl5.6.0 with UV's that are >= 1<<31. This will +show up as tests 8 and 9 of dualvar.t failing + + +Copyright (c) 1997-2002 Graham Barr <[EMAIL PROTECTED]>. All rights reserved. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. ==== //depot/perl/ext/List/Util/Util.xs#15 (text) ==== Index: perl/ext/List/Util/Util.xs --- perl/ext/List/Util/Util.xs#14~18048~ Tue Oct 22 10:04:26 2002 +++ perl/ext/List/Util/Util.xs Sun Nov 3 02:11:18 2002 @@ -43,6 +43,12 @@ # define NV double #endif +#ifdef SVf_IVisUV +# define slu_sv_value(sv) (NV)(SvIOK(sv) ? SvIOK_UV(sv) ? SvUVX(sv) : SvIVX(sv) : +SvNV(sv)) +#else +# define slu_sv_value(sv) (NV)(SvIOK(sv) ? SvIVX(sv) : SvNV(sv)) +#endif + #ifndef Drand01 # define Drand01() ((rand() & 0x7FFF) / (double) ((unsigned long)1 << 15)) #endif @@ -90,6 +96,10 @@ # endif #endif +#ifndef PTR2IV +# define PTR2IV(ptr) (IV)(ptr) +#endif + MODULE=List::Util PACKAGE=List::Util void @@ -107,10 +117,10 @@ XSRETURN_UNDEF; } retsv = ST(0); - retval = SvNV(retsv); + retval = slu_sv_value(retsv); for(index = 1 ; index < items ; index++) { SV *stacksv = ST(index); - NV val = SvNV(stacksv); + NV val = slu_sv_value(stacksv); if(val < retval ? !ix : ix) { retsv = stacksv; retval = val; @@ -127,13 +137,16 @@ PROTOTYPE: @ CODE: { + SV *sv; int index; if(!items) { XSRETURN_UNDEF; } - RETVAL = SvNV(ST(0)); + sv = ST(0); + RETVAL = slu_sv_value(sv); for(index = 1 ; index < items ; index++) { - RETVAL += SvNV(ST(index)); + sv = ST(index); + RETVAL += slu_sv_value(sv); } } OUTPUT: @@ -199,6 +212,7 @@ PERL_CONTEXT *cx; SV** newsp; I32 gimme = G_SCALAR; + I32 hasargs = 0; bool oldcatch = CATCH_GET; if(items <= 1) { @@ -222,7 +236,10 @@ SAVESPTR(PL_op); ret = ST(1); CATCH_SET(TRUE); - PUSHBLOCK(cx, CXt_NULL, SP); + PUSHBLOCK(cx, CXt_SUB, SP); + PUSHSUB(cx); + if (!CvDEPTH(cv)) + (void)SvREFCNT_inc(cv); for(index = 2 ; index < items ; index++) { GvSV(agv) = ret; GvSV(bgv) = ST(index); @@ -250,6 +267,7 @@ PERL_CONTEXT *cx; SV** newsp; I32 gimme = G_SCALAR; + I32 hasargs = 0; bool oldcatch = CATCH_GET; if(items <= 1) { @@ -269,7 +287,11 @@ SAVETMPS; SAVESPTR(PL_op); CATCH_SET(TRUE); - PUSHBLOCK(cx, CXt_NULL, SP); + PUSHBLOCK(cx, CXt_SUB, SP); + PUSHSUB(cx); + if (!CvDEPTH(cv)) + (void)SvREFCNT_inc(cv); + for(index = 1 ; index < items ; index++) { GvSV(PL_defgv) = ST(index); PL_op = reducecop; @@ -380,6 +402,20 @@ OUTPUT: RETVAL +IV +refaddr(sv) + SV * sv +PROTOTYPE: $ +CODE: +{ + if(!SvROK(sv)) { + XSRETURN_UNDEF; + } + RETVAL = PTR2IV(SvRV(sv)); +} +OUTPUT: + RETVAL + void weaken(sv) SV *sv @@ -421,16 +457,34 @@ OUTPUT: RETVAL +void +isvstring(sv) + SV *sv +PROTOTYPE: $ +CODE: +#ifdef SvVOK + ST(0) = boolSV(SvVOK(sv)); + XSRETURN(1); +#else + croak("vstrings are not implemented in this release of perl"); +#endif + + BOOT: { -#ifndef SvWEAKREF +#if !defined(SvWEAKREF) || !defined(SvVOK) HV *stash = gv_stashpvn("Scalar::Util", 12, TRUE); GV *vargv = *(GV**)hv_fetch(stash, "EXPORT_FAIL", 11, TRUE); AV *varav; if (SvTYPE(vargv) != SVt_PVGV) gv_init(vargv, stash, "Scalar::Util", 12, TRUE); varav = GvAVn(vargv); +#endif +#ifndef SvWEAKREF av_push(varav, newSVpv("weaken",6)); av_push(varav, newSVpv("isweak",6)); +#endif +#ifndef SvVOK + av_push(varav, newSVpv("isvstring",9)); #endif } ==== //depot/perl/ext/List/Util/lib/List/Util.pm#11 (text) ==== Index: perl/ext/List/Util/lib/List/Util.pm --- perl/ext/List/Util/lib/List/Util.pm#10~16822~ Mon May 27 13:42:47 2002 +++ perl/ext/List/Util/lib/List/Util.pm Sun Nov 3 02:11:18 2002 @@ -9,11 +9,11 @@ require Exporter; require DynaLoader; -our @ISA = qw(Exporter DynaLoader); -our @EXPORT_OK = qw(first min max minstr maxstr reduce sum shuffle); -our $VERSION = "1.07_00"; +our @ISA = qw(Exporter DynaLoader); +our @EXPORT_OK = qw(first min max minstr maxstr reduce sum shuffle); +our $VERSION = "1.08_00"; our $XS_VERSION = $VERSION; -$VERSION = eval $VERSION; +$VERSION = eval $VERSION; bootstrap List::Util $XS_VERSION; ==== //depot/perl/ext/List/Util/lib/Scalar/Util.pm#8 (text) ==== Index: perl/ext/List/Util/lib/Scalar/Util.pm --- perl/ext/List/Util/lib/Scalar/Util.pm#7~15283~ Mon Mar 18 02:10:55 2002 +++ perl/ext/List/Util/lib/Scalar/Util.pm Sun Nov 3 02:11:18 2002 @@ -10,7 +10,7 @@ require List::Util; # List::Util loads the XS our @ISA = qw(Exporter); -our @EXPORT_OK = qw(blessed dualvar reftype weaken isweak tainted readonly openhandle); +our @EXPORT_OK = qw(blessed dualvar reftype weaken isweak tainted readonly openhandle +refaddr isvstring); our $VERSION = $List::Util::VERSION; sub openhandle ($) { @@ -41,7 +41,7 @@ =head1 SYNOPSIS - use Scalar::Util qw(blessed dualvar isweak readonly reftype tainted weaken); + use Scalar::Util qw(blessed dualvar isweak readonly refaddr reftype tainted +weaken); =head1 DESCRIPTION @@ -78,6 +78,14 @@ $num = $foo + 2; # 12 $str = $foo . " world"; # Hello world +=item isvstring EXPR + +If EXPR is a scalar which was coded as a vstring the result is true. + + $vs = v49.46.48; + $fmt = isvstring($vs) ? "%vd" : "%s"; #true + printf($fmt,$vs); + =item isweak EXPR If EXPR is a scalar which is a weak reference the result is true. @@ -105,6 +113,18 @@ $readonly = foo($bar); # false $readonly = foo(0); # true + +=item refaddr EXPR + +If EXPR evaluates to a reference the internal memory address of +the referenced value is returned. Otherwise C<undef> is returned. + + $addr = refaddr "string"; # undef + $addr = refaddr \$var; # eg 12345678 + $addr = refaddr []; # eg 23456784 + + $obj = bless {}, "Foo"; + $addr = refaddr $obj; # eg 88123488 =item reftype EXPR ==== //depot/perl/ext/List/Util/t/first.t#3 (xtext) ==== Index: perl/ext/List/Util/t/first.t --- perl/ext/List/Util/t/first.t#2~11853~ Mon Sep 3 13:00:00 2001 +++ perl/ext/List/Util/t/first.t Sun Nov 3 02:11:18 2002 @@ -15,7 +15,7 @@ use List::Util qw(first); -print "1..7\n"; +print "1..8\n"; print "not " unless defined &first; print "ok 1\n"; @@ -41,3 +41,10 @@ print "not " if defined eval { first { die if $_ } 0,0,1 }; print "ok 7\n"; + +($x) = foobar(); +$x = '' unless defined $x; +print "${x}ok 8\n"; + +sub foobar { first { !defined(wantarray) || wantarray } "not ","not ","not " } + ==== //depot/perl/ext/List/Util/t/isvstring.t#1 (text) ==== Index: perl/ext/List/Util/t/isvstring.t --- /dev/null Tue May 5 13:32:27 1998 +++ perl/ext/List/Util/t/isvstring.t Sun Nov 3 02:11:18 2002 @@ -0,0 +1,41 @@ +#!./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; + } + } + $|=1; + require Scalar::Util; + if (grep { /isvstring/ } @Scalar::Util::EXPORT_FAIL) { + print("1..0\n"); + exit 0; + } +} + +use Scalar::Util qw(isvstring); + +print "1..4\n"; + +print "ok 1\n"; + +$vs = 49.46.48; + +print "not " unless $vs == "1.0"; +print "ok 2\n"; + +print "not " unless isvstring($vs); +print "ok 3\n"; + +$sv = "1.0"; +print "not " if isvstring($sv); +print "ok 4\n"; + + + ==== //depot/perl/ext/List/Util/t/reduce.t#3 (xtext) ==== Index: perl/ext/List/Util/t/reduce.t --- perl/ext/List/Util/t/reduce.t#2~11853~ Mon Sep 3 13:00:00 2001 +++ perl/ext/List/Util/t/reduce.t Sun Nov 3 02:11:18 2002 @@ -16,7 +16,7 @@ use List::Util qw(reduce min); -print "1..8\n"; +print "1..9\n"; print "not " if defined reduce {}; print "ok 1\n"; @@ -50,3 +50,9 @@ print "not " if defined eval { reduce { die if $b > 2; $a + $b } 0,1,2,3,4 }; print "ok 8\n"; + +($x) = foobar(); +print "${x}ok 9\n"; + +sub foobar { reduce { (defined(wantarray) && !wantarray) ? '' : 'not ' } 0,1,2,3 } + ==== //depot/perl/ext/List/Util/t/refaddr.t#1 (xtext) ==== Index: perl/ext/List/Util/t/refaddr.t --- /dev/null Tue May 5 13:32:27 1998 +++ perl/ext/List/Util/t/refaddr.t Sun Nov 3 02:11:18 2002 @@ -0,0 +1,54 @@ +#!./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(refaddr); +use vars qw($t $y $x *F $v $r); +use Symbol qw(gensym); + +# Ensure we do not trigger and tied methods +tie *F, 'MyTie'; + +print "1..13\n"; + +my $i = 1; +foreach $v (undef, 10, 'string') { + print "not " if defined refaddr($v); + print "ok ",$i++,"\n"; +} + +foreach $r ({}, \$t, [], \*F, sub {}) { + my $addr = $r + 0; + print "not " unless refaddr($r) == $addr; + print "ok ",$i++,"\n"; + my $obj = bless $r, 'FooBar'; + print "not " unless refaddr($r) == $addr; + print "ok ",$i++,"\n"; +} + +package FooBar; + +use overload '0+' => sub { 10 }, + '+' => sub { 10 + $_[1] }; + +package MyTie; + +sub TIEHANDLE { bless {} } +sub DESTROY {} + +sub AUTOLOAD { + warn "$AUTOLOAD called"; + exit 1; # May be in an eval +} End of Patch.