t/safe_isa.t

   1 use strict;
   2 use warnings FATAL => 'all';
   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 $class = 'Bar';
  12 my $blam2 = '';
  13 my $undef;
  14
  15 # basic isa usage -
  16
  17 ok($foo->isa('Foo'), 'foo isa Foo');
  18 ok($bar->isa('Foo'), 'bar isa Foo');
  19 ok($class->isa('Foo'), 'class name isa Foo');
  20 ok(!eval { $blam->isa('Foo'); 1 }, 'blam goes blam with isa');
  21 ok(!eval { $blam2->isa('Foo'); 1 }, 'blam2 goes blam with isa');
  22 ok(!eval { $undef->isa('Foo'); 1 }, 'undef goes blam with isa');
  23
  24 ok(!$foo->can('bar'), 'foo !can bar');
  25 ok($bar->can('bar'), 'bar can bar');
  26 ok($class->can('bar'), 'our class name can bar');
  27 ok(!eval { $blam->can('bar'); 1 }, 'blam goes blam with can');
  28 ok(!eval { $blam2->can('bar'); 1 }, 'blam2 goes blam with can');
  29 ok(!eval { $undef->can('bar'); 1 }, 'undef goes blam with can');
  30
  31 use Safe::Isa;
  32
  33 ok($foo->$_isa('Foo'), 'foo $_isa Foo');
  34 ok($bar->$_isa('Foo'), 'bar $_isa Foo');
  35 ok($class->$_isa('Foo'), 'class name $_isa Foo');
  36 ok(eval { $blam->$_isa('Foo'); 1 }, 'no boom today with isa');
  37 ok(eval { $blam2->$_isa('Foo'); 1 }, 'no boom today with isa');
  38 ok(eval { $undef->$_isa('Foo'); 1 }, 'no boom today with isa');
  39
  40 ok(!$foo->$_can('bar'), 'foo !$_can bar');
  41 ok($bar->$_can('bar'), 'bar $_can bar');
  42 ok($class->$_can('bar'), 'class name $_can bar');
  43 ok(eval { $blam->$_can('bar'); 1 }, 'no boom today with can');
  44 ok(eval { $blam2->$_can('bar'); 1 }, 'no boom today with can');
  45 ok(eval { $undef->$_can('bar'); 1 }, 'no boom today with can');
  46
  47 ok($foo->$_call_if_object(isa => 'Foo'), 'foo $_call_if_object(isa => Foo)');
  48 ok($bar->$_call_if_object(isa => 'Foo'), 'bar $_call_if_object(isa => Foo)');
  49 ok(eval { $blam->$_call_if_object(isa => 'Foo'); 1 }, 'no boom today with _call_if_object');
  50
  51 ok($foo->$_call_if_object_or_classname(isa => 'Foo'), 'foo $_call_if_object_or_classname(isa => Foo)');
  52 ok($bar->$_call_if_object_or_classname(isa => 'Foo'), 'bar $_call_if_object_or_classname(isa => Foo)');
  53 ok($class->$_call_if_object_or_classname(isa => 'Foo'), 'class name $_call_if_object_or_classname(isa => Foo)');
  54 ok(eval { $blam->$_call_if_object_or_classname(isa => 'Foo'); 1 }, 'no boom today with _call_if_object_or_classname');
  55 ok(eval { $blam2->$_call_if_object_or_classname(isa => 'Foo'); 1 }, 'no boom today with _call_if_object_or_classname');
  56 ok(eval { $undef->$_call_if_object_or_classname(isa => 'Foo'); 1 }, 'no boom today with _call_if_object_or_classname');