t/safe_isa.t

   1 use strict;
   2 use warnings;
   3 use Test::More tests => 28;
   4
   5 { package Foo; sub new { bless({}, $_[0]) } }
   6 { package Bar; our @ISA = qw(Foo); sub bar { $_[1] } }
   7
   8 my $foo = Foo->new;
   9 my $bar = Bar->new;
  10 my $blam = [ 42 ];
  11 my $undef;
  12
  13 # basic isa usage -
  14
  15 ok($foo->isa('Foo'), 'foo isa Foo');
  16 ok($bar->isa('Foo'), 'bar isa Foo');
  17 ok(!eval { $blam->isa('Foo'); 1 }, 'blam goes blam');
  18 ok(!eval { $undef->isa('Foo'); 1 }, 'undef goes poof');
  19
  20
  21 ok(!$foo->can('bar'), 'foo !can bar');
  22 ok($bar->can('bar'), 'bar can bar');
  23 ok(!eval { $blam->can('bar'); 1 }, 'blam goes blam');
  24 ok(!eval { $undef->can('bar'); 1 }, 'undef goes poof');
  25
  26 use Safe::Isa;
  27
  28 ok($foo->$_isa('Foo'), 'foo $_isa Foo');
  29 ok($bar->$_isa('Foo'), 'bar $_isa Foo');
  30 ok(eval { is($blam->$_isa('Foo'), undef, 'blam isn\'t Foo'); 1 }, 'no boom today');
  31 ok(eval { is($undef->$_isa('Foo'), undef, 'undef isn\'t Foo either'); 1 }, 'and no boom tomorrow either');
  32
  33 ok(!$foo->$_can('bar'), 'foo !$_can bar');
  34 ok($bar->$_can('bar'), 'bar $_can bar');
  35 ok(eval { is($blam->$_can('bar'), undef, 'blam can\'t bar'); 1 }, 'no boom today');
  36 ok(eval { is($undef->$_can('bar'), undef, 'undef can\'t bar either'); 1 }, 'and no boom tomorrow either');
  37
  38 ok($foo->$_call_if_object(isa => 'Foo'), 'foo $_call_if_object(isa => Foo)');
  39 ok($bar->$_call_if_object(isa => 'Foo'), 'bar $_call_if_object(isa => Foo)');
  40 is($bar->$_call_if_object(bar => ), undef, 'bar $_call_if_object(bar => undef)');
  41 is($bar->$_call_if_object(bar => 2), 2, 'bar $_call_if_object(bar => 2)');
  42 ok(eval { is($blam->$_call_if_object(isa => 'Foo'), undef, 'blam can\'t call anything'); 1 }, 'no boom today');
  43 ok(eval { is($undef->$_call_if_object(isa => 'Foo'), undef, 'undef can\'t call anything'); 1 }, 'and no boom tomorrow either');