12 my($object, $package, $type) = @_;
13 print "# $object $package $type\n";
14 is(ref($object), $package);
15 my $r = qr/^\Q$package\E=(\w+)\(0x([0-9a-f]+)\)$/;
19 # in 64-bit platforms hex warns for 32+ -bit values
20 cmp_ok(do {no warnings 'portable'; hex($2)}, '==', $object);
23 # test blessing simple types
26 expected($a1, "A", "HASH");
28 expected($b1, "B", "ARRAY");
29 $c1 = bless \(map "$_", "test"), "C";
30 expected($c1, "C", "SCALAR");
31 our $test = "foo"; $d1 = bless \*test, "D";
32 expected($d1, "D", "GLOB");
33 $e1 = bless sub { 1 }, "E";
34 expected($e1, "E", "CODE");
36 expected($f1, "F", "REF");
37 $g1 = bless \substr("test", 1, 2), "G";
38 expected($g1, "G", "LVALUE");
40 # blessing ref to object doesn't modify object
42 expected(bless(\$a1, "F"), "F", "REF");
43 expected($a1, "A", "HASH");
45 # reblessing does modify object
48 expected($a1, "A2", "HASH");
52 local $a1 = bless $a1, "A3"; # should rebless outer $a1
53 local $b1 = bless [], "B3";
54 my $c1 = bless $c1, "C3"; # should rebless outer $c1
55 our $test2 = ""; my $d1 = bless \*test2, "D3";
56 expected($a1, "A3", "HASH");
57 expected($b1, "B3", "ARRAY");
58 expected($c1, "C3", "SCALAR");
59 expected($d1, "D3", "GLOB");
61 expected($a1, "A3", "HASH");
62 expected($b1, "B", "ARRAY");
63 expected($c1, "C3", "SCALAR");
64 expected($d1, "D", "GLOB");
68 expected(bless({}, $1), "E", "HASH");
72 $! = 2; # attempt to avoid cached string
74 expected(bless({}, $!), $string, "HASH");
80 sub test { main::is(${$_[0]}, $string) }
90 ### example of magic variable that is a reference??
92 # no class, or empty string (with a warning), or undef (with two)
93 expected(bless([]), 'main', "ARRAY");
95 local $SIG{__WARN__} = sub { push @w, join '', @_ };
99 expected($m, 'main', "ARRAY");
104 expected($m, 'main', "ARRAY");
108 $m = bless [], undef;
109 expected($m, 'main', "ARRAY");
114 $a1 = bless {}, "A4";
115 $b1 = eval { bless {}, $a1 };
116 isnt ($@, '', "class is a ref");
118 # class is an overloaded ref
121 use overload '""' => sub { "C4" };
123 $h1 = bless {}, "H4";
124 $c4 = eval { bless \$test, $h1 };
125 is ($@, '', "class is an overloaded ref");
126 expected($c4, 'C4', "SCALAR");