This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
perldelta - move split change to other perlfunc changes and add issue link
[perl5.git] / t / test_pl / can_isa_ok.t
1 #!/usr/bin/env perl -w
2
3 # Test isa_ok() and can_ok() in test.pl
4
5 use strict;
6 use warnings;
7
8 BEGIN { require "test.pl"; }
9
10 require Test::More;
11
12 can_ok('Test::More', qw(require_ok use_ok ok is isnt like skip can_ok
13                         pass fail eq_array eq_hash eq_set));
14 can_ok(bless({}, "Test::More"), qw(require_ok use_ok ok is isnt like skip 
15                                    can_ok pass fail eq_array eq_hash eq_set));
16
17
18 isa_ok(bless([], "Foo"), "Foo");
19 isa_ok([], 'ARRAY');
20 isa_ok(\42, 'SCALAR');
21 {
22     local %Bar::;
23     local @Foo::ISA = 'Bar';
24     isa_ok( "Foo", "Bar" );
25 }
26
27
28 # can_ok() & isa_ok should call can() & isa() on the given object, not 
29 # just class, in case of custom can()
30 {
31        local *Foo::can;
32        local *Foo::isa;
33        *Foo::can = sub { $_[0]->[0] };
34        *Foo::isa = sub { $_[0]->[0] };
35        my $foo = bless([0], 'Foo');
36        ok( ! $foo->can('bar') );
37        ok( ! $foo->isa('bar') );
38        $foo->[0] = 1;
39        can_ok( $foo, 'blah');
40        isa_ok( $foo, 'blah');
41 }
42
43
44 note "object/class_ok"; {
45     {
46         package Child;
47         our @ISA = qw(Parent);
48     }
49
50     {
51         package Parent;
52         sub new { bless {}, shift }
53     }
54
55     # Unfortunately we can't usefully test the failure case without
56     # significantly modifying test.pl
57     class_ok "Child", "Parent";
58     class_ok "Parent", "Parent";
59     object_ok( Parent->new, "Parent" );
60     object_ok( Child->new, "Parent" );
61 }
62
63 done_testing;