cpan/List-Util/t/blessed.t

   1 #!./perl
   2
   3 BEGIN {
   4     unless (-d 'blib') {
   5         chdir 't' if -d 't';
   6         @INC = '../lib';
   7         require Config; import Config;
   8         keys %Config; # Silence warning
   9         if ($Config{extensions} !~ /\bList\/Util\b/) {
  10             print "1..0 # Skip: List::Util was not built\n";
  11             exit 0;
  12         }
  13     }
  14 }
  15
  16 use Test::More tests => 11;
  17 use Scalar::Util qw(blessed);
  18 use vars qw($t $x);
  19
  20 ok(!defined blessed(undef),     'undef is not blessed');
  21 ok(!defined blessed(1),         'Numbers are not blessed');
  22 ok(!defined blessed('A'),       'Strings are not blessed');
  23 ok(!defined blessed({}),        'Unblessed HASH-ref');
  24 ok(!defined blessed([]),        'Unblessed ARRAY-ref');
  25 ok(!defined blessed(\$t),       'Unblessed SCALAR-ref');
  26
  27 $x = bless [], "ABC";
  28 is(blessed($x), "ABC",  'blessed ARRAY-ref');
  29
  30 $x = bless {}, "DEF";
  31 is(blessed($x), "DEF",  'blessed HASH-ref');
  32
  33 $x = bless {}, "0";
  34 cmp_ok(blessed($x), "eq", "0",  'blessed HASH-ref');
  35
  36 {
  37   my $blessed = do {
  38     my $depth;
  39     no warnings 'redefine';
  40     local *UNIVERSAL::can = sub { die "Burp!" if ++$depth > 2; blessed(shift) };
  41     $x = bless {}, "DEF";
  42     blessed($x);
  43   };
  44   is($blessed, "DEF", 'recursion of UNIVERSAL::can');
  45 }
  46
  47 {
  48   package Broken;
  49   sub isa { die };
  50   sub can { die };
  51
  52   my $obj = bless [], __PACKAGE__;
  53   ::is( ::blessed($obj), __PACKAGE__, "blessed on broken isa() and can()" );
  54 }
  55