t/safe_isa.t

   1 use strict;
   2 use warnings FATAL => 'all';
   3 use Test::More tests => 15;
   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
  12 # basic isa usage -
  13
  14 ok($foo->isa('Foo'), 'foo isa Foo');
  15 ok($bar->isa('Foo'), 'bar isa Foo');
  16 ok(!eval { $blam->isa('Foo'); 1 }, 'blam goes blam');
  17
  18 ok(!$foo->can('bar'), 'foo !can bar');
  19 ok($bar->can('bar'), 'bar can bar');
  20 ok(!eval { $blam->can('bar'); 1 }, 'blam goes blam');
  21
  22 use Safe::Isa;
  23
  24 ok($foo->$_isa('Foo'), 'foo $_isa Foo');
  25 ok($bar->$_isa('Foo'), 'bar $_isa Foo');
  26 ok(eval { $blam->$_isa('Foo'); 1 }, 'no boom today');
  27
  28 ok(!$foo->$_can('bar'), 'foo !$_can bar');
  29 ok($bar->$_can('bar'), 'bar $_can bar');
  30 ok(eval { $blam->$_can('bar'); 1 }, 'no boom today');
  31
  32 ok($foo->$_call_if_object(isa => 'Foo'), 'foo $_call_if_object(isa => Foo)');
  33 ok($bar->$_call_if_object(isa => 'Foo'), 'bar $_call_if_object(isa => Foo)');
  34 ok(eval { $blam->$_call_if_object(isa => 'Foo'); 1 }, 'no boom today');