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
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
+Change 757 on 2002/11/03 by <gbarr@pobox.com> (Graham Barr)
+
+ Add XS_VERSION
+
+Change 756 on 2002/11/03 by <gbarr@pobox.com> (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 <gbarr@pobox.com> (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 <gbarr@pobox.com> (Graham Barr)
+
+ Add isvstring()
+
+Change 745 on 2002/09/23 by <gbarr@pobox.com> (Graham Barr)
+
+ Scalar::Util
+ - Add refaddr()
+
+Change 722 on 2002/04/29 by <gbarr@pobox.com> (Graham Barr)
+
+ Release 1.0701
+
+Change 721 on 2002/04/29 by <gbarr@pobox.com> (Graham Barr)
+
+ Add comment to README about failing tests on perl5.6.0
+
+Change 714 on 2002/03/18 by <gbarr@pobox.com> (Graham Barr)
+
+ Release 1.07
+
Change 713 on 2002/03/18 by <gbarr@pobox.com> (Graham Barr)
Add Scalar::Util::openhandle()
dualvar
shuffle
-Copyright (c) 1997-2001 Graham Barr <gbarr@pobox.com>. 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 <gbarr@pobox.com>. All rights reserved.
This library is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
# 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
# endif
#endif
+#ifndef PTR2IV
+# define PTR2IV(ptr) (IV)(ptr)
+#endif
+
MODULE=List::Util PACKAGE=List::Util
void
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;
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:
PERL_CONTEXT *cx;
SV** newsp;
I32 gimme = G_SCALAR;
+ I32 hasargs = 0;
bool oldcatch = CATCH_GET;
if(items <= 1) {
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);
PERL_CONTEXT *cx;
SV** newsp;
I32 gimme = G_SCALAR;
+ I32 hasargs = 0;
bool oldcatch = CATCH_GET;
if(items <= 1) {
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;
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
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
}
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;
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 ($) {
=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
$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.
$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
If EXPR evaluates to a reference the type of the variable referenced
use List::Util qw(first);
-print "1..7\n";
+print "1..8\n";
print "not " unless defined &first;
print "ok 1\n";
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 " }
+
--- /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;
+ }
+ }
+ $|=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";
+
+
+
use List::Util qw(reduce min);
-print "1..8\n";
+print "1..9\n";
print "not " if defined reduce {};
print "ok 1\n";
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 }
+
--- /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 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
+}
projects / p5sagit/p5-mst-13.2.git / commitdiff