X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2Fop%2Fbless.t;h=3aaceb8ce73db6af4fa14e6be8e56d4559a81614;hb=397cf4b72b64bab2d81c27006b39549ca667b5a8;hp=3d5d85d01bfaf17083a593c9452878726038f3e0;hpb=81689caa70f1ebdcb0b17a51c3e0742ee11ec130;p=p5sagit%2Fp5-mst-13.2.git diff --git a/t/op/bless.t b/t/op/bless.t index 3d5d85d..3aaceb8 100644 --- a/t/op/bless.t +++ b/t/op/bless.t @@ -1,10 +1,10 @@ #!./perl -print "1..29\n"; +print "1..31\n"; BEGIN { chdir 't' if -d 't'; - unshift @INC, '../lib' if -d '../lib'; + @INC = '../lib'; } sub expected { @@ -13,7 +13,8 @@ sub expected { ref($object) eq $package && "$object" =~ /^\Q$package\E=(\w+)\(0x([0-9a-f]+)\)$/ && $1 eq $type - && hex($2) == $object + # in 64-bit platforms hex warns for 32+ -bit values + && do { no warnings 'portable'; hex($2) == $object } ); print "# $object $package $type\n"; return "not "; @@ -27,7 +28,7 @@ $b1 = bless [], "B"; print expected($b1, "B", "ARRAY"), "ok 2\n"; $c1 = bless \(map "$_", "test"), "C"; print expected($c1, "C", "SCALAR"), "ok 3\n"; -$d1 = bless \*test, "D"; +our $test = "foo"; $d1 = bless \*test, "D"; print expected($d1, "D", "GLOB"), "ok 4\n"; $e1 = bless sub { 1 }, "E"; print expected($e1, "E", "CODE"), "ok 5\n"; @@ -43,7 +44,7 @@ print expected($a1, "A", "HASH"), "ok 9\n"; # reblessing does modify object -$a2 = bless $a1, "A2"; +bless $a1, "A2"; print expected($a1, "A2", "HASH"), "ok 10\n"; # local and my @@ -51,7 +52,7 @@ print expected($a1, "A2", "HASH"), "ok 10\n"; local $a1 = bless $a1, "A3"; # should rebless outer $a1 local $b1 = bless [], "B3"; my $c1 = bless $c1, "C3"; # should rebless outer $c1 - my $d1 = bless \*test2, "D3"; + our $test2 = ""; my $d1 = bless \*test2, "D3"; print expected($a1, "A3", "HASH"), "ok 11\n"; print expected($b1, "B3", "ARRAY"), "ok 12\n"; print expected($c1, "C3", "SCALAR"), "ok 13\n"; @@ -93,7 +94,7 @@ print expected(bless({}, $1), "E", "HASH"), "ok 19\n"; print expected(bless([]), 'main', "ARRAY"), "ok 22\n"; { local $SIG{__WARN__} = sub { push @w, join '', @_ }; - local $^W = 1; + use warnings; $m = bless []; print expected($m, 'main', "ARRAY"), "ok 23\n"; @@ -114,3 +115,13 @@ print expected(bless([]), 'main', "ARRAY"), "ok 22\n"; $a1 = bless {}, "A4"; $b1 = eval { bless {}, $a1 }; print $@ ? "ok 29\n" : "not ok 29\t# $b1\n"; + +# class is an overloaded ref +{ + package H4; + use overload '""' => sub { "C4" }; +} +$h1 = bless {}, "H4"; +$c4 = eval { bless \$test, $h1 }; +print expected($c4, 'C4', "SCALAR"), "ok 30\n"; +print $@ ? "not ok 31\t# $@" : "ok 31\n";