},
'Scalar::Util' => {
- 'DISTRIBUTION' => 'PEVANS/Scalar-List-Utils-1.51.tar.gz',
+ 'DISTRIBUTION' => 'PEVANS/Scalar-List-Utils-1.50.tar.gz',
'FILES' => q[cpan/Scalar-List-Utils],
},
/* clone the value so we don't invoke magic again */
arg = sv_mortalcopy(arg);
- if(SvOK(arg) && !(SvUOK(arg) || SvIOK(arg) || SvNOK(arg)))
- SvNV(arg); /* sets SVf_IOK/SVf_UOK if it's an integer */
-
- if(!SvOK(arg) || SvUOK(arg))
+ if(SvUOK(arg))
sv_setpvf(keysv, "%" UVuf, SvUV(arg));
else if(SvIOK(arg))
sv_setpvf(keysv, "%" IVdf, SvIV(arg));
else
- sv_setpvf(keysv, "%.15" NVgf, SvNV(arg));
+ sv_setpvf(keysv, "%" NVgf, SvNV(arg));
#ifdef HV_FETCH_EMPTY_HE
he = (HE*) hv_common(seen, NULL, SvPVX(keysv), SvCUR(keysv), 0, HV_FETCH_LVALUE | HV_FETCH_EMPTY_HE, NULL, 0);
if (HeVAL(he))
/* under debugger, provide information about sub location */
if (PL_DBsub && CvGV(cv)) {
HV* DBsub = GvHV(PL_DBsub);
- HE* old_data = NULL;
+ HE* old_data;
GV* oldgv = CvGV(cv);
HV* oldhv = GvSTASH(oldgv);
+ SV* old_full_name = sv_2mortal(newSVpvn_flags(HvNAME(oldhv), HvNAMELEN_get(oldhv), HvNAMEUTF8(oldhv) ? SVf_UTF8 : 0));
+ sv_catpvn(old_full_name, "::", 2);
+ sv_catpvn_flags(old_full_name, GvNAME(oldgv), GvNAMELEN(oldgv), GvNAMEUTF8(oldgv) ? SV_CATUTF8 : SV_CATBYTES);
- if (oldhv) {
- SV* old_full_name = sv_2mortal(newSVpvn_flags(HvNAME(oldhv), HvNAMELEN_get(oldhv), HvNAMEUTF8(oldhv) ? SVf_UTF8 : 0));
- sv_catpvn(old_full_name, "::", 2);
- sv_catpvn_flags(old_full_name, GvNAME(oldgv), GvNAMELEN(oldgv), GvNAMEUTF8(oldgv) ? SV_CATUTF8 : SV_CATBYTES);
-
- old_data = hv_fetch_ent(DBsub, old_full_name, 0, 0);
- }
+ old_data = hv_fetch_ent(DBsub, old_full_name, 0, 0);
if (old_data && HeVAL(old_data)) {
SV* new_full_name = sv_2mortal(newSVpvn_flags(HvNAME(stash), HvNAMELEN_get(stash), HvNAMEUTF8(stash) ? SVf_UTF8 : 0));
PREINIT:
CV *cv;
GV *gv;
- const char *stashname;
PPCODE:
if (!SvROK(code) && SvGMAGICAL(code))
mg_get(code);
if(!(gv = CvGV(cv)))
XSRETURN(0);
- if(GvSTASH(gv))
- stashname = HvNAME(GvSTASH(gv));
- else
- stashname = "__ANON__";
-
- mPUSHs(newSVpvf("%s::%s", stashname, GvNAME(gv)));
+ mPUSHs(newSVpvf("%s::%s", HvNAME(GvSTASH(gv)), GvNAME(gv)));
XSRETURN(1);
BOOT:
all any first min max minstr maxstr none notall product reduce sum sum0 shuffle uniq uniqnum uniqstr
head tail pairs unpairs pairkeys pairvalues pairmap pairgrep pairfirst
);
-our $VERSION = "1.51";
+our $VERSION = "1.50";
our $XS_VERSION = $VERSION;
-$VERSION =~ tr/_//d;
+$VERSION = eval $VERSION;
require XSLoader;
XSLoader::load('List::Util', $XS_VERSION);
# For objects returned by pairs()
sub List::Util::_Pair::key { shift->[0] }
sub List::Util::_Pair::value { shift->[1] }
-sub List::Util::_Pair::TO_JSON { [ @{+shift} ] }
=head1 NAME
...
}
-Since version C<1.51> they also have a C<TO_JSON> method to ease
-serialisation.
-
=head2 unpairs
my @kvlist = unpairs @pairs
my @values = head $size, @list;
-I<Since version 1.50.>
-
Returns the first C<$size> elements from C<@list>. If C<$size> is negative, returns
all but the last C<$size> elements from C<@list>.
my @values = tail $size, @list;
-I<Since version 1.50.>
-
Returns the last C<$size> elements from C<@list>. If C<$size> is negative, returns
all but the first C<$size> elements from C<@list>.
use warnings;
use List::Util;
-our $VERSION = "1.51"; # FIXUP
-$VERSION =~ tr/_//d; # FIXUP
+our $VERSION = "1.50"; # FIXUP
+$VERSION = eval $VERSION; # FIXUP
1;
__END__
dualvar isdual isvstring looks_like_number openhandle readonly set_prototype
tainted
);
-our $VERSION = "1.51";
-$VERSION =~ tr/_//d;
+our $VERSION = "1.50";
+$VERSION = eval $VERSION;
require List::Util; # List::Util loads the XS
List::Util->VERSION( $VERSION ); # Ensure we got the right XS version (RT#100863)
my $fh = openhandle( $fh );
-Returns C<$fh> itself, if C<$fh> may be used as a filehandle and is open, or if
-it is a tied handle. Otherwise C<undef> is returned.
+Returns C<$fh> itself if C<$fh> may be used as a filehandle and is open, or is
+is a tied handle. Otherwise C<undef> is returned.
$fh = openhandle(*STDIN); # \*STDIN
$fh = openhandle(\*STDIN); # \*STDIN
subname set_subname
);
-our $VERSION = "1.51";
-$VERSION =~ tr/_//d;
+our $VERSION = "1.50";
+$VERSION = eval $VERSION;
require List::Util; # as it has the XS
List::Util->VERSION( $VERSION ); # Ensure we got the right XS version (RT#100863)
Returns the name of the given C<$code> reference, if it has one. Normal named
subs will give a fully-qualified name consisting of the package and the
localname separated by C<::>. Anonymous code references will give C<__ANON__>
-as the localname. If the package the code was compiled in has been deleted
-(e.g. using C<delete_package> from L<Symbol>), C<__ANON__> will be returned as
-the package name. If a name has been set using L</set_subname>, this name will be
-returned instead.
+as the localname. If a name has been set using L</set_subname>, this name will
+be returned instead.
This function was inspired by C<sub_fullname> from L<Sub::Identify>. The
remaining functions that C<Sub::Identify> implements can easily be emulated
use strict;
use warnings;
-use Test::More tests => 29;
+use Test::More tests => 27;
use List::Util qw(pairgrep pairfirst pairmap pairs unpairs pairkeys pairvalues);
-use Scalar::Util qw(blessed);
no warnings 'misc'; # avoid "Odd number of elements" warnings most of the time
my @p = pairs one => 1, two => 2;
is( $p[0]->key, "one", 'pairs ->key' );
is( $p[0]->value, 1, 'pairs ->value' );
- is_deeply( $p[0]->TO_JSON,
- [ one => 1 ],
- 'pairs ->TO_JSON' );
- ok( !blessed($p[0]->TO_JSON) , 'pairs ->TO_JSON is not blessed' );
}
is_deeply( [ unpairs [ four => 4 ], [ five => 5 ], [ six => 6 ] ],
BEGIN { $^P |= 0x210 }
-use Test::More tests => 21;
+use Test::More tests => 18;
use B::Deparse;
use Sub::Util qw( subname set_subname );
-use Symbol qw( delete_package ) ;
{
sub localfunc {}
'subname of set_subname');
}
-# this used to segfault
-
-{
- sub ToDelete::foo {}
-
- my $foo = \&ToDelete::foo;
-
- delete_package 'ToDelete';
-
- is( subname($foo), "$]" >= 5.010 ? '__ANON__::foo' : 'ToDelete::foo', 'subname in deleted package' );
- ok( set_subname('NewPackage::foo', $foo), 'rename from deleted package' );
- is( subname($foo), 'NewPackage::foo', 'subname after rename' );
-}
-
# vim: ft=perl
use strict;
use warnings;
-use Test::More tests => 33;
+use Test::More tests => 30;
use List::Util qw( uniqnum uniqstr uniq );
use Tie::Array;
[ 1, 1.1, 1.2, 1.3 ],
'uniqnum distinguishes floats' );
-{
- my @nums = map $_+0.1, 1e7..1e7+5;
- is_deeply( [ uniqnum @nums ],
- [ @nums ],
- 'uniqnum distinguishes large floats' );
-
- my @strings = map "$_", @nums;
- is_deeply( [ uniqnum @strings ],
- [ @strings ],
- 'uniqnum distinguishes large floats (stringified)' );
-}
-
# Hard to know for sure what an Inf is going to be. Lets make one
my $Inf = 0 + 1E1000;
my $NaN;
[ 0, 1, 12345, $Inf, -$Inf, $NaN ],
'uniqnum preserves the special values of +-Inf and Nan' );
-SKIP: {
+{
my $maxuint = ~0;
my $maxint = ~0 >> 1;
my $minint = -(~0 >> 1) - 1;
is_deeply( [ uniqnum @nums, 1.0 ],
[ @nums ],
'uniqnum preserves uniqness of full integer range' );
-
- my @strs = map "$_", @nums;
-
- skip( "Perl $] doesn't stringify UV_MAX right ($maxuint)", 1 )
- if $maxuint !~ /\A[0-9]+\z/;
-
- is_deeply( [ uniqnum @strs, "1.0" ],
- [ @strs ],
- 'uniqnum preserves uniqness of full integer range (stringified)' );
}
{
https://perl5.git.perl.org / perl5.git / commitdiff