cpan/libnet/t/time.t libnet
cpan/List-Util/Changes Util extension
cpan/List-Util/lib/List/Util.pm List::Util
-cpan/List-Util/lib/List/Util/PP.pm List::Util
cpan/List-Util/lib/List/Util/XS.pm List::Util
cpan/List-Util/lib/Scalar/Util.pm Scalar::Util
-cpan/List-Util/lib/Scalar/Util/PP.pm Scalar::Util
cpan/List-Util/ListUtil.xs Util extension
cpan/List-Util/Makefile.PL Util extension
cpan/List-Util/multicall.h Util extension
cpan/List-Util/t/00version.t Scalar::Util
cpan/List-Util/t/blessed.t Scalar::Util
cpan/List-Util/t/dualvar.t Scalar::Util
-cpan/List-Util/t/expfail.t List::Util
cpan/List-Util/t/first.t List::Util
+cpan/List-Util/t/getmagic-once.t
cpan/List-Util/t/isvstring.t Scalar::Util
cpan/List-Util/t/lln.t Scalar::Util
cpan/List-Util/t/maxstr.t List::Util
cpan/List-Util/t/minstr.t List::Util
cpan/List-Util/t/min.t List::Util
cpan/List-Util/t/openhan.t Scalar::Util
-cpan/List-Util/t/p_00version.t Scalar::Util
-cpan/List-Util/t/p_blessed.t Scalar::Util
-cpan/List-Util/t/p_first.t List::Util
-cpan/List-Util/t/p_lln.t Scalar::Util
-cpan/List-Util/t/p_maxstr.t List::Util
-cpan/List-Util/t/p_max.t List::Util
-cpan/List-Util/t/p_minstr.t List::Util
-cpan/List-Util/t/p_min.t List::Util
-cpan/List-Util/t/p_openhan.t Scalar::Util
-cpan/List-Util/t/p_readonly.t Scalar::Util
-cpan/List-Util/t/p_reduce.t List::Util
-cpan/List-Util/t/p_refaddr.t Scalar::Util
-cpan/List-Util/t/p_reftype.t Scalar::Util
cpan/List-Util/t/proto.t Scalar::Util
-cpan/List-Util/t/p_shuffle.t List::Util
-cpan/List-Util/t/p_sum.t List::Util
-cpan/List-Util/t/p_tainted.t Scalar::Util
cpan/List-Util/t/readonly.t Scalar::Util
cpan/List-Util/t/reduce.t List::Util
cpan/List-Util/t/refaddr.t Scalar::Util
cpan/List-Util/t/sum.t List::Util
cpan/List-Util/t/tainted.t Scalar::Util
cpan/List-Util/t/weak.t Scalar::Util
-cpan/List-Util/XS.pp List::Util
cpan/Locale-Codes/ChangeLog Locale::Codes
cpan/Locale-Codes/lib/Locale/Codes/API.pod Locale::Codes documentation
cpan/Locale-Codes/lib/Locale/Codes/Changes.pod Locale::Codes documentation
'Scalar-List-Utils' => {
'MAINTAINER' => 'gbarr',
- 'DISTRIBUTION' => 'GBARR/Scalar-List-Utils-1.23.tar.gz',
+ 'DISTRIBUTION' => 'PEVANS/Scalar-List-Utils-1.25.tar.gz',
# Note that perl uses its own version of Makefile.PL
'FILES' => q[cpan/List-Util],
+1.25 -- Sat Mar 24 13:10:13 UTC 2012
+
+ * Restore back-compat. to perl 5.6 (thanks to Zefram)
+
+1.24 -- Thu Mar 22 18:10:10 UTC 2012
+
+ * Update to 1.24 release version (no other changes since 1.23_04).
+
+1.23_04 -- Sat Mar 10 00:16:16 UTC 2012
+
+ * RT#72700 Fix off-by-two on string literal length
+
+1.23_03 -- Tue Sep 14 10:09:59 CDT 2010
+
+ * Min perl version supported for build is not 5.008
+ * Dropped the pure-Perl implementation of both Scalar::- and List::Util.
+ * RT#61118 Fix assumption in sum() that once magic, always magic
+
+1.23_02 -- Tue Mar 30 11:09:15 CDT 2010
+
+ * Fix first() and reduce() to check the callback first; &first(1) is now illigal. [gfx]
+ * Fix reduce() to allow XSUB callbacks [gfx]
+ * Fix first() to allow XSUB callbacks [gfx]
+ * Resolve RT #55763: tainted() doesn't do SvGETMAGIC(sv) [gfx]
+ * define CvISXSUB so older perl versions will still compile
+
+1.23_01 -- Mon Mar 22 08:24:11 CDT 2010
+
+ * Add failing tests; SVt_RV is not directly SvROK [gfx]
+ * Implement openhandle() in XS (with extra tests) [gfx]
+ * Modernize *.pm [gfx]
+ * Modernize ListUtil.xs [gfx]
+ * Add ppport.h [gfx]
+ * Fix an overloading issue on sum(), and add tests for overloading [gfx]
+ * Small tweaks for minstr()/maxstr() [gfx]
+ * Optimize dualvar() [gfx]
+ * Use sv_copypv() instead of SvPV() and sv_setpv() [gfx]
+ * avoid non-portable warnings
+
1.23 -- Wed Mar 10 20:50:00 CST 2010
* Add a test file to ensure 'GETMAGIC' called once [gfx]
#include <perl.h>
#include <XSUB.h>
-#ifndef PERL_VERSION
-# include <patchlevel.h>
-# if !(defined(PERL_VERSION) || (SUBVERSION > 0 && defined(PATCHLEVEL)))
-# include <could_not_find_Perl_patchlevel.h>
-# endif
-# define PERL_REVISION 5
-# define PERL_VERSION PATCHLEVEL
-# define PERL_SUBVERSION SUBVERSION
-#endif
+#define NEED_sv_2pv_flags 1
+#include "ppport.h"
-#if PERL_VERSION >= 6
+#if PERL_BCDVERSION >= 0x5006000
# include "multicall.h"
#endif
-#ifndef aTHX
-# define aTHX
-# define pTHX
+#ifndef CvISXSUB
+# define CvISXSUB(cv) CvXSUB(cv)
#endif
+
/* Some platforms have strict exports. And before 5.7.3 cxinc (or Perl_cxinc)
was not exported. Therefore platforms like win32, VMS etc have problems
so we redefine it here -- GMB
*/
-#if PERL_VERSION < 7
+#if PERL_BCDVERSION < 0x5007000
/* Not in 5.6.1. */
-# define SvUOK(sv) SvIOK_UV(sv)
# ifdef cxinc
# undef cxinc
# endif
my_cxinc(pTHX)
{
cxstack_max = cxstack_max * 3 / 2;
- Renew(cxstack, cxstack_max + 1, struct context); /* XXX should fix CXINC macro */
+ Renew(cxstack, cxstack_max + 1, struct context); /* fencepost bug in older CXINC macros requires +1 here */
return cxstack_ix + 1;
}
#endif
-#if PERL_VERSION < 6
-# define NV double
+#ifndef sv_copypv
+#define sv_copypv(a, b) my_sv_copypv(aTHX_ a, b)
+static void
+my_sv_copypv(pTHX_ SV *const dsv, SV *const ssv)
+{
+ STRLEN len;
+ const char * const s = SvPV_const(ssv,len);
+ sv_setpvn(dsv,s,len);
+ if (SvUTF8(ssv))
+ SvUTF8_on(dsv);
+ else
+ SvUTF8_off(dsv);
+}
#endif
#ifdef SVf_IVisUV
# define slu_sv_value(sv) (SvIOK(sv)) ? (NV)(SvIVX(sv)) : (SvNV(sv))
#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)
-# endif
-# ifndef SvTAINTED
-
-static bool
-sv_tainted(pTHX_ SV *sv)
-{
- if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv)) {
- MAGIC *mg = mg_find(sv, 't');
- if (mg && ((mg->mg_len & 1) || (mg->mg_len & 2) && mg->mg_obj == sv))
- return TRUE;
- }
- return FALSE;
-}
-
-# define SvTAINTED_on(sv) sv_magic((sv), Nullsv, 't', Nullch, 0)
-# define SvTAINTED(sv) (SvMAGICAL(sv) && sv_tainted(aTHX_ sv))
-# endif
-# define PL_defgv defgv
-# define PL_op op
-# define PL_curpad curpad
-# define CALLRUNOPS runops
-# define PL_curpm curpm
-# define PL_sv_undef sv_undef
-# define PERL_CONTEXT struct context
-#endif
-#if (PERL_VERSION < 5) || (PERL_VERSION == 5 && PERL_SUBVERSION <50)
-# ifndef PL_tainting
-# define PL_tainting tainting
-# endif
-# ifndef PL_stack_base
-# define PL_stack_base stack_base
-# endif
-# ifndef PL_stack_sp
-# define PL_stack_sp stack_sp
-# endif
-# ifndef PL_ppaddr
-# define PL_ppaddr ppaddr
-# endif
-#endif
-
-#ifndef PTR2UV
-# define PTR2UV(ptr) (UV)(ptr)
-#endif
-
-#ifndef SvUV_set
-# define SvUV_set(sv, val) (((XPVUV*)SvANY(sv))->xuv_uv = (val))
-#endif
-
-#ifndef PERL_UNUSED_DECL
-# ifdef HASATTRIBUTE
-# if (defined(__GNUC__) && defined(__cplusplus)) || defined(__INTEL_COMPILER)
-# define PERL_UNUSED_DECL
-# else
-# define PERL_UNUSED_DECL __attribute__((unused))
-# endif
-# else
-# define PERL_UNUSED_DECL
-# endif
-#endif
-
-#ifndef dNOOP
-#define dNOOP extern int Perl___notused PERL_UNUSED_DECL
-#endif
-
-#ifndef GvSVn
-# define GvSVn GvSV
-#endif
-
MODULE=List::Util PACKAGE=List::Util
void
PROTOTYPE: @
CODE:
{
+ dXSTARG;
SV *sv;
SV *retsv = NULL;
int index;
NV retval = 0;
+ int magic;
if(!items) {
XSRETURN_UNDEF;
}
- sv = ST(0);
- if (SvAMAGIC(sv)) {
- retsv = sv_newmortal();
+ sv = ST(0);
+ magic = SvAMAGIC(sv);
+ if (magic) {
+ retsv = TARG;
sv_setsv(retsv, sv);
}
else {
retval = slu_sv_value(sv);
}
for(index = 1 ; index < items ; index++) {
- sv = ST(index);
- if (retsv || SvAMAGIC(sv)) {
- if (!retsv) {
- retsv = sv_newmortal();
- sv_setnv(retsv,retval);
+ sv = ST(index);
+ if(!magic && SvAMAGIC(sv)){
+ magic = TRUE;
+ if (!retsv)
+ retsv = TARG;
+ sv_setnv(retsv,retval);
+ }
+ if (magic) {
+ SV* const tmpsv = amagic_call(retsv, sv, add_amg, SvAMAGIC(retsv) ? AMGf_assign : 0);
+ if(tmpsv) {
+ magic = SvAMAGIC(tmpsv);
+ if (!magic) {
+ retval = slu_sv_value(tmpsv);
+ }
+ else {
+ retsv = tmpsv;
+ }
}
- if (!amagic_call(retsv, sv, add_amg, AMGf_assign)) {
- sv_setnv(retsv, SvNV(retsv) + SvNV(sv));
+ else {
+ /* fall back to default */
+ magic = FALSE;
+ retval = SvNV(retsv) + SvNV(sv);
}
}
else {
retval += slu_sv_value(sv);
}
}
- if (!retsv) {
- retsv = sv_newmortal();
+ if (!magic) {
+ if (!retsv)
+ retsv = TARG;
sv_setnv(retsv,retval);
}
ST(0) = retsv;
XSRETURN(1);
}
+#define SLU_CMP_LARGER 1
+#define SLU_CMP_SMALLER -1
void
minstr(...)
PROTOTYPE: @
ALIAS:
- minstr = 2
- maxstr = 0
+ minstr = SLU_CMP_LARGER
+ maxstr = SLU_CMP_SMALLER
CODE:
{
SV *left;
if(!items) {
XSRETURN_UNDEF;
}
- /*
- sv_cmp & sv_cmp_locale return 1,0,-1 for gt,eq,lt
- so we set ix to the value we are looking for
- xsubpp does not allow -ve values, so we start with 0,2 and subtract 1
- */
- ix -= 1;
left = ST(0);
#ifdef OPpLOCALE
if(MAXARG & OPpLOCALE) {
PROTOTYPE: &@
CODE:
{
- dMULTICALL;
SV *ret = sv_newmortal();
int index;
GV *agv,*bgv,*gv;
HV *stash;
- I32 gimme = G_SCALAR;
SV **args = &PL_stack_base[ax];
- CV *cv;
+ CV* cv = sv_2cv(block, &stash, &gv, 0);
- if(items <= 1) {
- XSRETURN_UNDEF;
- }
- cv = sv_2cv(block, &stash, &gv, 0);
if (cv == Nullcv) {
croak("Not a subroutine reference");
}
- PUSH_MULTICALL(cv);
- agv = gv_fetchpv("a", TRUE, SVt_PV);
- bgv = gv_fetchpv("b", TRUE, SVt_PV);
+
+ if(items <= 1) {
+ XSRETURN_UNDEF;
+ }
+
+ agv = gv_fetchpv("a", GV_ADD, SVt_PV);
+ bgv = gv_fetchpv("b", GV_ADD, SVt_PV);
SAVESPTR(GvSV(agv));
SAVESPTR(GvSV(bgv));
GvSV(agv) = ret;
SvSetSV(ret, args[1]);
- for(index = 2 ; index < items ; index++) {
- GvSV(bgv) = args[index];
- MULTICALL;
- SvSetSV(ret, *PL_stack_sp);
+
+ if(!CvISXSUB(cv)) {
+ dMULTICALL;
+ I32 gimme = G_SCALAR;
+
+ PUSH_MULTICALL(cv);
+ for(index = 2 ; index < items ; index++) {
+ GvSV(bgv) = args[index];
+ MULTICALL;
+ SvSetSV(ret, *PL_stack_sp);
+ }
+ POP_MULTICALL;
}
- POP_MULTICALL;
+ else {
+ for(index = 2 ; index < items ; index++) {
+ dSP;
+ GvSV(bgv) = args[index];
+
+ PUSHMARK(SP);
+ call_sv((SV*)cv, G_SCALAR);
+
+ SvSetSV(ret, *PL_stack_sp);
+ }
+ }
+
ST(0) = ret;
XSRETURN(1);
}
PROTOTYPE: &@
CODE:
{
- dMULTICALL;
int index;
GV *gv;
HV *stash;
- I32 gimme = G_SCALAR;
SV **args = &PL_stack_base[ax];
- CV *cv;
+ CV *cv = sv_2cv(block, &stash, &gv, 0);
+ if (cv == Nullcv) {
+ croak("Not a subroutine reference");
+ }
if(items <= 1) {
XSRETURN_UNDEF;
}
- cv = sv_2cv(block, &stash, &gv, 0);
- if (cv == Nullcv) {
- croak("Not a subroutine reference");
- }
- PUSH_MULTICALL(cv);
+
SAVESPTR(GvSV(PL_defgv));
- for(index = 1 ; index < items ; index++) {
- GvSV(PL_defgv) = args[index];
- MULTICALL;
- if (SvTRUE(*PL_stack_sp)) {
- POP_MULTICALL;
- ST(0) = ST(index);
- XSRETURN(1);
- }
+ if(!CvISXSUB(cv)) {
+ dMULTICALL;
+ I32 gimme = G_SCALAR;
+ PUSH_MULTICALL(cv);
+
+ for(index = 1 ; index < items ; index++) {
+ GvSV(PL_defgv) = args[index];
+ MULTICALL;
+ if (SvTRUEx(*PL_stack_sp)) {
+ POP_MULTICALL;
+ ST(0) = ST(index);
+ XSRETURN(1);
+ }
+ }
+ POP_MULTICALL;
+ }
+ else {
+ for(index = 1 ; index < items ; index++) {
+ dSP;
+ GvSV(PL_defgv) = args[index];
+
+ PUSHMARK(SP);
+ call_sv((SV*)cv, G_SCALAR);
+ if (SvTRUEx(*PL_stack_sp)) {
+ ST(0) = ST(index);
+ XSRETURN(1);
+ }
+ }
}
- POP_MULTICALL;
XSRETURN_UNDEF;
}
PROTOTYPE: $$
CODE:
{
- STRLEN len;
- char *ptr = SvPV(str,len);
- ST(0) = sv_newmortal();
- (void)SvUPGRADE(ST(0),SVt_PVNV);
- sv_setpvn(ST(0),ptr,len);
- if (SvUTF8(str))
- SvUTF8_on(ST(0));
+ dXSTARG;
+ (void)SvUPGRADE(TARG, SVt_PVNV);
+ sv_copypv(TARG,str);
if(SvNOK(num) || SvPOK(num) || SvMAGICAL(num)) {
- SvNV_set(ST(0), SvNV(num));
- SvNOK_on(ST(0));
+ SvNV_set(TARG, SvNV(num));
+ SvNOK_on(TARG);
}
#ifdef SVf_IVisUV
else if (SvUOK(num)) {
- SvUV_set(ST(0), SvUV(num));
- SvIOK_on(ST(0));
- SvIsUV_on(ST(0));
+ SvUV_set(TARG, SvUV(num));
+ SvIOK_on(TARG);
+ SvIsUV_on(TARG);
}
#endif
else {
- SvIV_set(ST(0), SvIV(num));
- SvIOK_on(ST(0));
+ SvIV_set(TARG, SvIV(num));
+ SvIOK_on(TARG);
}
if(PL_tainting && (SvTAINTED(num) || SvTAINTED(str)))
- SvTAINTED_on(ST(0));
+ SvTAINTED_on(TARG);
+ ST(0) = TARG;
XSRETURN(1);
}
PROTOTYPE: $
CODE:
{
- if (SvMAGICAL(sv))
- mg_get(sv);
+ SvGETMAGIC(sv);
if(!(SvROK(sv) && SvOBJECT(SvRV(sv)))) {
XSRETURN_UNDEF;
}
PROTOTYPE: $
CODE:
{
- if (SvMAGICAL(sv))
- mg_get(sv);
+ SvGETMAGIC(sv);
if(!SvROK(sv)) {
XSRETURN_UNDEF;
}
PROTOTYPE: $
CODE:
{
- if (SvMAGICAL(sv))
- mg_get(sv);
+ SvGETMAGIC(sv);
if(!SvROK(sv)) {
XSRETURN_UNDEF;
}
SV *sv
PROTOTYPE: $
CODE:
+ SvGETMAGIC(sv);
RETVAL = SvREADONLY(sv);
OUTPUT:
RETVAL
SV *sv
PROTOTYPE: $
CODE:
+ SvGETMAGIC(sv);
RETVAL = SvTAINTED(sv);
OUTPUT:
RETVAL
PROTOTYPE: $
CODE:
#ifdef SvVOK
+ SvGETMAGIC(sv);
ST(0) = boolSV(SvVOK(sv));
XSRETURN(1);
#else
PROTOTYPE: $
CODE:
SV *tempsv;
+ SvGETMAGIC(sv);
if (SvAMAGIC(sv) && (tempsv = AMG_CALLun(sv, numer))) {
sv = tempsv;
}
- else if (SvMAGICAL(sv)) {
- SvGETMAGIC(sv);
- }
-#if (PERL_VERSION < 8) || (PERL_VERSION == 8 && PERL_SUBVERSION <5)
+#if PERL_BCDVERSION < 0x5008005
if (SvPOK(sv) || SvPOKp(sv)) {
RETVAL = looks_like_number(sv);
}
}
if (SvPOK(proto)) {
/* set the prototype */
- STRLEN len;
- char *ptr = SvPV(proto, len);
- sv_setpvn(sv, ptr, len);
+ sv_copypv(sv, proto);
}
else {
/* delete the prototype */
XSRETURN(1);
}
+void
+openhandle(SV* sv)
+PROTOTYPE: $
+CODE:
+{
+ IO* io = NULL;
+ SvGETMAGIC(sv);
+ if(SvROK(sv)){
+ /* deref first */
+ sv = SvRV(sv);
+ }
+
+ /* must be GLOB or IO */
+ if(isGV(sv)){
+ io = GvIO((GV*)sv);
+ }
+ else if(SvTYPE(sv) == SVt_PVIO){
+ io = (IO*)sv;
+ }
+
+ if(io){
+ /* real or tied filehandle? */
+ if(IoIFP(io) || SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar)){
+ XSRETURN(1);
+ }
+ }
+ XSRETURN_UNDEF;
+}
+
BOOT:
{
HV *lu_stash = gv_stashpvn("List::Util", 10, TRUE);
varav = GvAVn(vargv);
#endif
if (SvTYPE(rmcgv) != SVt_PVGV)
- gv_init(rmcgv, lu_stash, "List::Util", 12, TRUE);
+ gv_init(rmcgv, lu_stash, "List::Util", 10, TRUE);
rmcsv = GvSVn(rmcgv);
#ifndef SvWEAKREF
av_push(varav, newSVpv("weaken",6));
# -*- perl -*-
-BEGIN { require 5.006; } # allow CPAN testers to get the point
+BEGIN { require 5.006; }
use strict;
use warnings;
use Config;
use ExtUtils::MakeMaker;
my $PERL_CORE = grep { $_ eq 'PERL_CORE=1' } @ARGV;
-my $do_xs = $PERL_CORE || can_cc();
-
-for (@ARGV) {
- /^-pm/ and $do_xs = 0;
- /^-xs/ and $do_xs = 1;
-}
-
WriteMakefile(
NAME => q[List::Util],
ABSTRACT => q[Common Scalar and List utility subroutines],
INSTALLDIRS => q[perl],
PREREQ_PM => {'Test::More' => 0,},
(eval { ExtUtils::MakeMaker->VERSION(6.31) } ? (LICENSE => 'perl') : ()),
- ($do_xs ? () : (XS => {}, C => [], OBJECT => '')),
( eval { ExtUtils::MakeMaker->VERSION(6.46) } ? (
META_MERGE => {
resources => { ##
- repository => 'http://github.com/gbarr/Scalar-List-Utils',
+ repository => 'https://github.com/Scalar-List-Utils/Scalar-List-Utils',
},
}
)
),
);
-
-sub can_cc {
-
- foreach my $cmd (split(/ /, $Config::Config{cc})) {
- my $_cmd = $cmd;
- return $_cmd if (-x $_cmd or $_cmd = MM->maybe_command($_cmd));
-
- for my $dir ((split /$Config::Config{path_sep}/, $ENV{PATH}), '.') {
- my $abs = File::Spec->catfile($dir, $_[1]);
- return $abs if (-x $abs or $abs = MM->maybe_command($abs));
- }
- }
-
- return;
-}
-
-package MY;
-
-sub init_PM {
- my $self = shift;
-
- $self->SUPER::init_PM(@_);
-
- return if $do_xs;
-
- my $pm = $self->{PM};
- my $pm_file = File::Spec->catfile(qw(lib List Util XS.pm));
-
- # When installing pure perl, install XS.pp as XS.pm
- $self->{PM}{'XS.pp'} = delete $self->{PM}{$pm_file};
-}
-
+++ /dev/null
-package List::Util::XS;
-use strict;
-use vars qw($VERSION);
-
-$VERSION = undef;
-
-sub VERSION {
- require Carp;
- Carp::croak("You need to install Scalar-List-Utils with a C compiler to ensure the XS is compiled")
- if defined $_[1];
- $VERSION;
-}
-
-1;
-__END__
-
-=head1 NAME
-
-List::Util::XS - Indicate if List::Util was compiled with a C compiler
-
-=head1 SYNOPSIS
-
- use List::Util::XS 1.20;
-
-=head1 DESCRIPTION
-
-B<*** This instalation does not have XS installed ***>
-
-C<List::Util::XS> can be used as a dependency to ensure List::Util was
-installed using a C compiler and that the XS version is installed.
-
-During installation C<$List::Util::XS::VERSION> will be set to
-C<undef> if the XS was not compiled.
-
-=head1 SEE ALSO
-
-L<Scalar::Util>, L<List::Util>, L<List::MoreUtils>
-
-=head1 COPYRIGHT
-
-Copyright (c) 2008 Graham Barr <gbarr@pobox.com>. All rights reserved.
-This program is free software; you can redistribute it and/or
-modify it under the same terms as Perl itself.
-
-=cut
package List::Util;
use strict;
-use vars qw(@ISA @EXPORT_OK $VERSION $XS_VERSION $TESTING_PERL_ONLY);
require Exporter;
-@ISA = qw(Exporter);
-@EXPORT_OK = qw(first min max minstr maxstr reduce sum shuffle);
-$VERSION = "1.23";
-$XS_VERSION = $VERSION;
+our @ISA = qw(Exporter);
+our @EXPORT_OK = qw(first min max minstr maxstr reduce sum shuffle);
+our $VERSION = "1.25";
+our $XS_VERSION = $VERSION;
$VERSION = eval $VERSION;
-eval {
- # PERL_DL_NONLAZY must be false, or any errors in loading will just
- # cause the perl code to be tested
- local $ENV{PERL_DL_NONLAZY} = 0 if $ENV{PERL_DL_NONLAZY};
- eval {
- require XSLoader;
- XSLoader::load('List::Util', $XS_VERSION);
- 1;
- } or do {
- require DynaLoader;
- local @ISA = qw(DynaLoader);
- bootstrap List::Util $XS_VERSION;
- };
-} unless $TESTING_PERL_ONLY;
-
-
-if (!defined &sum) {
- require List::Util::PP;
- List::Util::PP->import;
-}
+require XSLoader;
+XSLoader::load('List::Util', $XS_VERSION);
1;
+++ /dev/null
-# List::Util::PP.pm
-#
-# Copyright (c) 1997-2009 Graham Barr <gbarr@pobox.com>. All rights reserved.
-# This program is free software; you can redistribute it and/or
-# modify it under the same terms as Perl itself.
-
-package List::Util::PP;
-
-use strict;
-use warnings;
-use vars qw(@ISA @EXPORT $VERSION $a $b);
-require Exporter;
-
-@ISA = qw(Exporter);
-@EXPORT = qw(first min max minstr maxstr reduce sum shuffle);
-$VERSION = "1.23";
-$VERSION = eval $VERSION;
-
-sub reduce (&@) {
- my $code = shift;
- require Scalar::Util;
- my $type = Scalar::Util::reftype($code);
- unless($type and $type eq 'CODE') {
- require Carp;
- Carp::croak("Not a subroutine reference");
- }
- no strict 'refs';
-
- return shift unless @_ > 1;
-
- use vars qw($a $b);
-
- my $caller = caller;
- local(*{$caller."::a"}) = \my $a;
- local(*{$caller."::b"}) = \my $b;
-
- $a = shift;
- foreach (@_) {
- $b = $_;
- $a = &{$code}();
- }
-
- $a;
-}
-
-sub first (&@) {
- my $code = shift;
- require Scalar::Util;
- my $type = Scalar::Util::reftype($code);
- unless($type and $type eq 'CODE') {
- require Carp;
- Carp::croak("Not a subroutine reference");
- }
-
- foreach (@_) {
- return $_ if &{$code}();
- }
-
- undef;
-}
-
-
-sub sum (@) { reduce { $a + $b } @_ }
-
-sub min (@) { reduce { $a < $b ? $a : $b } @_ }
-
-sub max (@) { reduce { $a > $b ? $a : $b } @_ }
-
-sub minstr (@) { reduce { $a lt $b ? $a : $b } @_ }
-
-sub maxstr (@) { reduce { $a gt $b ? $a : $b } @_ }
-
-sub shuffle (@) {
- my @a=\(@_);
- my $n;
- my $i=@_;
- map {
- $n = rand($i--);
- (${$a[$n]}, $a[$n] = $a[$i])[0];
- } @_;
-}
-
-1;
package List::Util::XS;
use strict;
-use vars qw($VERSION);
use List::Util;
-$VERSION = "1.23"; # FIXUP
+our $VERSION = "1.25"; # FIXUP
$VERSION = eval $VERSION; # FIXUP
-sub _VERSION { # FIXUP
- require Carp;
- Carp::croak("You need to install Scalar-List-Utils with a C compiler to ensure the XS is compiled")
- if defined $_[1];
- $VERSION;
-}
-
1;
__END__
During installation C<$List::Util::XS::VERSION> will be set to
C<undef> if the XS was not compiled.
+Starting with release 1.23_03, Scalar-List-Util is B<always> using
+the XS implementation, but for backwards compatibility, we still
+ship the C<List::Util::XS> module which just loads C<List::Util>.
+
=head1 SEE ALSO
L<Scalar::Util>, L<List::Util>, L<List::MoreUtils>
package Scalar::Util;
use strict;
-use vars qw(@ISA @EXPORT_OK $VERSION @EXPORT_FAIL);
require Exporter;
require List::Util; # List::Util loads the XS
-@ISA = qw(Exporter);
-@EXPORT_OK = qw(blessed dualvar reftype weaken isweak tainted readonly openhandle refaddr isvstring looks_like_number set_prototype);
-$VERSION = "1.23";
+our @ISA = qw(Exporter);
+our @EXPORT_OK = qw(blessed dualvar reftype weaken isweak tainted readonly openhandle refaddr isvstring looks_like_number set_prototype);
+our $VERSION = "1.25";
$VERSION = eval $VERSION;
-unless (defined &dualvar) {
- # Load Pure Perl version if XS not loaded
- require Scalar::Util::PP;
- Scalar::Util::PP->import;
- push @EXPORT_FAIL, qw(weaken isweak dualvar isvstring set_prototype);
+our @EXPORT_FAIL;
+
+unless (defined &weaken) {
+ push @EXPORT_FAIL, qw(weaken);
+}
+unless (defined &isweak) {
+ push @EXPORT_FAIL, qw(isweak isvstring);
+}
+unless (defined &isvstring) {
+ push @EXPORT_FAIL, qw(isvstring);
}
sub export_fail {
- if (grep { /dualvar/ } @EXPORT_FAIL) { # no XS loaded
- my $pat = join("|", @EXPORT_FAIL);
- if (my ($err) = grep { /^($pat)$/ } @_ ) {
- require Carp;
- Carp::croak("$err is only available with the XS version of Scalar::Util");
- }
- }
-
- if (grep { /^(weaken|isweak)$/ } @_ ) {
+ if (grep { /^(?:weaken|isweak)$/ } @_ ) {
require Carp;
Carp::croak("Weak references are not implemented in the version of perl");
}
- if (grep { /^(isvstring)$/ } @_ ) {
+ if (grep { /^isvstring$/ } @_ ) {
require Carp;
Carp::croak("Vstrings are not implemented in the version of perl");
}
@_;
}
-sub openhandle ($) {
- my $fh = shift;
- my $rt = reftype($fh) || '';
-
- return defined(fileno($fh)) ? $fh : undef
- if $rt eq 'IO';
-
- if (reftype(\$fh) eq 'GLOB') { # handle openhandle(*DATA)
- $fh = \(my $tmp=$fh);
- }
- elsif ($rt ne 'GLOB') {
- return undef;
- }
-
- (tied(*$fh) or defined(fileno($fh)))
- ? $fh : undef;
-}
-
1;
__END__
+++ /dev/null
-# Scalar::Util::PP.pm
-#
-# Copyright (c) 1997-2009 Graham Barr <gbarr@pobox.com>. All rights reserved.
-# This program is free software; you can redistribute it and/or
-# modify it under the same terms as Perl itself.
-#
-# This module is normally only loaded if the XS module is not available
-
-package Scalar::Util::PP;
-
-use strict;
-use warnings;
-use vars qw(@ISA @EXPORT $VERSION $recurse);
-require Exporter;
-use B qw(svref_2object);
-
-@ISA = qw(Exporter);
-@EXPORT = qw(blessed reftype tainted readonly refaddr looks_like_number);
-$VERSION = "1.23";
-$VERSION = eval $VERSION;
-
-sub blessed ($) {
- return undef unless length(ref($_[0]));
- my $b = svref_2object($_[0]);
- return undef unless $b->isa('B::PVMG');
- my $s = $b->SvSTASH;
- return $s->isa('B::HV') ? $s->NAME : undef;
-}
-
-sub refaddr($) {
- return undef unless length(ref($_[0]));
-
- my $addr;
- if(defined(my $pkg = blessed($_[0]))) {
- $addr .= bless $_[0], 'Scalar::Util::Fake';
- bless $_[0], $pkg;
- }
- else {
- $addr .= $_[0]
- }
-
- $addr =~ /0x(\w+)/;
- local $^W;
- no warnings 'portable';
- hex($1);
-}
-
-{
- my %tmap = qw(
- B::NULL SCALAR
-
- B::HV HASH
- B::AV ARRAY
- B::CV CODE
- B::IO IO
- B::GV GLOB
- B::REGEXP REGEXP
- );
-
- sub reftype ($) {
- my $r = shift;
-
- return undef unless length(ref($r));
-
- my $t = ref(svref_2object($r));
-
- return
- exists $tmap{$t} ? $tmap{$t}
- : length(ref($$r)) ? 'REF'
- : 'SCALAR';
- }
-}
-
-sub tainted {
- local($@, $SIG{__DIE__}, $SIG{__WARN__});
- local $^W = 0;
- no warnings;
- eval { kill 0 * $_[0] };
- $@ =~ /^Insecure/;
-}
-
-sub readonly {
- return 0 if tied($_[0]) || (ref(\($_[0])) ne "SCALAR");
-
- local($@, $SIG{__DIE__}, $SIG{__WARN__});
- my $tmp = $_[0];
-
- !eval { $_[0] = $tmp; 1 };
-}
-
-sub looks_like_number {
- local $_ = shift;
-
- # checks from perlfaq4
- return 0 if !defined($_);
- if (ref($_)) {
- require overload;
- return overload::Overloaded($_) ? defined(0 + $_) : 0;
- }
- return 1 if (/^[+-]?[0-9]+$/); # is a +/- integer
- return 1 if (/^([+-]?)(?=[0-9]|\.[0-9])[0-9]*(\.[0-9]*)?([Ee]([+-]?[0-9]+))?$/); # a C float
- return 1 if ($] >= 5.008 and /^(Inf(inity)?|NaN)$/i) or ($] >= 5.006001 and /^Inf$/i);
-
- 0;
-}
-
-
-1;
+++ /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 Test::More tests => 3;
-use strict;
-
-$List::Util::TESTING_PERL_ONLY = $List::Util::TESTING_PERL_ONLY = 1;
-require Scalar::Util;
-
-for my $func (qw(dualvar set_prototype weaken)) {
- eval { Scalar::Util->import($func); };
- like(
- $@,
- qr/$func is only available with the XS/,
- "no pure perl $func: error raised",
- );
-}
use List::Util qw(first);
use Test::More;
-plan tests => 19 + ($::PERL_ONLY ? 0 : 2);
+plan tests => 22 + ($::PERL_ONLY ? 0 : 2);
my $v;
ok(defined &first, 'defined');
} }
+use constant XSUBC_TRUE => 1;
+use constant XSUBC_FALSE => 0;
+
+is first(\&XSUBC_TRUE, 42, 1, 2, 3), 42, 'XSUB callbacks';
+is first(\&XSUBC_FALSE, 42, 1, 2, 3), undef, 'XSUB callbacks';
+
+
+eval { &first(1) };
+ok($@ =~ /^Not a subroutine reference/, 'check for code reference');
eval { &first(1,2) };
ok($@ =~ /^Not a subroutine reference/, 'check for code reference');
eval { &first(qw(a b)) };
--- /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 strict;
+use Scalar::Util qw(blessed reftype refaddr);
+use Test::More tests => 6;
+
+my $getmagic_count;
+
+{
+ package T;
+ use Tie::Scalar;
+ use base qw(Tie::StdScalar);
+
+ sub FETCH {
+ $getmagic_count++;
+ my($self) = @_;
+ return $self->SUPER::FETCH;
+ }
+}
+
+tie my $var, 'T';
+
+$var = bless {};
+
+$getmagic_count = 0;
+ok blessed($var);
+is $getmagic_count, 1, 'blessed';
+
+$getmagic_count = 0;
+ok reftype($var);
+is $getmagic_count, 1, 'reftype';
+
+$getmagic_count = 0;
+ok refaddr($var);
+is $getmagic_count, 1, 'refaddr';
}
use strict;
-use Test::More tests => 8;
+use Test::More tests => 10;
use List::Util qw(max);
my $v;
$v = max($thr,$two,$one);
is($v, 3, 'overload');
+
{ package Foo;
use overload
}
}
-SKIP: {
- eval { require bignum; } or skip("Need bignum for testing overloading",1);
+use Math::BigInt;
+
+my $v1 = Math::BigInt->new(2) ** Math::BigInt->new(65);
+my $v2 = $v1 - 1;
+my $v3 = $v2 - 1;
+$v = max($v1,$v2,$v1,$v3,$v1);
+is($v, $v1, 'bigint');
+
+$v = max($v1, 1, 2, 3);
+is($v, $v1, 'bigint and normal int');
+
+$v = max(1, 2, $v1, 3);
+is($v, $v1, 'bigint and normal int');
- my $v1 = 2**65;
- my $v2 = $v1 - 1;
- my $v3 = $v2 - 1;
- $v = max($v1,$v2,$v1,$v3,$v1);
- is($v, $v1, 'bigint');
-}
}
use strict;
-use Test::More tests => 8;
+use Test::More tests => 10;
use List::Util qw(min);
my $v;
}
}
-SKIP: {
- eval { require bignum; } or skip("Need bignum for testing overloading",1);
+use Math::BigInt;
+
+my $v1 = Math::BigInt->new(2) ** Math::BigInt->new(65);
+my $v2 = $v1 - 1;
+my $v3 = $v2 - 1;
+$v = min($v1,$v2,$v1,$v3,$v1);
+is($v, $v3, 'bigint');
+
+$v = min($v1, 1, 2, 3);
+is($v, 1, 'bigint and normal int');
+
+$v = min(1, 2, $v1, 3);
+is($v, 1, 'bigint and normal int');
- my $v1 = 2**65;
- my $v2 = $v1 - 1;
- my $v3 = $v2 - 1;
- $v = min($v1,$v2,$v1,$v3,$v1);
- is($v, $v3, 'bigint');
-}
use strict;
-use Test::More tests => 14;
+use Test::More tests => 21;
use Scalar::Util qw(openhandle);
ok(defined &openhandle, 'defined');
skip "3-arg open only on 5.6 or later", 1 if $]<5.006;
open my $fh, "<", $0;
- skip "could not open $0 for reading: $!", 1 unless $fh;
+ skip "could not open $0 for reading: $!", 2 unless $fh;
is(openhandle($fh), $fh, "works with indirect filehandles");
+ close($fh);
+ is(openhandle($fh), undef, "works with indirect filehandles");
}
SKIP: {
- skip "in-memory files only on 5.8 or later", 1 if $]<5.008;
+ skip "in-memory files only on 5.8 or later", 2 if $]<5.008;
open my $fh, "<", \"in-memory file";
- skip "could not open in-memory file: $!", 1 unless $fh;
+ skip "could not open in-memory file: $!", 2 unless $fh;
is(openhandle($fh), $fh, "works with in-memory files");
+ close($fh);
+ is(openhandle($fh), undef, "works with in-memory files");
}
ok(openhandle(\*DATA), "works for \*DATA");
{
require IO::Handle;
my $fh = IO::Handle->new_from_fd(fileno(*STDERR), 'w');
- skip "new_from_fd(fileno(*STDERR)) failed", 1 unless $fh;
+ skip "new_from_fd(fileno(*STDERR)) failed", 2 unless $fh;
ok(openhandle($fh), "works for IO::Handle objects");
ok(!openhandle(IO::Handle->new), "unopened IO::Handle");
require IO::File;
my $fh = IO::File->new;
$fh->open("< $0")
- or skip "could not open $0: $!", 1;
+ or skip "could not open $0: $!", 3;
ok(openhandle($fh), "works for IO::File objects");
+ close($fh);
+ ok(!openhandle($fh), "works for IO::File objects");
ok(!openhandle(IO::File->new), "unopened IO::File" );
}
SKIP: {
- skip( "Tied handles only on 5.8 or later", 1) if $]<5.008;
+ skip( "Tied handles only on 5.8 or later", 2) if $]<5.008;
use vars qw(*H);
package main;
tie *H, 'My::Tie';
ok(openhandle(*H), "tied handles are always ok");
+ ok(openhandle(\*H), "tied handle refs are always ok");
}
+ok !openhandle(undef), "undef is not a filehandle";
+ok !openhandle("STDIN"), "strings are not filehandles";
+ok !openhandle(0), "integers are not filehandles";
+
+
__DATA__
+++ /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 Test::More tests => 2;
-
-# force perl-only version to be tested
-$List::Util::TESTING_PERL_ONLY = $List::Util::TESTING_PERL_ONLY = 1;
-
-require Scalar::Util;
-require List::Util;
-
-is( $Scalar::Util::PP::VERSION, $List::Util::VERSION, "VERSION mismatch");
-is( $List::Util::PP::VERSION, $List::Util::VERSION, "VERSION mismatch");
-
+++ /dev/null
-#!./perl
-
-# force perl-only version to be tested
-$List::Util::TESTING_PERL_ONLY = $List::Util::TESTING_PERL_ONLY = 1;
-
-(my $f = __FILE__) =~ s/p_//;
-do $f; die $@ if $@;
+++ /dev/null
-#!./perl
-
-# force perl-only version to be tested
-$List::Util::TESTING_PERL_ONLY = $List::Util::TESTING_PERL_ONLY = 1;
-
-(my $f = __FILE__) =~ s/p_//;
-$::PERL_ONLY = $::PERL_ONLY = 1; # Mustn't use it only once!
-do $f; die $@ if $@;
+++ /dev/null
-#!./perl
-
-# force perl-only version to be tested
-$List::Util::TESTING_PERL_ONLY = $List::Util::TESTING_PERL_ONLY = 1;
-
-(my $f = __FILE__) =~ s/p_//;
-do $f; die $@ if $@;
+++ /dev/null
-#!./perl
-
-# force perl-only version to be tested
-$List::Util::TESTING_PERL_ONLY = $List::Util::TESTING_PERL_ONLY = 1;
-
-(my $f = __FILE__) =~ s/p_//;
-do $f; die $@ if $@;
+++ /dev/null
-#!./perl
-
-# force perl-only version to be tested
-$List::Util::TESTING_PERL_ONLY = $List::Util::TESTING_PERL_ONLY = 1;
-
-(my $f = __FILE__) =~ s/p_//;
-do $f; die $@ if $@;
+++ /dev/null
-#!./perl
-
-# force perl-only version to be tested
-$List::Util::TESTING_PERL_ONLY = $List::Util::TESTING_PERL_ONLY = 1;
-
-(my $f = __FILE__) =~ s/p_//;
-do $f; die $@ if $@;
+++ /dev/null
-#!./perl
-
-# force perl-only version to be tested
-$List::Util::TESTING_PERL_ONLY = $List::Util::TESTING_PERL_ONLY = 1;
-
-(my $f = __FILE__) =~ s/p_//;
-do $f; die $@ if $@;
+++ /dev/null
-#!./perl
-
-# force perl-only version to be tested
-$List::Util::TESTING_PERL_ONLY = $List::Util::TESTING_PERL_ONLY = 1;
-
-(my $f = __FILE__) =~ s/p_//;
-do $f; die $@ if $@;
+++ /dev/null
-#!./perl
-
-# force perl-only version to be tested
-$List::Util::TESTING_PERL_ONLY = $List::Util::TESTING_PERL_ONLY = 1;
-
-(my $f = __FILE__) =~ s/p_//;
-do $f; die $@ if $@;
+++ /dev/null
-#!./perl
-
-# force perl-only version to be tested
-$List::Util::TESTING_PERL_ONLY = $List::Util::TESTING_PERL_ONLY = 1;
-
-(my $f = __FILE__) =~ s/p_//;
-$::PERL_ONLY = $::PERL_ONLY = 1; # Mustn't use it only once!
-do $f; die $@ if $@;
+++ /dev/null
-#!./perl
-
-# force perl-only version to be tested
-$List::Util::TESTING_PERL_ONLY = $List::Util::TESTING_PERL_ONLY = 1;
-
-(my $f = __FILE__) =~ s/p_//;
-do $f; die $@ if $@;
+++ /dev/null
-#!./perl
-
-# force perl-only version to be tested
-$List::Util::TESTING_PERL_ONLY = $List::Util::TESTING_PERL_ONLY = 1;
-
-(my $f = __FILE__) =~ s/p_//;
-do $f; die $@ if $@;
+++ /dev/null
-#!./perl
-
-# force perl-only version to be tested
-$List::Util::TESTING_PERL_ONLY = $List::Util::TESTING_PERL_ONLY = 1;
-
-(my $f = __FILE__) =~ s/p_//;
-do $f; die $@ if $@;
+++ /dev/null
-#!./perl
-
-# force perl-only version to be tested
-$List::Util::TESTING_PERL_ONLY = $List::Util::TESTING_PERL_ONLY = 1;
-
-(my $f = __FILE__) =~ s/p_//;
-do $f; die $@ if $@;
+++ /dev/null
-#!./perl -T
-
-use File::Spec;
-
-# force perl-only version to be tested
-$List::Util::TESTING_PERL_ONLY = $List::Util::TESTING_PERL_ONLY = 1;
-
-(my $f = __FILE__) =~ s/p_//;
-my $filename = ($^O eq 'MSWin32' || $^O eq 'VMS')
- ? File::Spec->rel2abs(File::Spec->catfile(".", $f))
- : File::Spec->catfile(".", $f);
-do $filename; die $@ if $@;
use List::Util qw(reduce min);
use Test::More;
-plan tests => 27 + ($::PERL_ONLY ? 0 : 2);
+plan tests => 29 + ($::PERL_ONLY ? 0 : 2);
my $v = reduce {};
} }
+# XSUB callback
+use constant XSUBC => 42;
+
+is reduce(\&XSUBC, 1, 2, 3), 42, "xsub callbacks";
+
+eval { &reduce(1) };
+ok($@ =~ /^Not a subroutine reference/, 'check for code reference');
eval { &reduce(1,2) };
ok($@ =~ /^Not a subroutine reference/, 'check for code reference');
eval { &reduce(qw(a b)) };
}
}
-use Test::More tests => 29;
+use Test::More tests => 32;
use Scalar::Util qw(reftype);
use vars qw($t $y $x *F);
tie *F, 'MyTie';
my $RE = $] < 5.011 ? 'SCALAR' : 'REGEXP';
+my $s = []; # SvTYPE($s) is SVt_RV, and SvROK($s) is true
+$s = undef; # SvTYPE($s) is SVt_RV, but SvROK($s) is false
+
@test = (
[ undef, 1, 'number' ],
[ undef, 'A', 'string' ],
[ HASH => {}, 'HASH ref' ],
[ ARRAY => [], 'ARRAY ref' ],
[ SCALAR => \$t, 'SCALAR ref' ],
+ [ SCALAR => \$s, 'SCALAR ref (but SVt_RV)' ],
[ REF => \(\$t), 'REF ref' ],
[ GLOB => \*F, 'tied GLOB ref' ],
[ GLOB => gensym, 'GLOB ref' ],
}
}
-use Test::More tests => 8;
+use Test::More tests => 13;
use List::Util qw(sum);
}
}
-SKIP: {
- eval { require bignum; } or skip("Need bignum for testing overloading",1);
+use Math::BigInt;
+my $v1 = Math::BigInt->new(2) ** Math::BigInt->new(65);
+my $v2 = $v1 - 1;
+$v = sum($v1,$v2);
+is($v, $v1 + $v2, 'bigint');
- my $v1 = 2**65;
- my $v2 = 2**65;
- my $v3 = $v1 + $v2;
- $v = sum($v1,$v2);
- is($v, $v3, 'bignum');
+$v = sum(42, $v1);
+is($v, $v1 + 42, 'bigint + builtin int');
+
+$v = sum(42, $v1, 2);
+is($v, $v1 + 42 + 2, 'bigint + builtin int');
+
+{ package example;
+
+ use overload
+ '0+' => sub { $_[0][0] },
+ '""' => sub { my $r = "$_[0][0]"; $r = "+$r" unless $r =~ m/^\-/; $r .= " [$_[0][1]]"; $r },
+ fallback => 1;
+
+ sub new {
+ my $class = shift;
+
+ my $this = bless [@_], $class;
+
+ return $this;
+ }
+}
+
+{
+ my $e1 = example->new(7, "test");
+ $t = sum($e1, 7, 7);
+ is($t, 21, 'overload returning non-overload');
+ $t = sum(8, $e1, 8);
+ is($t, 23, 'overload returning non-overload');
+ $t = sum(9, 9, $e1);
+ is($t, 25, 'overload returning non-overload');
}
}
}
-use Test::More tests => 4;
+use Test::More tests => 5;
use Scalar::Util qw(tainted);
$var = $ENV{$key};
ok( tainted($var), 'copy of environment variable');
+
+{
+ package Tainted;
+ sub TIESCALAR { bless {} }
+ sub FETCH { $^X }
+}
+
+tie my $tiedvar, 'Tainted';
+ok( tainted($tiedvar), 'for magic variables');
cpan/DB_File
cpan/IPC-SysV
+cpan/List-Util
cpan/Time-HiRes
cpan/Win32API-File
dist/Cwd
Various warnings and error messages that mention variable names or values,
methods, etc.
+=item *
+
+L<Scalar::Util> has been upgraded from version 1.23 to version 1.25.
+
=back
One side effect of these changes is that blessing into "\0" no longer
https://perl5.git.perl.org / perl5.git / commitdiff