mirror of
https://github.com/Perl/perl5.git
synced 2026-01-26 08:38:23 +00:00
938df7bd54
Somewhere along the way we stopped testing test.pl itself. This fixes that oversight, and repairs the tests to accomodate some of the changes that should have been noticed. This includes hardening the tests for Win32, which does not allow unlinking a file that is open.
68 lines
1.5 KiB
Perl
68 lines
1.5 KiB
Perl
#!/usr/bin/env perl -w
|
|
|
|
# Test isa_ok() and can_ok() in test.pl
|
|
|
|
use strict;
|
|
use warnings;
|
|
|
|
BEGIN {
|
|
chdir 't' if -d 't';
|
|
push @INC, ".";
|
|
require 'test.pl';
|
|
}
|
|
|
|
require Test::More;
|
|
|
|
can_ok('Test::More', qw(require_ok use_ok ok is isnt like skip can_ok
|
|
pass fail eq_array eq_hash eq_set));
|
|
can_ok(bless({}, "Test::More"), qw(require_ok use_ok ok is isnt like skip
|
|
can_ok pass fail eq_array eq_hash eq_set));
|
|
|
|
|
|
isa_ok(bless([], "Foo"), "Foo");
|
|
isa_ok([], 'ARRAY');
|
|
isa_ok(\42, 'SCALAR');
|
|
{
|
|
local %Bar::;
|
|
local @Foo::ISA = 'Bar';
|
|
isa_ok( "Foo", "Bar" );
|
|
}
|
|
|
|
|
|
# can_ok() & isa_ok should call can() & isa() on the given object, not
|
|
# just class, in case of custom can()
|
|
{
|
|
local *Foo::can;
|
|
local *Foo::isa;
|
|
*Foo::can = sub { $_[0]->[0] };
|
|
*Foo::isa = sub { $_[0]->[0] };
|
|
my $foo = bless([0], 'Foo');
|
|
ok( ! $foo->can('bar') );
|
|
ok( ! $foo->isa('bar') );
|
|
$foo->[0] = 1;
|
|
can_ok( $foo, 'blah');
|
|
isa_ok( $foo, 'blah');
|
|
}
|
|
|
|
|
|
note "object/class_ok"; {
|
|
{
|
|
package Child;
|
|
our @ISA = qw(Parent);
|
|
}
|
|
|
|
{
|
|
package Parent;
|
|
sub new { bless {}, shift }
|
|
}
|
|
|
|
# Unfortunately we can't usefully test the failure case without
|
|
# significantly modifying test.pl
|
|
class_ok "Child", "Parent";
|
|
class_ok "Parent", "Parent";
|
|
object_ok( Parent->new, "Parent" );
|
|
object_ok( Child->new, "Parent" );
|
|
}
|
|
|
|
done_testing;
|