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