Commit | Line | Data |
---|---|---|
b8ab4b0c MS |
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 | ||
bbce3ca6 | 8 | BEGIN { require "test.pl"; } |
b8ab4b0c MS |
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 | ||
bbce3ca6 MS |
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 | ||
b8ab4b0c | 63 | done_testing; |