1#!./perl
2
3use strict;
4use warnings;
5
6use Test::More tests => 12;
7use Scalar::Util qw(blessed);
8
9my $t;
10
11ok(!defined blessed(undef), 'undef is not blessed');
12ok(!defined blessed(1),     'Numbers are not blessed');
13ok(!defined blessed('A'),   'Strings are not blessed');
14ok(!defined blessed({}),    'Unblessed HASH-ref');
15ok(!defined blessed([]),    'Unblessed ARRAY-ref');
16ok(!defined blessed(\$t),   'Unblessed SCALAR-ref');
17
18my $x;
19
20$x = bless [], "ABC";
21is(blessed($x), "ABC", 'blessed ARRAY-ref');
22
23$x = bless {}, "DEF";
24is(blessed($x), "DEF", 'blessed HASH-ref');
25
26$x = bless {}, "0";
27cmp_ok(blessed($x), "eq", "0", 'blessed HASH-ref');
28
29{
30  my $blessed = do {
31    my $depth;
32    no warnings 'redefine';
33    local *UNIVERSAL::can = sub { die "Burp!" if ++$depth > 2; blessed(shift) };
34    $x = bless {}, "DEF";
35    blessed($x);
36  };
37  is($blessed, "DEF", 'recursion of UNIVERSAL::can');
38}
39
40{
41  package Broken;
42  sub isa { die };
43  sub can { die };
44
45  my $obj = bless [], __PACKAGE__;
46  ::is( ::blessed($obj), __PACKAGE__, "blessed on broken isa() and can()" );
47}
48
49SKIP: {
50  # Unicode package names only supported in perl 5.16 onwards
51  skip "Unicode package names are not supported", 1 if $] < 5.016;
52
53  my $utf8_pack= "X\x{100}";
54  my $obj= bless {}, $utf8_pack;
55  ::is( ::blessed($obj), $utf8_pack, "blessed preserves utf8ness for utf8 class names" );
56}
57