diff options
author | Sawyer X <xsawyerx@cpan.org> | 2020-06-01 10:05:08 +0300 |
---|---|---|
committer | Sawyer X <xsawyerx@cpan.org> | 2020-06-02 08:37:38 +0300 |
commit | cac6698e074af8daec0f7011cd77824d5d849d6f (patch) | |
tree | 998431f410400987dd463fb664ee703383cb750c /cpan/Scalar-List-Utils/t | |
parent | 3cee922e3a8cc2a8044e5d7e9ab4086a6aa4a478 (diff) | |
download | perl-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.t | 18 | ||||
-rw-r--r-- | cpan/Scalar-List-Utils/t/dualvar.t | 42 | ||||
-rw-r--r-- | cpan/Scalar-List-Utils/t/exotic_names.t | 8 | ||||
-rw-r--r-- | cpan/Scalar-List-Utils/t/first.t | 17 | ||||
-rw-r--r-- | cpan/Scalar-List-Utils/t/isvstring.t | 10 | ||||
-rw-r--r-- | cpan/Scalar-List-Utils/t/lln.t | 24 | ||||
-rw-r--r-- | cpan/Scalar-List-Utils/t/readonly.t | 18 | ||||
-rw-r--r-- | cpan/Scalar-List-Utils/t/reduce.t | 38 | ||||
-rw-r--r-- | cpan/Scalar-List-Utils/t/reductions.t | 51 | ||||
-rw-r--r-- | cpan/Scalar-List-Utils/t/refaddr.t | 29 | ||||
-rw-r--r-- | cpan/Scalar-List-Utils/t/reftype.t | 24 | ||||
-rw-r--r-- | cpan/Scalar-List-Utils/t/sample.t | 73 | ||||
-rw-r--r-- | cpan/Scalar-List-Utils/t/scalarutil-proto.t | 30 | ||||
-rw-r--r-- | cpan/Scalar-List-Utils/t/shuffle.t | 25 | ||||
-rw-r--r-- | cpan/Scalar-List-Utils/t/sum.t | 2 | ||||
-rw-r--r-- | cpan/Scalar-List-Utils/t/tainted.t | 4 | ||||
-rw-r--r-- | cpan/Scalar-List-Utils/t/uniq.t | 119 | ||||
-rw-r--r-- | cpan/Scalar-List-Utils/t/uniqnum.t | 329 | ||||
-rw-r--r-- | cpan/Scalar-List-Utils/t/weak.t | 4 |
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)); |