summaryrefslogtreecommitdiff
path: root/cpan/Scalar-List-Utils/t
diff options
context:
space:
mode:
authorSawyer X <xsawyerx@cpan.org>2020-06-01 10:05:08 +0300
committerSawyer X <xsawyerx@cpan.org>2020-06-02 08:37:38 +0300
commitcac6698e074af8daec0f7011cd77824d5d849d6f (patch)
tree998431f410400987dd463fb664ee703383cb750c /cpan/Scalar-List-Utils/t
parent3cee922e3a8cc2a8044e5d7e9ab4086a6aa4a478 (diff)
downloadperl-cac6698e074af8daec0f7011cd77824d5d849d6f.tar.gz
Update Scalar-List-Utils to 1.55
Diffstat (limited to 'cpan/Scalar-List-Utils/t')
-rw-r--r--cpan/Scalar-List-Utils/t/blessed.t18
-rw-r--r--cpan/Scalar-List-Utils/t/dualvar.t42
-rw-r--r--cpan/Scalar-List-Utils/t/exotic_names.t8
-rw-r--r--cpan/Scalar-List-Utils/t/first.t17
-rw-r--r--cpan/Scalar-List-Utils/t/isvstring.t10
-rw-r--r--cpan/Scalar-List-Utils/t/lln.t24
-rw-r--r--cpan/Scalar-List-Utils/t/readonly.t18
-rw-r--r--cpan/Scalar-List-Utils/t/reduce.t38
-rw-r--r--cpan/Scalar-List-Utils/t/reductions.t51
-rw-r--r--cpan/Scalar-List-Utils/t/refaddr.t29
-rw-r--r--cpan/Scalar-List-Utils/t/reftype.t24
-rw-r--r--cpan/Scalar-List-Utils/t/sample.t73
-rw-r--r--cpan/Scalar-List-Utils/t/scalarutil-proto.t30
-rw-r--r--cpan/Scalar-List-Utils/t/shuffle.t25
-rw-r--r--cpan/Scalar-List-Utils/t/sum.t2
-rw-r--r--cpan/Scalar-List-Utils/t/tainted.t4
-rw-r--r--cpan/Scalar-List-Utils/t/uniq.t119
-rw-r--r--cpan/Scalar-List-Utils/t/uniqnum.t329
-rw-r--r--cpan/Scalar-List-Utils/t/weak.t4
19 files changed, 652 insertions, 213 deletions
diff --git a/cpan/Scalar-List-Utils/t/blessed.t b/cpan/Scalar-List-Utils/t/blessed.t
index 2ae3679196..49eb355ffc 100644
--- a/cpan/Scalar-List-Utils/t/blessed.t
+++ b/cpan/Scalar-List-Utils/t/blessed.t
@@ -8,23 +8,23 @@ use Scalar::Util qw(blessed);
my $t;
-ok(!defined blessed(undef), 'undef is not blessed');
-ok(!defined blessed(1), 'Numbers are not blessed');
-ok(!defined blessed('A'), 'Strings are not blessed');
-ok(!defined blessed({}), 'Unblessed HASH-ref');
-ok(!defined blessed([]), 'Unblessed ARRAY-ref');
-ok(!defined blessed(\$t), 'Unblessed SCALAR-ref');
+ok(!defined blessed(undef), 'undef is not blessed');
+ok(!defined blessed(1), 'Numbers are not blessed');
+ok(!defined blessed('A'), 'Strings are not blessed');
+ok(!defined blessed({}), 'Unblessed HASH-ref');
+ok(!defined blessed([]), 'Unblessed ARRAY-ref');
+ok(!defined blessed(\$t), 'Unblessed SCALAR-ref');
my $x;
$x = bless [], "ABC";
-is(blessed($x), "ABC", 'blessed ARRAY-ref');
+is(blessed($x), "ABC", 'blessed ARRAY-ref');
$x = bless {}, "DEF";
-is(blessed($x), "DEF", 'blessed HASH-ref');
+is(blessed($x), "DEF", 'blessed HASH-ref');
$x = bless {}, "0";
-cmp_ok(blessed($x), "eq", "0", 'blessed HASH-ref');
+cmp_ok(blessed($x), "eq", "0", 'blessed HASH-ref');
{
my $blessed = do {
diff --git a/cpan/Scalar-List-Utils/t/dualvar.t b/cpan/Scalar-List-Utils/t/dualvar.t
index 08dff11778..bd77c969b5 100644
--- a/cpan/Scalar-List-Utils/t/dualvar.t
+++ b/cpan/Scalar-List-Utils/t/dualvar.t
@@ -5,8 +5,8 @@ use warnings;
use Scalar::Util ();
use Test::More (grep { /dualvar/ } @Scalar::Util::EXPORT_FAIL)
- ? (skip_all => 'dualvar requires XS version')
- : (tests => 41);
+ ? (skip_all => 'dualvar requires XS version')
+ : (tests => 41);
use Config;
Scalar::Util->import('dualvar');
@@ -15,44 +15,44 @@ Scalar::Util->import('isdual');
my $var;
$var = dualvar( 2.2,"string");
-ok( isdual($var), 'Is a dualvar');
-ok( $var == 2.2, 'Numeric value');
-ok( $var eq "string", 'String value');
+ok( isdual($var), 'Is a dualvar');
+ok( $var == 2.2, 'Numeric value');
+ok( $var eq "string", 'String value');
my $var2 = $var;
-ok( isdual($var2), 'Is a dualvar');
-ok( $var2 == 2.2, 'copy Numeric value');
-ok( $var2 eq "string", 'copy String value');
+ok( isdual($var2), 'Is a dualvar');
+ok( $var2 == 2.2, 'copy Numeric value');
+ok( $var2 eq "string", 'copy String value');
$var++;
-ok( ! isdual($var), 'No longer dualvar');
-ok( $var == 3.2, 'inc Numeric value');
-ok( $var ne "string", 'inc String value');
+ok( ! isdual($var), 'No longer dualvar');
+ok( $var == 3.2, 'inc Numeric value');
+ok( $var ne "string", 'inc String value');
my $numstr = "10.2";
my $numtmp = int($numstr); # use $numstr as an int
$var = dualvar($numstr, "");
-ok( isdual($var), 'Is a dualvar');
-ok( $var == $numstr, 'NV');
+ok( isdual($var), 'Is a dualvar');
+ok( $var == $numstr, 'NV');
SKIP: {
skip("dualvar with UV value known to fail with $]",3) if $] < 5.006_001;
my $bits = ($Config{'use64bitint'}) ? 63 : 31;
$var = dualvar(1<<$bits, "");
- ok( isdual($var), 'Is a dualvar');
- ok( $var == (1<<$bits), 'UV 1');
- ok( $var > 0, 'UV 2');
+ ok( isdual($var), 'Is a dualvar');
+ ok( $var == (1<<$bits), 'UV 1');
+ ok( $var > 0, 'UV 2');
}
# Create a dualvar "the old fashioned way"
$var = "10";
-ok( ! isdual($var), 'Not a dualvar');
+ok( ! isdual($var), 'Not a dualvar');
my $foo = $var + 0;
-ok( isdual($var), 'Is a dualvar');
+ok( isdual($var), 'Is a dualvar');
{
package Tied;
@@ -63,9 +63,9 @@ ok( isdual($var), 'Is a dualvar');
tie my $tied, 'Tied';
$var = dualvar($tied, "ok");
-ok(isdual($var), 'Is a dualvar');
-ok($var == 7.5, 'Tied num');
-ok($var eq 'ok', 'Tied str');
+ok(isdual($var), 'Is a dualvar');
+ok($var == 7.5, 'Tied num');
+ok($var eq 'ok', 'Tied str');
SKIP: {
diff --git a/cpan/Scalar-List-Utils/t/exotic_names.t b/cpan/Scalar-List-Utils/t/exotic_names.t
index cb5d2cc9f2..3c5f212325 100644
--- a/cpan/Scalar-List-Utils/t/exotic_names.t
+++ b/cpan/Scalar-List-Utils/t/exotic_names.t
@@ -13,10 +13,10 @@ BEGIN { $^P |= 0x210 }
use if $] >= 5.016, feature => 'unicode_eval';
if ($] >= 5.008) {
- my $builder = Test::More->builder;
- binmode $builder->output, ":encoding(utf8)";
- binmode $builder->failure_output, ":encoding(utf8)";
- binmode $builder->todo_output, ":encoding(utf8)";
+ my $builder = Test::More->builder;
+ binmode $builder->output, ":encoding(utf8)";
+ binmode $builder->failure_output, ":encoding(utf8)";
+ binmode $builder->todo_output, ":encoding(utf8)";
}
sub compile_named_sub {
diff --git a/cpan/Scalar-List-Utils/t/first.t b/cpan/Scalar-List-Utils/t/first.t
index ba7726ae56..3f008e703c 100644
--- a/cpan/Scalar-List-Utils/t/first.t
+++ b/cpan/Scalar-List-Utils/t/first.t
@@ -5,10 +5,10 @@ use warnings;
use List::Util qw(first);
use Test::More;
-plan tests => 22 + ($::PERL_ONLY ? 0 : 2);
+plan tests => 24;
my $v;
-ok(defined &first, 'defined');
+ok(defined &first, 'defined');
$v = first { 8 == ($_ - 1) } 9,4,5,6;
is($v, 9, 'one more than 8');
@@ -20,7 +20,7 @@ $v = first { 0 };
is($v, undef, 'no args');
$v = first { $_->[1] le "e" and "e" le $_->[2] }
- [qw(a b c)], [qw(d e f)], [qw(g h i)];
+ [qw(a b c)], [qw(d e f)], [qw(g h i)];
is_deeply($v, [qw(d e f)], 'reference args');
# Check that eval{} inside the block works correctly
@@ -89,11 +89,9 @@ SKIP: {
is(&Internals::SvREFCNT(\&huge), $refcnt, "Refcount unchanged");
}
-# The remainder of the tests are only relevant for the XS
-# implementation. The Perl-only implementation behaves differently
-# (and more flexibly) in a way that we can't emulate from XS.
-if (!$::PERL_ONLY) { SKIP: {
-
+# These tests are only relevant for the real multicall implementation. The
+# psuedo-multicall implementation behaves differently.
+SKIP: {
$List::Util::REAL_MULTICALL ||= 0; # Avoid use only once
skip("Poor man's MULTICALL can't cope", 2)
if !$List::Util::REAL_MULTICALL;
@@ -105,8 +103,7 @@ if (!$::PERL_ONLY) { SKIP: {
# Can we goto a subroutine?
eval {()=first{goto sub{}} 1,2;};
like($@, qr/^Can't goto subroutine from a sort sub/, "goto sub");
-
-} }
+}
use constant XSUBC_TRUE => 1;
use constant XSUBC_FALSE => 0;
diff --git a/cpan/Scalar-List-Utils/t/isvstring.t b/cpan/Scalar-List-Utils/t/isvstring.t
index 9d345aa26f..3649d41c59 100644
--- a/cpan/Scalar-List-Utils/t/isvstring.t
+++ b/cpan/Scalar-List-Utils/t/isvstring.t
@@ -6,18 +6,18 @@ use warnings;
$|=1;
use Scalar::Util ();
use Test::More (grep { /isvstring/ } @Scalar::Util::EXPORT_FAIL)
- ? (skip_all => 'isvstring requires XS version')
- : (tests => 3);
+ ? (skip_all => 'isvstring requires XS version')
+ : (tests => 3);
Scalar::Util->import(qw[isvstring]);
my $vs = ord("A") == 193 ? 241.75.240 : 49.46.48;
-ok( $vs == "1.0", 'dotted num');
-ok( isvstring($vs), 'isvstring');
+ok( $vs == "1.0", 'dotted num');
+ok( isvstring($vs), 'isvstring');
my $sv = "1.0";
-ok( !isvstring($sv), 'not isvstring');
+ok( !isvstring($sv), 'not isvstring');
diff --git a/cpan/Scalar-List-Utils/t/lln.t b/cpan/Scalar-List-Utils/t/lln.t
index df9ea3aea9..8458344671 100644
--- a/cpan/Scalar-List-Utils/t/lln.t
+++ b/cpan/Scalar-List-Utils/t/lln.t
@@ -10,18 +10,18 @@ foreach my $num (qw(1 -1 +1 1.0 +1.0 -1.0 -1.0e-12)) {
ok(looks_like_number($num), "'$num'");
}
-is(!!looks_like_number("Inf"), $] >= 5.006001, 'Inf');
-is(!!looks_like_number("Infinity"), $] >= 5.008, 'Infinity');
-is(!!looks_like_number("NaN"), $] >= 5.008, 'NaN');
-is(!!looks_like_number("foo"), '', 'foo');
-is(!!looks_like_number(undef), '', 'undef');
-is(!!looks_like_number({}), '', 'HASH Ref');
-is(!!looks_like_number([]), '', 'ARRAY Ref');
+is(!!looks_like_number("Inf"), $] >= 5.006001, 'Inf');
+is(!!looks_like_number("Infinity"), $] >= 5.008, 'Infinity');
+is(!!looks_like_number("NaN"), $] >= 5.008, 'NaN');
+is(!!looks_like_number("foo"), '', 'foo');
+is(!!looks_like_number(undef), '', 'undef');
+is(!!looks_like_number({}), '', 'HASH Ref');
+is(!!looks_like_number([]), '', 'ARRAY Ref');
use Math::BigInt;
my $bi = Math::BigInt->new('1234567890');
-is(!!looks_like_number($bi), 1, 'Math::BigInt');
-is(!!looks_like_number("$bi"), 1, 'Stringified Math::BigInt');
+is(!!looks_like_number($bi), 1, 'Math::BigInt');
+is(!!looks_like_number("$bi"), 1, 'Stringified Math::BigInt');
{ package Foo;
sub TIEHASH { bless {} }
@@ -29,9 +29,9 @@ sub FETCH { $_[1] }
}
my %foo;
tie %foo, 'Foo';
-is(!!looks_like_number($foo{'abc'}), '', 'Tied');
-is(!!looks_like_number($foo{'123'}), 1, 'Tied');
+is(!!looks_like_number($foo{'abc'}), '', 'Tied');
+is(!!looks_like_number($foo{'123'}), 1, 'Tied');
-is(!!looks_like_number("\x{1815}"), '', 'MONGOLIAN DIGIT FIVE');
+is(!!looks_like_number("\x{1815}"), '', 'MONGOLIAN DIGIT FIVE');
# We should copy some of perl core tests like t/base/num.t here
diff --git a/cpan/Scalar-List-Utils/t/readonly.t b/cpan/Scalar-List-Utils/t/readonly.t
index c8e19ff4c8..1333adeb4f 100644
--- a/cpan/Scalar-List-Utils/t/readonly.t
+++ b/cpan/Scalar-List-Utils/t/readonly.t
@@ -6,26 +6,26 @@ use warnings;
use Scalar::Util qw(readonly);
use Test::More tests => 11;
-ok( readonly(1), 'number constant');
+ok( readonly(1), 'number constant');
my $var = 2;
-ok( !readonly($var), 'number variable');
-is( $var, 2, 'no change to number variable');
+ok( !readonly($var), 'number variable');
+is( $var, 2, 'no change to number variable');
-ok( readonly("fred"), 'string constant');
+ok( readonly("fred"), 'string constant');
$var = "fred";
-ok( !readonly($var), 'string variable');
-is( $var, 'fred', 'no change to string variable');
+ok( !readonly($var), 'string variable');
+is( $var, 'fred', 'no change to string variable');
$var = \2;
-ok( !readonly($var), 'reference to constant');
-ok( readonly($$var), 'de-reference to constant');
+ok( !readonly($var), 'reference to constant');
+ok( readonly($$var), 'de-reference to constant');
-ok( !readonly(*STDOUT), 'glob');
+ok( !readonly(*STDOUT), 'glob');
sub try
{
diff --git a/cpan/Scalar-List-Utils/t/reduce.t b/cpan/Scalar-List-Utils/t/reduce.t
index 848c34fb22..67fdbaac22 100644
--- a/cpan/Scalar-List-Utils/t/reduce.t
+++ b/cpan/Scalar-List-Utils/t/reduce.t
@@ -5,25 +5,25 @@ use warnings;
use List::Util qw(reduce min);
use Test::More;
-plan tests => 30 + ($::PERL_ONLY ? 0 : 2);
+plan tests => 33;
my $v = reduce {};
-is( $v, undef, 'no args');
+is( $v, undef, 'no args');
$v = reduce { $a / $b } 756,3,7,4;
-is( $v, 9, '4-arg divide');
+is( $v, 9, '4-arg divide');
$v = reduce { $a / $b } 6;
-is( $v, 6, 'one arg');
+is( $v, 6, 'one arg');
my @a = map { rand } 0 .. 20;
$v = reduce { $a < $b ? $a : $b } @a;
-is( $v, min(@a), 'min');
+is( $v, min(@a), 'min');
@a = map { pack("C", int(rand(256))) } 0 .. 20;
$v = reduce { $a . $b } @a;
-is( $v, join("",@a), 'concat');
+is( $v, join("",@a), 'concat');
sub add {
my($aa, $bb) = @_;
@@ -31,26 +31,26 @@ sub add {
}
$v = reduce { my $t="$a $b\n"; 0+add($a, $b) } 3, 2, 1;
-is( $v, 6, 'call sub');
+is( $v, 6, 'call sub');
# Check that eval{} inside the block works correctly
$v = reduce { eval { die }; $a + $b } 0,1,2,3,4;
-is( $v, 10, 'use eval{}');
+is( $v, 10, 'use eval{}');
$v = !defined eval { reduce { die if $b > 2; $a + $b } 0,1,2,3,4 };
ok($v, 'die');
sub foobar { reduce { (defined(wantarray) && !wantarray) ? $a+1 : 0 } 0,1,2,3 }
($v) = foobar();
-is( $v, 3, 'scalar context');
+is( $v, 3, 'scalar context');
sub add2 { $a + $b }
$v = reduce \&add2, 1,2,3;
-is( $v, 6, 'sub reference');
+is( $v, 6, 'sub reference');
$v = reduce { add2() } 3,4,5;
-is( $v, 12, 'call sub');
+is( $v, 12, 'call sub');
$v = reduce { eval "$a + $b" } 1,2,3;
@@ -125,11 +125,9 @@ SKIP: {
is($ok, '', 'Not a subroutine reference');
}
-# The remainder of the tests are only relevant for the XS
-# implementation. The Perl-only implementation behaves differently
-# (and more flexibly) in a way that we can't emulate from XS.
-if (!$::PERL_ONLY) { SKIP: {
-
+# These tests are only relevant for the real multicall implementation. The
+# psuedo-multicall implementation behaves differently.
+SKIP: {
$List::Util::REAL_MULTICALL ||= 0; # Avoid use only once
skip("Poor man's MULTICALL can't cope", 2)
if !$List::Util::REAL_MULTICALL;
@@ -141,8 +139,12 @@ if (!$::PERL_ONLY) { SKIP: {
# Can we goto a subroutine?
eval {()=reduce{goto sub{}} 1,2;};
like($@, qr/^Can't goto subroutine from a sort sub/, "goto sub");
+}
-} }
+{
+ my @ret = reduce { $a + $b } 1 .. 5;
+ is_deeply( \@ret, [ 15 ], 'reduce in list context yields only final answer' );
+}
# XSUB callback
use constant XSUBC => 42;
@@ -162,4 +164,4 @@ ok($@ =~ /^Not a subroutine reference/, 'check for code reference');
my @names = ("a\x{100}c", "d\x{101}efgh", 'ijk');
my $longest = reduce { length($a) > length($b) ? $a : $b } @names;
-is( length($longest), 6, 'missing SMG rt#121992');
+is( length($longest), 6, 'missing SMG rt#121992');
diff --git a/cpan/Scalar-List-Utils/t/reductions.t b/cpan/Scalar-List-Utils/t/reductions.t
new file mode 100644
index 0000000000..fd669f14c7
--- /dev/null
+++ b/cpan/Scalar-List-Utils/t/reductions.t
@@ -0,0 +1,51 @@
+#!./perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 7;
+
+use List::Util qw( reductions );
+
+is_deeply( [ reductions { } ], [],
+ 'emmpty list'
+);
+
+is_deeply(
+ [ reductions { $a + $b } 1 .. 5 ],
+ [ 1, 3, 6, 10, 15 ],
+ 'sum 1..5'
+);
+
+# We don't guarantee what this will return but it definitely shouldn't crash
+{
+ my $ret = reductions { $a + $b } 1 .. 3;
+ pass( 'reductions in scalar context does not crash' );
+}
+
+my $destroyed_count;
+sub Guardian::DESTROY { $destroyed_count++ }
+
+{
+ undef $destroyed_count;
+
+ my @ret = reductions { $b } map { bless [], "Guardian" } 1 .. 5;
+
+ ok( !$destroyed_count, 'nothing destroyed yet' );
+
+ @ret = ();
+
+ is( $destroyed_count, 5, 'all the items were destroyed' );
+}
+
+{
+ undef $destroyed_count;
+
+ ok( !defined eval {
+ reductions { die "stop" if $b == 4; bless [], "Guardian" } 1 .. 4;
+ 1
+ }, 'die in BLOCK is propagated'
+ );
+
+ is( $destroyed_count, 2, 'intermediate temporaries are destroyed after exception' );
+}
diff --git a/cpan/Scalar-List-Utils/t/refaddr.t b/cpan/Scalar-List-Utils/t/refaddr.t
index 8d7c441bb3..91b6fa9ec6 100644
--- a/cpan/Scalar-List-Utils/t/refaddr.t
+++ b/cpan/Scalar-List-Utils/t/refaddr.t
@@ -64,9 +64,10 @@ foreach my $r ({}, \$t, [], \*F, sub {}) {
package FooBar;
-use overload '0+' => sub { 10 },
- '+' => sub { 10 + $_[1] },
- '""' => sub { "10" };
+use overload
+ '0+' => sub { 10 },
+ '+' => sub { 10 + $_[1] },
+ '""' => sub { "10" };
package MyTie;
@@ -85,21 +86,21 @@ use Scalar::Util qw(refaddr);
sub TIEHASH
{
- my $pkg = shift;
- return bless [ @_ ], $pkg;
+ my $pkg = shift;
+ return bless [ @_ ], $pkg;
}
sub FETCH
{
- my $self = shift;
- my $key = shift;
- my ($underlying) = @$self;
- return $underlying->{refaddr($key)};
+ my $self = shift;
+ my $key = shift;
+ my ($underlying) = @$self;
+ return $underlying->{refaddr($key)};
}
sub STORE
{
- my $self = shift;
- my $key = shift;
- my $value = shift;
- my ($underlying) = @$self;
- return ($underlying->{refaddr($key)} = $key);
+ my $self = shift;
+ my $key = shift;
+ my $value = shift;
+ my ($underlying) = @$self;
+ return ($underlying->{refaddr($key)} = $key);
}
diff --git a/cpan/Scalar-List-Utils/t/reftype.t b/cpan/Scalar-List-Utils/t/reftype.t
index a40e41493b..2fefd8fbef 100644
--- a/cpan/Scalar-List-Utils/t/reftype.t
+++ b/cpan/Scalar-List-Utils/t/reftype.t
@@ -18,18 +18,18 @@ $s = undef; # SvTYPE($s) is SVt_RV, but SvROK($s) is false
my $t;
my @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' ],
- [ CODE => sub {}, 'CODE ref' ],
- [ IO => *STDIN{IO},'IO ref' ],
- [ $RE => qr/x/, 'REGEEXP' ],
+ [ 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' ],
+ [ CODE => sub {}, 'CODE ref' ],
+ [ IO => *STDIN{IO}, 'IO ref' ],
+ [ $RE => qr/x/, 'REGEEXP' ],
);
foreach my $test (@test) {
diff --git a/cpan/Scalar-List-Utils/t/sample.t b/cpan/Scalar-List-Utils/t/sample.t
new file mode 100644
index 0000000000..0927571948
--- /dev/null
+++ b/cpan/Scalar-List-Utils/t/sample.t
@@ -0,0 +1,73 @@
+#!./perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 9;
+
+use List::Util qw(sample);
+
+{
+ my @items = sample 3, 1 .. 10;
+ is( scalar @items, 3, 'returns correct count when plentiful' );
+
+ @items = sample 10, 1 .. 10;
+ is( scalar @items, 10, 'returns correct count when exact' );
+
+ @items = sample 20, 1 .. 10;
+ is( scalar @items, 10, 'returns correct count when short' );
+}
+
+{
+ my @items = sample 5, 1 .. 5;
+ is_deeply( [ sort { $a <=> $b } @items ], [ 1 .. 5 ],
+ 'returns a permutation of the input list when exact' );
+}
+
+{
+ # These two seeds happen to give different results for me, but there is the
+ # smallest 1-in-2**48 chance that they happen to agree on some platform. If
+ # so then pick a different seed value.
+
+ srand 1234;
+ my $x = join "", sample 3, 'a'..'z';
+
+ srand 5678;
+ my $y = join "", sample 3, 'a'..'z';
+
+ isnt( $x, $y, 'returns different result on different random seed' );
+
+ srand;
+}
+
+{
+ my @nums = ( 1..5 );
+ sample 5, @nums;
+
+ is_deeply( \@nums, [ 1..5 ],
+ 'sample does not mutate passed array'
+ );
+}
+
+{
+ my $destroyed_count;
+ sub Guardian::DESTROY { $destroyed_count++ }
+
+ my @ret = sample 3, map { bless [], "Guardian" } 1 .. 10;
+
+ is( $destroyed_count, 7, 'the 7 unselected items were destroyed' );
+
+ @ret = ();
+
+ is( $destroyed_count, 10, 'all the items were destroyed' );
+}
+
+{
+ local $List::Util::RAND = sub { 4/10 };
+
+ is(
+ join( "", sample 5, 'A'..'Z' ),
+ join( "", sample 5, 'A'..'Z' ),
+ 'rigged rand() yields predictable output'
+ );
+}
diff --git a/cpan/Scalar-List-Utils/t/scalarutil-proto.t b/cpan/Scalar-List-Utils/t/scalarutil-proto.t
index e9b653a666..8d70a77cfd 100644
--- a/cpan/Scalar-List-Utils/t/scalarutil-proto.t
+++ b/cpan/Scalar-List-Utils/t/scalarutil-proto.t
@@ -5,48 +5,48 @@ use warnings;
use Scalar::Util ();
use Test::More (grep { /set_prototype/ } @Scalar::Util::EXPORT_FAIL)
- ? (skip_all => 'set_prototype requires XS version')
- : (tests => 14);
+ ? (skip_all => 'set_prototype requires XS version')
+ : (tests => 14);
Scalar::Util->import('set_prototype');
sub f { }
-is( prototype('f'), undef, 'no prototype');
+is( prototype('f'), undef, 'no prototype');
my $r = set_prototype(\&f,'$');
-is( prototype('f'), '$', 'set prototype');
-is( $r, \&f, 'return value');
+is( prototype('f'), '$', 'set prototype');
+is( $r, \&f, 'return value');
set_prototype(\&f,undef);
-is( prototype('f'), undef, 'remove prototype');
+is( prototype('f'), undef, 'remove prototype');
set_prototype(\&f,'');
-is( prototype('f'), '', 'empty prototype');
+is( prototype('f'), '', 'empty prototype');
sub g (@) { }
-is( prototype('g'), '@', '@ prototype');
+is( prototype('g'), '@', '@ prototype');
set_prototype(\&g,undef);
-is( prototype('g'), undef, 'remove prototype');
+is( prototype('g'), undef, 'remove prototype');
sub stub;
-is( prototype('stub'), undef, 'non existing sub');
+is( prototype('stub'), undef, 'non existing sub');
set_prototype(\&stub,'$$$');
-is( prototype('stub'), '$$$', 'change non existing sub');
+is( prototype('stub'), '$$$', 'change non existing sub');
sub f_decl ($$$$);
-is( prototype('f_decl'), '$$$$', 'forward declaration');
+is( prototype('f_decl'), '$$$$', 'forward declaration');
set_prototype(\&f_decl,'\%');
-is( prototype('f_decl'), '\%', 'change forward declaration');
+is( prototype('f_decl'), '\%', 'change forward declaration');
eval { &set_prototype( 'f', '' ); };
print "not " unless
-ok($@ =~ /^set_prototype: not a reference/, 'not a reference');
+ok($@ =~ /^set_prototype: not a reference/, 'not a reference');
eval { &set_prototype( \'f', '' ); };
-ok($@ =~ /^set_prototype: not a subroutine reference/, 'not a sub reference');
+ok($@ =~ /^set_prototype: not a subroutine reference/, 'not a sub reference');
# RT 72080
diff --git a/cpan/Scalar-List-Utils/t/shuffle.t b/cpan/Scalar-List-Utils/t/shuffle.t
index dff963715d..7135b5163c 100644
--- a/cpan/Scalar-List-Utils/t/shuffle.t
+++ b/cpan/Scalar-List-Utils/t/shuffle.t
@@ -3,24 +3,35 @@
use strict;
use warnings;
-use Test::More tests => 6;
+use Test::More tests => 7;
use List::Util qw(shuffle);
my @r;
@r = shuffle();
-ok( !@r, 'no args');
+ok( !@r, 'no args');
@r = shuffle(9);
-is( 0+@r, 1, '1 in 1 out');
-is( $r[0], 9, 'one arg');
+is( 0+@r, 1, '1 in 1 out');
+is( $r[0], 9, 'one arg');
my @in = 1..100;
@r = shuffle(@in);
-is( 0+@r, 0+@in, 'arg count');
+is( 0+@r, 0+@in, 'arg count');
-isnt( "@r", "@in", 'result different to args');
+isnt( "@r", "@in", 'result different to args');
my @s = sort { $a <=> $b } @r;
-is( "@in", "@s", 'values');
+is( "@in", "@s", 'values');
+
+{
+ local $List::Util::RAND = sub { 4/10 }; # chosen by a fair die
+
+ @r = shuffle(1..10);
+ is_deeply(
+ [ shuffle(1..10) ],
+ [ shuffle(1..10) ],
+ 'rigged rand() yields predictable output'
+ );
+}
diff --git a/cpan/Scalar-List-Utils/t/sum.t b/cpan/Scalar-List-Utils/t/sum.t
index e2c416df8c..5247a37b00 100644
--- a/cpan/Scalar-List-Utils/t/sum.t
+++ b/cpan/Scalar-List-Utils/t/sum.t
@@ -9,7 +9,7 @@ use Config;
use List::Util qw(sum);
my $v = sum;
-is( $v, undef, 'no args');
+is( $v, undef, 'no args');
$v = sum(9);
is( $v, 9, 'one arg');
diff --git a/cpan/Scalar-List-Utils/t/tainted.t b/cpan/Scalar-List-Utils/t/tainted.t
index fb83c86c32..1197b29586 100644
--- a/cpan/Scalar-List-Utils/t/tainted.t
+++ b/cpan/Scalar-List-Utils/t/tainted.t
@@ -13,10 +13,10 @@ my $var = 2;
ok( !tainted($var), 'known variable');
-ok( tainted($^X), 'interpreter variable');
+ok( tainted($^X), 'interpreter variable');
$var = $^X;
-ok( tainted($var), 'copy of interpreter variable');
+ok( tainted($var), 'copy of interpreter variable');
{
package Tainted;
diff --git a/cpan/Scalar-List-Utils/t/uniq.t b/cpan/Scalar-List-Utils/t/uniq.t
index 8e76f21b9b..c55f03a638 100644
--- a/cpan/Scalar-List-Utils/t/uniq.t
+++ b/cpan/Scalar-List-Utils/t/uniq.t
@@ -2,9 +2,9 @@
use strict;
use warnings;
-
-use Test::More tests => 33;
-use List::Util qw( uniqnum uniqstr uniq );
+use Config; # to determine ivsize
+use Test::More tests => 31;
+use List::Util qw( uniqstr uniqint uniq );
use Tie::Array;
@@ -67,69 +67,52 @@ SKIP: {
is( $warnings, "", 'No warnings are printed when handling Unicode strings' );
}
-is_deeply( [ uniqnum qw( 1 1.0 1E0 2 3 ) ],
- [ 1, 2, 3 ],
- 'uniqnum compares numbers' );
-
-is_deeply( [ uniqnum qw( 1 1.1 1.2 1.3 ) ],
- [ 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;
-$Inf **= 1000 while ( $NaN = $Inf - $Inf ) == $NaN;
-
-is_deeply( [ uniqnum 0, 1, 12345, $Inf, -$Inf, $NaN, 0, $Inf, $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;
-
- my @nums = ($maxuint, $maxuint-1, -1, $Inf, $NaN, $maxint, $minint, 1 );
-
- is_deeply( [ uniqnum @nums, 1.0 ],
- [ @nums ],
- 'uniqnum preserves uniqness of full integer range' );
+is_deeply( [ uniqint ],
+ [],
+ 'uniqint of empty list' );
- my @strs = map "$_", @nums;
+is_deeply( [ uniqint 5, 5 ],
+ [ 5 ],
+ 'uniqint of repeated-element list' );
- skip( "Perl $] doesn't stringify UV_MAX right ($maxuint)", 1 )
- if $maxuint !~ /\A[0-9]+\z/;
+is_deeply( [ uniqint 1, 2, 1, 3 ],
+ [ 1, 2, 3 ],
+ 'uniqint removes subsequent duplicates' );
- is_deeply( [ uniqnum @strs, "1.0" ],
- [ @strs ],
- 'uniqnum preserves uniqness of full integer range (stringified)' );
-}
+is_deeply( [ uniqint 6.1, 6.2, 6.3 ],
+ [ 6 ],
+ 'uniqint compares as and returns integers' );
{
my $warnings = "";
local $SIG{__WARN__} = sub { $warnings .= join "", @_ };
- is_deeply( [ uniqnum 0, undef ],
+ is_deeply( [ uniqint 0, undef ],
[ 0 ],
- 'uniqnum considers undef and zero equivalent' );
+ 'uniqint considers undef and zero equivalent' );
- ok( length $warnings, 'uniqnum on undef yields a warning' );
+ ok( length $warnings, 'uniqint on undef yields a warning' );
- is_deeply( [ uniqnum undef ],
+ is_deeply( [ uniqint undef ],
[ 0 ],
- 'uniqnum on undef coerces to zero' );
+ 'uniqint on undef coerces to zero' );
+}
+
+SKIP: {
+ skip('UVs are not reliable on this perl version', 2) unless $] ge "5.008000";
+
+ my $maxbits = $Config{ivsize} * 8 - 1;
+
+ # An integer guaranteed to be a UV
+ my $uv = 1 << $maxbits;
+ is_deeply( [ uniqint $uv, $uv + 1 ],
+ [ $uv, $uv + 1 ],
+ 'uniqint copes with UVs' );
+
+ my $nvuv = 2 ** $maxbits;
+ is_deeply( [ uniqint $nvuv, 0 ],
+ [ int($nvuv), 0 ],
+ 'uniqint copes with NVUV dualvars' );
}
is_deeply( [ uniq () ],
@@ -169,24 +152,21 @@ is( scalar( uniqstr qw( a b c d a b e ) ), 5, 'uniqstr() in scalar context' );
'uniqstr respects stringify overload' );
}
-{
- package Numify;
+SKIP: {
+ skip('int overload requires perl version 5.8.0', 1) unless $] ge "5.008000";
- use overload '0+' => sub { return $_[0]->{num} };
+ package Googol;
- sub new { bless { num => $_[1] }, $_[0] }
+ use overload '""' => sub { "1" . ( "0"x100 ) },
+ 'int' => sub { $_[0] };
- package main;
- use Scalar::Util qw( refaddr );
+ sub new { bless {}, $_[0] }
- my @nums = map { Numify->new( $_ ) } qw( 2 2 5 );
+ package main;
- # is_deeply wants to use eq overloading
- my @ret = uniqnum @nums;
- ok( scalar @ret == 2 &&
- refaddr $ret[0] == refaddr $nums[0] &&
- refaddr $ret[1] == refaddr $nums[2],
- 'uniqnum respects numify overload' );
+ is_deeply( [ uniqint( Googol->new, Googol->new ) ],
+ [ "1" . ( "0"x100 ) ],
+ 'uniqint respects int overload' );
}
{
@@ -219,11 +199,6 @@ is( scalar( uniqstr qw( a b c d a b e ) ), 5, 'uniqstr() in scalar context' );
is_deeply( [ uniqstr $1, $2, $3 ],
[qw( a b )],
'uniqstr handles magic' );
-
- "1 1 2" =~ m/(.) (.) (.)/;
- is_deeply( [ uniqnum $1, $2, $3 ],
- [ 1, 2 ],
- 'uniqnum handles magic' );
}
{
diff --git a/cpan/Scalar-List-Utils/t/uniqnum.t b/cpan/Scalar-List-Utils/t/uniqnum.t
new file mode 100644
index 0000000000..d34d2c7747
--- /dev/null
+++ b/cpan/Scalar-List-Utils/t/uniqnum.t
@@ -0,0 +1,329 @@
+#!./perl
+
+use strict;
+use warnings;
+use Config; # to determine nvsize
+use Test::More tests => 23;
+use List::Util qw( uniqnum );
+
+is_deeply( [ uniqnum qw( 1 1.0 1E0 2 3 ) ],
+ [ 1, 2, 3 ],
+ 'uniqnum compares numbers' );
+
+is_deeply( [ uniqnum qw( 1 1.1 1.2 1.3 ) ],
+ [ 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)' );
+}
+
+my ($uniq_count1, $uniq_count2, $equiv);
+
+if($Config{nvsize} == 8) {
+ # NV is either 'double' or 8-byte 'long double'
+
+ # The 2 values should be unequal - but just in case perl is buggy:
+ $equiv = 1 if 1.4142135623730951 == 1.4142135623730954;
+
+ $uniq_count1 = uniqnum (1.4142135623730951,
+ 1.4142135623730954 );
+
+ $uniq_count2 = uniqnum('1.4142135623730951',
+ '1.4142135623730954' );
+}
+
+elsif(length(sqrt(2)) > 25) {
+ # NV is either IEEE 'long double' or '__float128' or doubledouble
+
+ if(1 + (2 ** -1074) != 1) {
+ # NV is doubledouble
+
+ # The 2 values should be unequal - but just in case perl is buggy:
+ $equiv = 1 if 1 + (2 ** -1074) == 1 + (2 ** - 1073);
+
+ $uniq_count1 = uniqnum (1 + (2 ** -1074),
+ 1 + (2 ** -1073) );
+ # The 2 values should be unequal - but just in case perl is buggy:
+ $equiv = 1 if 4.0564819207303340847894502572035e31 == 4.0564819207303340847894502572034e31;
+
+ $uniq_count2 = uniqnum('4.0564819207303340847894502572035e31',
+ '4.0564819207303340847894502572034e31' );
+ }
+
+ else {
+ # NV is either IEEE 'long double' or '__float128'
+
+ # The 2 values should be unequal - but just in case perl is buggy:
+ $equiv = 1 if 1005.10228292019306452029161597769015 == 1005.1022829201930645202916159776901;
+
+ $uniq_count1 = uniqnum (1005.10228292019306452029161597769015,
+ 1005.1022829201930645202916159776901 );
+
+ $uniq_count2 = uniqnum('1005.10228292019306452029161597769015',
+ '1005.1022829201930645202916159776901' );
+ }
+}
+
+else {
+ # NV is extended precision 'long double'
+
+ # The 2 values should be unequal - but just in case perl is buggy:
+ $equiv = 1 if 10.770329614269008063 == 10.7703296142690080625;
+
+ $uniq_count1 = uniqnum (10.770329614269008063,
+ 10.7703296142690080625 );
+
+ $uniq_count2 = uniqnum('10.770329614269008063',
+ '10.7703296142690080625' );
+}
+
+if($equiv) {
+ is($uniq_count1, 1, 'uniqnum preserves uniqueness of high precision floats');
+ is($uniq_count2, 1, 'uniqnum preserves uniqueness of high precision floats (stringified)');
+}
+
+else {
+ is($uniq_count1, 2, 'uniqnum preserves uniqueness of high precision floats');
+ is($uniq_count2, 2, 'uniqnum preserves uniqueness of high precision floats (stringified)');
+}
+
+SKIP: {
+ skip ('test not relevant for this perl configuration', 1) unless $Config{nvsize} == 8
+ && $Config{ivsize} == 8;
+
+ my @in = (~0, ~0 - 1, 18446744073709551614.0, 18014398509481985, 1.8014398509481985e16);
+ my(@correct);
+
+ # On perl-5.6.2 (and perhaps other old versions), ~0 - 1 is assigned to an NV.
+ # This affects the outcome of the following test, so we need to first determine
+ # whether ~0 - 1 is an NV or a UV:
+
+ if("$in[1]" eq "1.84467440737096e+19") {
+
+ # It's an NV and $in[2] is a duplicate of $in[1]
+ @correct = (~0, ~0 - 1, 18014398509481985, 1.8014398509481985e16);
+ }
+ else {
+
+ # No duplicates in @in
+ @correct = @in;
+ }
+
+ is_deeply( [ uniqnum @in ],
+ [ @correct ],
+ 'uniqnum correctly compares UV/IVs that overflow NVs' );
+}
+
+my $ls = 31; # maximum left shift for 32-bit unity
+
+if( $Config{ivsize} == 8 ) {
+ $ls = 63; # maximum left shift for 64-bit unity
+}
+
+# Populate @in with UV-NV pairs of equivalent values.
+# Each of these values is exactly representable as
+# either a UV or an NV.
+
+my @in = (1 << $ls, 2 ** $ls,
+ 1 << ($ls - 3), 2 ** ($ls - 3),
+ 5 << ($ls - 3), 5 * (2 ** ($ls - 3)));
+
+my @correct = (1 << $ls, 1 << ($ls - 3), 5 << ($ls -3));
+
+if( $Config{ivsize} == 8 && $Config{nvsize} == 8 ) {
+
+ # Add some more UV-NV pairs of equivalent values.
+ # Each of these values is exactly representable
+ # as either a UV or an NV.
+
+ push @in, ( 9007199254740991, 9.007199254740991e+15,
+ 9007199254740992, 9.007199254740992e+15,
+ 9223372036854774784, 9.223372036854774784e+18,
+ 18446744073709549568, 1.8446744073709549568e+19,
+ 18446744073709139968, 1.8446744073709139968e+19,
+ 100000000000262144, 1.00000000000262144e+17,
+ 100000000001310720, 1.0000000000131072e+17,
+ 144115188075593728, 1.44115188075593728e+17,
+ -9007199254740991, -9.007199254740991e+15,
+ -9007199254740992, -9.007199254740992e+15,
+ -9223372036854774784, -9.223372036854774784e+18,
+ -18446744073709549568, -1.8446744073709549568e+19,
+ -18446744073709139968, -1.8446744073709139968e+19,
+ -100000000000262144, -1.00000000000262144e+17,
+ -100000000001310720, -1.0000000000131072e+17,
+ -144115188075593728, -1.44115188075593728e+17 );
+
+ push @correct, ( 9007199254740991,
+ 9007199254740992,
+ 9223372036854774784,
+ 18446744073709549568,
+ 18446744073709139968,
+ 100000000000262144,
+ 100000000001310720,
+ 144115188075593728,
+ -9007199254740991,
+ -9007199254740992,
+ -9223372036854774784,
+ -18446744073709549568,
+ -18446744073709139968,
+ -100000000000262144,
+ -100000000001310720,
+ -144115188075593728 );
+}
+
+# uniqnum should discard each of the NVs as being a
+# duplicate of the preceding UV.
+
+is_deeply( [ uniqnum @in],
+ [ @correct],
+ 'uniqnum correctly compares UV/IVs that don\'t overflow NVs' );
+
+# Hard to know for sure what an Inf is going to be. Lets make one
+my $Inf = 0 + 1E1000;
+my $NaN;
+$Inf **= 1000 while ( $NaN = $Inf - $Inf ) == $NaN;
+
+is_deeply( [ uniqnum 0, 1, 12345, $Inf, -$Inf, $NaN, 0, $Inf, $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;
+
+ my @nums = ($maxuint, $maxuint-1, -1, $maxint, $minint, 1 );
+
+ {
+ use warnings FATAL => 'numeric';
+ if (eval {
+ "$Inf" + 0 == $Inf
+ }) {
+ push @nums, $Inf;
+ }
+ if (eval {
+ my $nanish = "$NaN" + 0;
+ $nanish != 0 && !$nanish != $NaN;
+ }) {
+ push @nums, $NaN;
+ }
+ }
+
+ is_deeply( [ uniqnum @nums, 1.0 ],
+ [ @nums ],
+ 'uniqnum preserves uniqueness of full integer range' );
+
+ my @strs = map "$_", @nums;
+
+ if($maxuint !~ /\A[0-9]+\z/) {
+ skip( "Perl $] doesn't stringify UV_MAX right ($maxuint)", 1 );
+ }
+
+ is_deeply( [ uniqnum @strs, "1.0" ],
+ [ @strs ],
+ 'uniqnum preserves uniqueness of full integer range (stringified)' );
+}
+
+{
+ my @nums = (6.82132005170133e-38, 62345678);
+ is_deeply( [ uniqnum @nums ], [ @nums ],
+ 'uniqnum keeps uniqueness of numbers that stringify to the same byte pattern as a float'
+ );
+}
+
+{
+ my $warnings = "";
+ local $SIG{__WARN__} = sub { $warnings .= join "", @_ };
+
+ is_deeply( [ uniqnum 0, undef ],
+ [ 0 ],
+ 'uniqnum considers undef and zero equivalent' );
+
+ ok( length $warnings, 'uniqnum on undef yields a warning' );
+
+ is_deeply( [ uniqnum undef ],
+ [ 0 ],
+ 'uniqnum on undef coerces to zero' );
+}
+
+is_deeply( [uniqnum 0, -0.0 ],
+ [0],
+ 'uniqnum handles negative zero');
+
+SKIP: {
+ skip ('test not relevant for this perl configuration', 4) unless $Config{ivsize} == 8;
+
+ # 1e17 is the number beyond which "%.20g" formatting fails on some
+ # 64-bit int perls.
+ # The following 2 tests check that the nearest values (both above
+ # and below that tipping point) are being handled correctly.
+
+ # 99999999999999984 is the largest 64-bit integer less than 1e17
+ # that can be expressed exactly as a double
+
+ is_deeply( [ uniqnum (99999999999999984, 99999999999999984.0) ],
+ [ (99999999999999984) ],
+ 'uniqnum recognizes 99999999999999984 and 99999999999999984.0 as the same' );
+
+ is_deeply( [ uniqnum (-99999999999999984, -99999999999999984.0) ],
+ [ (-99999999999999984) ],
+ 'uniqnum recognizes -99999999999999984 and -99999999999999984.0 as the same' );
+
+ # 100000000000000016 is the smallest positive 64-bit integer greater than 1e17
+ # that can be expressed exactly as a double
+
+ is_deeply( [ uniqnum (100000000000000016, 100000000000000016.0) ],
+ [ (100000000000000016) ],
+ 'uniqnum recognizes 100000000000000016 and 100000000000000016.0 as the same' );
+
+ is_deeply( [ uniqnum (-100000000000000016, -100000000000000016.0) ],
+ [ (-100000000000000016) ],
+ 'uniqnum recognizes -100000000000000016 and -100000000000000016.0 as the same' );
+}
+
+# uniqnum not confused by IV'ified floats
+SKIP: {
+ # This fails on 5.6 and isn't fixable without breaking a lot of other tests
+ skip 'This perl version gets confused by IVNV dualvars', 1 if $] lt '5.008000';
+ my @nums = ( 2.1, 2.2, 2.3 );
+ my $dummy = sprintf "%d", $_ for @nums;
+
+ # All @nums now have both NOK and IOK but IV=2 in each case
+ is( scalar( uniqnum @nums ), 3, 'uniqnum not confused by dual IV+NV' );
+}
+
+{
+ package Numify;
+
+ use overload '0+' => sub { return $_[0]->{num} };
+
+ sub new { bless { num => $_[1] }, $_[0] }
+
+ package main;
+ use Scalar::Util qw( refaddr );
+
+ my @nums = map { Numify->new( $_ ) } qw( 2 2 5 );
+
+ # is_deeply wants to use eq overloading
+ my @ret = uniqnum @nums;
+ ok( scalar @ret == 2 &&
+ refaddr $ret[0] == refaddr $nums[0] &&
+ refaddr $ret[1] == refaddr $nums[2],
+ 'uniqnum respects numify overload' );
+}
+
+{
+ "1 1 2" =~ m/(.) (.) (.)/;
+ is_deeply( [ uniqnum $1, $2, $3 ],
+ [ 1, 2 ],
+ 'uniqnum handles magic' );
+}
diff --git a/cpan/Scalar-List-Utils/t/weak.t b/cpan/Scalar-List-Utils/t/weak.t
index 86ded9794f..39a4167cd6 100644
--- a/cpan/Scalar-List-Utils/t/weak.t
+++ b/cpan/Scalar-List-Utils/t/weak.t
@@ -7,8 +7,8 @@ use Config;
use Scalar::Util ();
use Test::More ((grep { /weaken/ } @Scalar::Util::EXPORT_FAIL) and !$ENV{PERL_CORE})
- ? (skip_all => 'weaken requires XS version')
- : (tests => 28);
+ ? (skip_all => 'weaken requires XS version')
+ : (tests => 28);
Scalar::Util->import(qw(weaken unweaken isweak));