t/safe_isa.t

   1 use strict;
   2 use warnings FATAL => 'all';
   3 use Test::More tests => 20;
   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 { $blam->$_isa('Foo'); 1 }, 'no boom today');
  31 ok(eval { $undef->$_isa('Foo'); 1 }, 'nor tomorrow either');
  32
  33 ok(!$foo->$_can('bar'), 'foo !$_can bar');
  34 ok($bar->$_can('bar'), 'bar $_can bar');
  35 ok(eval { $blam->$_can('bar'); 1 }, 'no boom today');
  36 ok(eval { $undef->$_can('bar'); 1 }, 'nor 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 ok(eval { $blam->$_call_if_object(isa => 'Foo'); 1 }, 'no boom today');
  41 ok(eval { $undef->$_call_if_object(isa => 'Foo'); 1 }, 'nor tomorrow either');