1*0Sstevel@tonic-gate#!./perl 2*0Sstevel@tonic-gate 3*0Sstevel@tonic-gateprint "1..31\n"; 4*0Sstevel@tonic-gate 5*0Sstevel@tonic-gateBEGIN { 6*0Sstevel@tonic-gate chdir 't' if -d 't'; 7*0Sstevel@tonic-gate @INC = '../lib'; 8*0Sstevel@tonic-gate} 9*0Sstevel@tonic-gate 10*0Sstevel@tonic-gatesub expected { 11*0Sstevel@tonic-gate my($object, $package, $type) = @_; 12*0Sstevel@tonic-gate return "" if ( 13*0Sstevel@tonic-gate ref($object) eq $package 14*0Sstevel@tonic-gate && "$object" =~ /^\Q$package\E=(\w+)\(0x([0-9a-f]+)\)$/ 15*0Sstevel@tonic-gate && $1 eq $type 16*0Sstevel@tonic-gate # in 64-bit platforms hex warns for 32+ -bit values 17*0Sstevel@tonic-gate && do { no warnings 'portable'; hex($2) == $object } 18*0Sstevel@tonic-gate ); 19*0Sstevel@tonic-gate print "# $object $package $type\n"; 20*0Sstevel@tonic-gate return "not "; 21*0Sstevel@tonic-gate} 22*0Sstevel@tonic-gate 23*0Sstevel@tonic-gate# test blessing simple types 24*0Sstevel@tonic-gate 25*0Sstevel@tonic-gate$a1 = bless {}, "A"; 26*0Sstevel@tonic-gateprint expected($a1, "A", "HASH"), "ok 1\n"; 27*0Sstevel@tonic-gate$b1 = bless [], "B"; 28*0Sstevel@tonic-gateprint expected($b1, "B", "ARRAY"), "ok 2\n"; 29*0Sstevel@tonic-gate$c1 = bless \(map "$_", "test"), "C"; 30*0Sstevel@tonic-gateprint expected($c1, "C", "SCALAR"), "ok 3\n"; 31*0Sstevel@tonic-gateour $test = "foo"; $d1 = bless \*test, "D"; 32*0Sstevel@tonic-gateprint expected($d1, "D", "GLOB"), "ok 4\n"; 33*0Sstevel@tonic-gate$e1 = bless sub { 1 }, "E"; 34*0Sstevel@tonic-gateprint expected($e1, "E", "CODE"), "ok 5\n"; 35*0Sstevel@tonic-gate$f1 = bless \[], "F"; 36*0Sstevel@tonic-gateprint expected($f1, "F", "REF"), "ok 6\n"; 37*0Sstevel@tonic-gate$g1 = bless \substr("test", 1, 2), "G"; 38*0Sstevel@tonic-gateprint expected($g1, "G", "LVALUE"), "ok 7\n"; 39*0Sstevel@tonic-gate 40*0Sstevel@tonic-gate# blessing ref to object doesn't modify object 41*0Sstevel@tonic-gate 42*0Sstevel@tonic-gateprint expected(bless(\$a1, "F"), "F", "REF"), "ok 8\n"; 43*0Sstevel@tonic-gateprint expected($a1, "A", "HASH"), "ok 9\n"; 44*0Sstevel@tonic-gate 45*0Sstevel@tonic-gate# reblessing does modify object 46*0Sstevel@tonic-gate 47*0Sstevel@tonic-gatebless $a1, "A2"; 48*0Sstevel@tonic-gateprint expected($a1, "A2", "HASH"), "ok 10\n"; 49*0Sstevel@tonic-gate 50*0Sstevel@tonic-gate# local and my 51*0Sstevel@tonic-gate{ 52*0Sstevel@tonic-gate local $a1 = bless $a1, "A3"; # should rebless outer $a1 53*0Sstevel@tonic-gate local $b1 = bless [], "B3"; 54*0Sstevel@tonic-gate my $c1 = bless $c1, "C3"; # should rebless outer $c1 55*0Sstevel@tonic-gate our $test2 = ""; my $d1 = bless \*test2, "D3"; 56*0Sstevel@tonic-gate print expected($a1, "A3", "HASH"), "ok 11\n"; 57*0Sstevel@tonic-gate print expected($b1, "B3", "ARRAY"), "ok 12\n"; 58*0Sstevel@tonic-gate print expected($c1, "C3", "SCALAR"), "ok 13\n"; 59*0Sstevel@tonic-gate print expected($d1, "D3", "GLOB"), "ok 14\n"; 60*0Sstevel@tonic-gate} 61*0Sstevel@tonic-gateprint expected($a1, "A3", "HASH"), "ok 15\n"; 62*0Sstevel@tonic-gateprint expected($b1, "B", "ARRAY"), "ok 16\n"; 63*0Sstevel@tonic-gateprint expected($c1, "C3", "SCALAR"), "ok 17\n"; 64*0Sstevel@tonic-gateprint expected($d1, "D", "GLOB"), "ok 18\n"; 65*0Sstevel@tonic-gate 66*0Sstevel@tonic-gate# class is magic 67*0Sstevel@tonic-gate"E" =~ /(.)/; 68*0Sstevel@tonic-gateprint expected(bless({}, $1), "E", "HASH"), "ok 19\n"; 69*0Sstevel@tonic-gate{ 70*0Sstevel@tonic-gate local $! = 1; 71*0Sstevel@tonic-gate my $string = "$!"; 72*0Sstevel@tonic-gate $! = 2; # attempt to avoid cached string 73*0Sstevel@tonic-gate $! = 1; 74*0Sstevel@tonic-gate print expected(bless({}, $!), $string, "HASH"), "ok 20\n"; 75*0Sstevel@tonic-gate 76*0Sstevel@tonic-gate# ref is ref to magic 77*0Sstevel@tonic-gate { 78*0Sstevel@tonic-gate { 79*0Sstevel@tonic-gate package F; 80*0Sstevel@tonic-gate sub test { ${$_[0]} eq $string or print "not " } 81*0Sstevel@tonic-gate } 82*0Sstevel@tonic-gate $! = 2; 83*0Sstevel@tonic-gate $f1 = bless \$!, "F"; 84*0Sstevel@tonic-gate $! = 1; 85*0Sstevel@tonic-gate $f1->test; 86*0Sstevel@tonic-gate print "ok 21\n"; 87*0Sstevel@tonic-gate } 88*0Sstevel@tonic-gate} 89*0Sstevel@tonic-gate 90*0Sstevel@tonic-gate# ref is magic 91*0Sstevel@tonic-gate### example of magic variable that is a reference?? 92*0Sstevel@tonic-gate 93*0Sstevel@tonic-gate# no class, or empty string (with a warning), or undef (with two) 94*0Sstevel@tonic-gateprint expected(bless([]), 'main', "ARRAY"), "ok 22\n"; 95*0Sstevel@tonic-gate{ 96*0Sstevel@tonic-gate local $SIG{__WARN__} = sub { push @w, join '', @_ }; 97*0Sstevel@tonic-gate use warnings; 98*0Sstevel@tonic-gate 99*0Sstevel@tonic-gate $m = bless []; 100*0Sstevel@tonic-gate print expected($m, 'main', "ARRAY"), "ok 23\n"; 101*0Sstevel@tonic-gate print @w ? "not ok 24\t# @w\n" : "ok 24\n"; 102*0Sstevel@tonic-gate 103*0Sstevel@tonic-gate @w = (); 104*0Sstevel@tonic-gate $m = bless [], ''; 105*0Sstevel@tonic-gate print expected($m, 'main', "ARRAY"), "ok 25\n"; 106*0Sstevel@tonic-gate print @w != 1 ? "not ok 26\t# @w\n" : "ok 26\n"; 107*0Sstevel@tonic-gate 108*0Sstevel@tonic-gate @w = (); 109*0Sstevel@tonic-gate $m = bless [], undef; 110*0Sstevel@tonic-gate print expected($m, 'main', "ARRAY"), "ok 27\n"; 111*0Sstevel@tonic-gate print @w != 2 ? "not ok 28\t# @w\n" : "ok 28\n"; 112*0Sstevel@tonic-gate} 113*0Sstevel@tonic-gate 114*0Sstevel@tonic-gate# class is a ref 115*0Sstevel@tonic-gate$a1 = bless {}, "A4"; 116*0Sstevel@tonic-gate$b1 = eval { bless {}, $a1 }; 117*0Sstevel@tonic-gateprint $@ ? "ok 29\n" : "not ok 29\t# $b1\n"; 118*0Sstevel@tonic-gate 119*0Sstevel@tonic-gate# class is an overloaded ref 120*0Sstevel@tonic-gate{ 121*0Sstevel@tonic-gate package H4; 122*0Sstevel@tonic-gate use overload '""' => sub { "C4" }; 123*0Sstevel@tonic-gate} 124*0Sstevel@tonic-gate$h1 = bless {}, "H4"; 125*0Sstevel@tonic-gate$c4 = eval { bless \$test, $h1 }; 126*0Sstevel@tonic-gateprint expected($c4, 'C4', "SCALAR"), "ok 30\n"; 127*0Sstevel@tonic-gateprint $@ ? "not ok 31\t# $@" : "ok 31\n"; 128