t/safe_does.t

   1 use strict;
   2 use warnings;
   3 use Test::More tests => 14;
   4
   5 { package Foo; sub new { bless({}, $_[0]) } }
   6 { package Bar; our @ISA = qw(Foo); sub bar { 1 } sub does { $_[0]->isa($_[1]) } }
   7
   8 my $foo = Foo->new;
   9 my $bar = Bar->new;
  10 my $blam = [ 42 ];
  11 my $undef;
  12
  13 # basic does, DOES usage -
  14 # on perls >= 5.10.0, DOES falls back to isa.
  15 # does must always be manually provided
  16
  17 if (UNIVERSAL->can('DOES')) {
  18   ok($foo->DOES('Foo'), 'foo DOES Foo');
  19   ok($bar->DOES('Foo'), 'bar DOES Foo');
  20 }
  21 else {
  22   ok(!eval { $foo->DOES('Foo') }, 'DOES not available in UNIVERSAL');
  23   ok(!eval { $bar->DOES('Foo') }, 'DOES not available in UNIVERSAL');
  24 }
  25
  26 ok(!eval { $foo->does('Foo') }, 'does not implemented on Foo');
  27 ok($bar->does('Foo'), 'bar does Foo');
  28 ok(!eval { $blam->DOES('Foo'); 1 }, 'blam goes blam');
  29 ok(!eval { $undef->DOES('Foo'); 1 }, 'undef goes poof');
  30
  31
  32 use Safe::Isa;
  33
  34 ok($foo->$_DOES('Foo'), 'foo $_DOES Foo');
  35 ok($bar->$_DOES('Foo'), 'bar $_DOES Foo');
  36 ok(eval { $blam->$_DOES('Foo'); 1 }, 'no boom today');
  37 ok(eval { $undef->$_DOES('Foo'); 1 }, 'nor tomorrow either');
  38
  39
  40 ok($foo->$_call_if_object(DOES => 'Foo'), 'foo $_call_if_object(DOES => Foo)');
  41 ok($bar->$_call_if_object(DOES => 'Foo'), 'bar $_call_if_object(DOES => Foo)');
  42 ok(eval { $blam->$_call_if_object(DOES => 'Foo'); 1 }, 'no boom today');
  43 ok(eval { $undef->$_call_if_object(DOES => 'Foo'); 1 }, 'nor tomorrow either');
  44