This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Fix spelling: precede
[perl5.git] / t / uni / bless.t
1 #!./perl
2
3 BEGIN {
4     chdir 't' if -d 't';
5     require './test.pl';
6     set_up_inc('../lib');
7 }
8
9 use utf8;
10 use open qw( :utf8 :std );
11 plan (84);
12
13 sub expected {
14     my($object, $package, $type) = @_;
15     print "# $object $package $type\n";
16     is(ref($object), $package);
17     my $r = qr/^\Q$package\E=(\w+)\(0x([0-9a-f]+)\)$/u;
18     like("$object", $r);
19     if ("$object" =~ $r) {
20         is($1, $type);
21         # in 64-bit platforms hex warns for 32+ -bit values
22         cmp_ok(do {no warnings 'portable'; hex($2)}, '==', $object);
23     }
24     else {
25         fail(); fail();
26     }
27 }
28
29 # test blessing simple types
30
31 $a1 = bless {}, "ዐ";
32 expected($a1, "ዐ", "HASH");
33 $b1 = bless [], "B";
34 expected($b1, "B", "ARRAY");
35 $c1 = bless \(map "$_", "test"), "ᶜ";
36 expected($c1, "ᶜ", "SCALAR");
37 $tèst = "foo"; $d1 = bless \*tèst, "ɖ";
38 expected($d1, "ɖ", "GLOB");
39 $e1 = bless sub { 1 }, "ಎ";
40 expected($e1, "ಎ", "CODE");
41 $f1 = bless \[], "ḟ";
42 expected($f1, "ḟ", "REF");
43 $g1 = bless \substr("test", 1, 2), "ㄍ";
44 expected($g1, "ㄍ", "LVALUE");
45
46 # blessing ref to object doesn't modify object
47
48 expected(bless(\$a1, "ḟ"), "ḟ", "REF");
49 expected($a1, "ዐ", "HASH");
50
51 # reblessing does modify object
52
53 bless $a1, "ዐ2";
54 expected($a1, "ዐ2", "HASH");
55
56 # local and my
57 {
58     local $a1 = bless $a1, "ዐ3";      # should rebless outer $a1
59     local $b1 = bless [], "B3";
60     my $c1 = bless $c1, "ᶜ3";         # should rebless outer $c1
61     our $test2 = ""; my $d1 = bless \*test2, "ɖ3";
62     expected($a1, "ዐ3", "HASH");
63     expected($b1, "B3", "ARRAY");
64     expected($c1, "ᶜ3", "SCALAR");
65     expected($d1, "ɖ3", "GLOB");
66 }
67 expected($a1, "ዐ3", "HASH");
68 expected($b1, "B", "ARRAY");
69 expected($c1, "ᶜ3", "SCALAR");
70 expected($d1, "ɖ", "GLOB");
71
72 # class is magic
73 "ಎ" =~ /(.)/;
74 expected(bless({}, $1), "ಎ", "HASH");
75 {
76     local $! = 1;
77     my $string = "$!";
78     $! = 2;     # attempt to avoid cached string
79     $! = 1;
80     expected(bless({}, $!), $string, "HASH");
81
82 # ref is ref to magic
83     {
84         {
85             package ḟ;
86             sub test { main::is(${$_[0]}, $string) }
87         }
88         $! = 2;
89         $f1 = bless \$!, "ḟ";
90         $! = 1;
91         $f1->test;
92     }
93 }
94
95 # ref is magic
96
97 # class is a ref
98 $a1 = bless {}, "ዐ4";
99 $b1 = eval { bless {}, $a1 };
100 isnt ($@, '', "class is a ref");
101
102 # class is an overloaded ref
103 =begin
104 $TODO = "Package not yet clean";
105 {
106     package ᚺ4;
107     use overload '""' => sub { "ᶜ4" };
108 }
109 $h1 = bless {}, "ᚺ4";
110 $c4 = eval { bless \$test, $h1 };
111 is ($@, '', "class is an overloaded ref");
112 expected($c4, 'ᶜ4', "SCALAR");
113 =cut
114
115 {
116     my %h = 1..2;
117     my($k) = keys %h; 
118     my $x=\$k;
119     bless $x, 'pàm';
120     is(ref $x, 'pàm');
121
122     my $a = bless \(keys %h), 'zàp';
123     is(ref $a, 'zàp');
124 }