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.
