1#!./perl 2 3BEGIN { 4 chdir 't' if -d 't'; 5 require './test.pl'; 6 set_up_inc('../lib'); 7 require Config; 8} 9 10use strict; 11use feature 'isa'; 12no warnings 'experimental::isa'; 13 14plan 11; 15 16package BaseClass {} 17package DerivedClass { our @ISA = qw(BaseClass) } 18package CustomClass { 19 sub isa { length($_[1]) == 9; } 20} 21 22my $baseobj = bless {}, "BaseClass"; 23my $derivedobj = bless {}, "DerivedClass"; 24my $customobj = bless {}, "CustomClass"; 25 26# Bareword package name 27ok($baseobj isa BaseClass, '$baseobj isa BaseClass'); 28ok(not($baseobj isa Another::Class), '$baseobj is not Another::Class'); 29 30# String package name 31ok($baseobj isa "BaseClass", '$baseobj isa BaseClass'); 32ok(not($baseobj isa "DerivedClass"), '$baseobj is not DerivedClass'); 33 34ok($derivedobj isa "DerivedClass", '$derivedobj isa DerivedClass'); 35ok($derivedobj isa "BaseClass", '$derivedobj isa BaseClass'); 36 37# Expression giving a package name 38my $classname = "DerivedClass"; 39ok($derivedobj isa $classname, '$derivedobj isa DerivedClass via SV'); 40 41# Invoked on instance which overrides ->isa 42ok($customobj isa "Something", '$customobj isa Something'); 43ok(not($customobj isa "SomethingElse"), '$customobj isa SomethingElse'); 44 45ok(not(undef isa "BaseClass"), 'undef is not BaseClass'); 46ok(not([] isa "BaseClass"), 'ARRAYref is not BaseClass'); 47 48# TODO: Consider 49# LHS = other class 50