diff options
Diffstat (limited to 'cpan/List-Util/t')
26 files changed, 164 insertions, 204 deletions
diff --git a/cpan/List-Util/t/expfail.t b/cpan/List-Util/t/expfail.t deleted file mode 100644 index 02fc192f14..0000000000 --- a/cpan/List-Util/t/expfail.t +++ /dev/null @@ -1,29 +0,0 @@ -#!./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", - ); -} diff --git a/cpan/List-Util/t/first.t b/cpan/List-Util/t/first.t index 1378c39044..497cdd5188 100644 --- a/cpan/List-Util/t/first.t +++ b/cpan/List-Util/t/first.t @@ -15,7 +15,7 @@ BEGIN { 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'); @@ -114,6 +114,15 @@ if (!$::PERL_ONLY) { SKIP: { } } +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)) }; diff --git a/cpan/List-Util/t/getmagic-once.t b/cpan/List-Util/t/getmagic-once.t new file mode 100644 index 0000000000..00b3490783 --- /dev/null +++ b/cpan/List-Util/t/getmagic-once.t @@ -0,0 +1,47 @@ +#!./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'; diff --git a/cpan/List-Util/t/max.t b/cpan/List-Util/t/max.t index aff916658f..9607015d83 100644 --- a/cpan/List-Util/t/max.t +++ b/cpan/List-Util/t/max.t @@ -14,7 +14,7 @@ BEGIN { } use strict; -use Test::More tests => 8; +use Test::More tests => 10; use List::Util qw(max); my $v; @@ -45,6 +45,7 @@ is($v, 3, 'overload'); $v = max($thr,$two,$one); is($v, 3, 'overload'); + { package Foo; use overload @@ -59,12 +60,17 @@ 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'); -} diff --git a/cpan/List-Util/t/min.t b/cpan/List-Util/t/min.t index 13d1116a6c..8d5be5e153 100644 --- a/cpan/List-Util/t/min.t +++ b/cpan/List-Util/t/min.t @@ -14,7 +14,7 @@ BEGIN { } use strict; -use Test::More tests => 8; +use Test::More tests => 10; use List::Util qw(min); my $v; @@ -59,12 +59,17 @@ 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 = 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'); -} diff --git a/cpan/List-Util/t/openhan.t b/cpan/List-Util/t/openhan.t index bf4e6c16f8..e0dffb6f53 100644 --- a/cpan/List-Util/t/openhan.t +++ b/cpan/List-Util/t/openhan.t @@ -15,7 +15,7 @@ BEGIN { use strict; -use Test::More tests => 14; +use Test::More tests => 21; use Scalar::Util qw(openhandle); ok(defined &openhandle, 'defined'); @@ -36,16 +36,20 @@ SKIP: { 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"); @@ -55,7 +59,7 @@ ok(openhandle(*DATA{IO}), "works for *DATA{IO}"); { 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"); @@ -65,14 +69,16 @@ ok(openhandle(*DATA{IO}), "works for *DATA{IO}"); 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); @@ -84,6 +90,12 @@ SKIP: { 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__ diff --git a/cpan/List-Util/t/p_00version.t b/cpan/List-Util/t/p_00version.t deleted file mode 100644 index 0b64f9eef3..0000000000 --- a/cpan/List-Util/t/p_00version.t +++ /dev/null @@ -1,26 +0,0 @@ -#!./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"); - diff --git a/cpan/List-Util/t/p_blessed.t b/cpan/List-Util/t/p_blessed.t deleted file mode 100644 index 48e7ef7dcd..0000000000 --- a/cpan/List-Util/t/p_blessed.t +++ /dev/null @@ -1,7 +0,0 @@ -#!./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 $@; diff --git a/cpan/List-Util/t/p_first.t b/cpan/List-Util/t/p_first.t deleted file mode 100644 index cd39ec44be..0000000000 --- a/cpan/List-Util/t/p_first.t +++ /dev/null @@ -1,8 +0,0 @@ -#!./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 $@; diff --git a/cpan/List-Util/t/p_lln.t b/cpan/List-Util/t/p_lln.t deleted file mode 100644 index 48e7ef7dcd..0000000000 --- a/cpan/List-Util/t/p_lln.t +++ /dev/null @@ -1,7 +0,0 @@ -#!./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 $@; diff --git a/cpan/List-Util/t/p_max.t b/cpan/List-Util/t/p_max.t deleted file mode 100644 index 48e7ef7dcd..0000000000 --- a/cpan/List-Util/t/p_max.t +++ /dev/null @@ -1,7 +0,0 @@ -#!./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 $@; diff --git a/cpan/List-Util/t/p_maxstr.t b/cpan/List-Util/t/p_maxstr.t deleted file mode 100644 index 48e7ef7dcd..0000000000 --- a/cpan/List-Util/t/p_maxstr.t +++ /dev/null @@ -1,7 +0,0 @@ -#!./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 $@; diff --git a/cpan/List-Util/t/p_min.t b/cpan/List-Util/t/p_min.t deleted file mode 100644 index 48e7ef7dcd..0000000000 --- a/cpan/List-Util/t/p_min.t +++ /dev/null @@ -1,7 +0,0 @@ -#!./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 $@; diff --git a/cpan/List-Util/t/p_minstr.t b/cpan/List-Util/t/p_minstr.t deleted file mode 100644 index 48e7ef7dcd..0000000000 --- a/cpan/List-Util/t/p_minstr.t +++ /dev/null @@ -1,7 +0,0 @@ -#!./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 $@; diff --git a/cpan/List-Util/t/p_openhan.t b/cpan/List-Util/t/p_openhan.t deleted file mode 100644 index 48e7ef7dcd..0000000000 --- a/cpan/List-Util/t/p_openhan.t +++ /dev/null @@ -1,7 +0,0 @@ -#!./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 $@; diff --git a/cpan/List-Util/t/p_readonly.t b/cpan/List-Util/t/p_readonly.t deleted file mode 100644 index 48e7ef7dcd..0000000000 --- a/cpan/List-Util/t/p_readonly.t +++ /dev/null @@ -1,7 +0,0 @@ -#!./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 $@; diff --git a/cpan/List-Util/t/p_reduce.t b/cpan/List-Util/t/p_reduce.t deleted file mode 100644 index cd39ec44be..0000000000 --- a/cpan/List-Util/t/p_reduce.t +++ /dev/null @@ -1,8 +0,0 @@ -#!./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 $@; diff --git a/cpan/List-Util/t/p_refaddr.t b/cpan/List-Util/t/p_refaddr.t deleted file mode 100644 index 48e7ef7dcd..0000000000 --- a/cpan/List-Util/t/p_refaddr.t +++ /dev/null @@ -1,7 +0,0 @@ -#!./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 $@; diff --git a/cpan/List-Util/t/p_reftype.t b/cpan/List-Util/t/p_reftype.t deleted file mode 100644 index 48e7ef7dcd..0000000000 --- a/cpan/List-Util/t/p_reftype.t +++ /dev/null @@ -1,7 +0,0 @@ -#!./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 $@; diff --git a/cpan/List-Util/t/p_shuffle.t b/cpan/List-Util/t/p_shuffle.t deleted file mode 100644 index 48e7ef7dcd..0000000000 --- a/cpan/List-Util/t/p_shuffle.t +++ /dev/null @@ -1,7 +0,0 @@ -#!./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 $@; diff --git a/cpan/List-Util/t/p_sum.t b/cpan/List-Util/t/p_sum.t deleted file mode 100644 index 48e7ef7dcd..0000000000 --- a/cpan/List-Util/t/p_sum.t +++ /dev/null @@ -1,7 +0,0 @@ -#!./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 $@; diff --git a/cpan/List-Util/t/p_tainted.t b/cpan/List-Util/t/p_tainted.t deleted file mode 100644 index 6a4cd22242..0000000000 --- a/cpan/List-Util/t/p_tainted.t +++ /dev/null @@ -1,12 +0,0 @@ -#!./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 $@; diff --git a/cpan/List-Util/t/reduce.t b/cpan/List-Util/t/reduce.t index 2e1257521c..4468ab8611 100644 --- a/cpan/List-Util/t/reduce.t +++ b/cpan/List-Util/t/reduce.t @@ -16,7 +16,7 @@ BEGIN { 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 {}; @@ -151,6 +151,13 @@ if (!$::PERL_ONLY) { SKIP: { } } +# 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)) }; diff --git a/cpan/List-Util/t/reftype.t b/cpan/List-Util/t/reftype.t index a7adafb996..31a5d3b841 100644 --- a/cpan/List-Util/t/reftype.t +++ b/cpan/List-Util/t/reftype.t @@ -13,7 +13,7 @@ BEGIN { } } -use Test::More tests => 29; +use Test::More tests => 32; use Scalar::Util qw(reftype); use vars qw($t $y $x *F); @@ -23,12 +23,16 @@ use Symbol qw(gensym); 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' ], diff --git a/cpan/List-Util/t/sum.t b/cpan/List-Util/t/sum.t index ef484f96c5..3615b4ab41 100644 --- a/cpan/List-Util/t/sum.t +++ b/cpan/List-Util/t/sum.t @@ -13,7 +13,7 @@ BEGIN { } } -use Test::More tests => 8; +use Test::More tests => 13; use List::Util qw(sum); @@ -58,12 +58,40 @@ 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; +$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'); } diff --git a/cpan/List-Util/t/tainted.t b/cpan/List-Util/t/tainted.t index 09ad330684..ab40aa69fe 100644 --- a/cpan/List-Util/t/tainted.t +++ b/cpan/List-Util/t/tainted.t @@ -16,7 +16,7 @@ BEGIN { } } -use Test::More tests => 4; +use Test::More tests => 5; use Scalar::Util qw(tainted); @@ -32,3 +32,12 @@ ok( tainted($ENV{$key}), 'environment variable'); $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'); |