xref: /openbsd-src/gnu/usr.bin/perl/t/op/isa.t (revision 256a93a44f36679bee503f12e49566c2183f6181)
1de8cc8edSafresh1#!./perl
2de8cc8edSafresh1
3de8cc8edSafresh1BEGIN {
4de8cc8edSafresh1    chdir 't' if -d 't';
5de8cc8edSafresh1    require './test.pl';
6de8cc8edSafresh1    set_up_inc('../lib');
7de8cc8edSafresh1    require Config;
8de8cc8edSafresh1}
9de8cc8edSafresh1
10de8cc8edSafresh1use strict;
11de8cc8edSafresh1use feature 'isa';
12de8cc8edSafresh1
13*256a93a4Safresh1plan 14;
14de8cc8edSafresh1
15de8cc8edSafresh1package BaseClass {}
16de8cc8edSafresh1package DerivedClass { our @ISA = qw(BaseClass) }
17de8cc8edSafresh1package CustomClass {
18de8cc8edSafresh1   sub isa { length($_[1]) == 9; }
19de8cc8edSafresh1}
20de8cc8edSafresh1
21de8cc8edSafresh1my $baseobj = bless {}, "BaseClass";
22de8cc8edSafresh1my $derivedobj = bless {}, "DerivedClass";
23de8cc8edSafresh1my $customobj = bless {}, "CustomClass";
24de8cc8edSafresh1
25de8cc8edSafresh1# Bareword package name
26de8cc8edSafresh1ok($baseobj isa BaseClass, '$baseobj isa BaseClass');
27de8cc8edSafresh1ok(not($baseobj isa Another::Class), '$baseobj is not Another::Class');
28de8cc8edSafresh1
29de8cc8edSafresh1# String package name
30de8cc8edSafresh1ok($baseobj isa "BaseClass",         '$baseobj isa BaseClass');
31de8cc8edSafresh1ok(not($baseobj isa "DerivedClass"), '$baseobj is not DerivedClass');
32de8cc8edSafresh1
33de8cc8edSafresh1ok($derivedobj isa "DerivedClass", '$derivedobj isa DerivedClass');
34de8cc8edSafresh1ok($derivedobj isa "BaseClass",    '$derivedobj isa BaseClass');
35de8cc8edSafresh1
36de8cc8edSafresh1# Expression giving a package name
37de8cc8edSafresh1my $classname = "DerivedClass";
38de8cc8edSafresh1ok($derivedobj isa $classname, '$derivedobj isa DerivedClass via SV');
39de8cc8edSafresh1
40de8cc8edSafresh1# Invoked on instance which overrides ->isa
41de8cc8edSafresh1ok($customobj isa "Something",          '$customobj isa Something');
42de8cc8edSafresh1ok(not($customobj isa "SomethingElse"), '$customobj isa SomethingElse');
43de8cc8edSafresh1
44de8cc8edSafresh1ok(not(undef isa "BaseClass"), 'undef is not BaseClass');
45de8cc8edSafresh1ok(not([] isa "BaseClass"),    'ARRAYref is not BaseClass');
46de8cc8edSafresh1
47*256a93a4Safresh1# Test that isa object method still works.
48*256a93a4Safresh1
49*256a93a4Safresh1ok($baseobj->isa('BaseClass'), '$baseobj isa BaseClass using object method');
50*256a93a4Safresh1ok(not($baseobj->isa('DerivedClass')), '$baseobj is not BaseClass using object method');
51*256a93a4Safresh1ok($derivedobj->isa('BaseClass'), '$derivedobj isa BaseClass using object method');
52*256a93a4Safresh1
53de8cc8edSafresh1# TODO: Consider
54de8cc8edSafresh1#    LHS = other class
55