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
CommitLineData
b8ab4b0c
MS
1#!/usr/bin/env perl -w
2
3# Test isa_ok() and can_ok() in test.pl
4
5use strict;
6use warnings;
7
bbce3ca6 8BEGIN { require "test.pl"; }
b8ab4b0c
MS
9
10require Test::More;
11
12can_ok('Test::More', qw(require_ok use_ok ok is isnt like skip can_ok
13 pass fail eq_array eq_hash eq_set));
14can_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
18isa_ok(bless([], "Foo"), "Foo");
19isa_ok([], 'ARRAY');
20isa_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
44note "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 63done_testing;