This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
183cb273f705da7136e63dfac8a68e874a3bf296
[perl5.git] / t / op / overload.t
1 #!./perl
2
3 BEGIN { unshift @INC, './lib', '../lib';
4     require Config; import Config;
5 }
6
7 package Oscalar;
8 use overload ( 
9                                 # Anonymous subroutines:
10 '+'     =>      sub {new Oscalar $ {$_[0]}+$_[1]},
11 '-'     =>      sub {new Oscalar
12                        $_[2]? $_[1]-${$_[0]} : ${$_[0]}-$_[1]},
13 '<=>'   =>      sub {new Oscalar
14                        $_[2]? $_[1]-${$_[0]} : ${$_[0]}-$_[1]},
15 'cmp'   =>      sub {new Oscalar
16                        $_[2]? ($_[1] cmp ${$_[0]}) : (${$_[0]} cmp $_[1])},
17 '*'     =>      sub {new Oscalar ${$_[0]}*$_[1]},
18 '/'     =>      sub {new Oscalar 
19                        $_[2]? $_[1]/${$_[0]} :
20                          ${$_[0]}/$_[1]},
21 '%'     =>      sub {new Oscalar
22                        $_[2]? $_[1]%${$_[0]} : ${$_[0]}%$_[1]},
23 '**'    =>      sub {new Oscalar
24                        $_[2]? $_[1]**${$_[0]} : ${$_[0]}-$_[1]},
25
26 qw(
27 ""      stringify
28 0+      numify)                 # Order of arguments unsignificant
29 );
30
31 sub new {
32   my $foo = $_[1];
33   bless \$foo;
34 }
35
36 sub stringify { "${$_[0]}" }
37 sub numify { 0 + "${$_[0]}" }   # Not needed, additional overhead
38                                 # comparing to direct compilation based on
39                                 # stringify
40
41 package main;
42
43 $test = 0;
44 $| = 1;
45 print "1..",&last,"\n";
46
47 sub test {
48   $test++; if (shift) {print "ok $test\n";1} else {print "not ok $test\n";0}
49 }
50
51 $a = new Oscalar "087";
52 $b= "$a";
53
54 # All test numbers in comments are off by 1.
55 # So much for hard-wiring them in :-)
56 test ($b eq $a);                # 2
57 test ($b eq "087");             # 3
58 test (ref $a eq "Oscalar");     # 4
59 test ($a eq $a);                # 5
60 test ($a eq "087");             # 6
61
62 $c = $a + 7;
63
64 test (ref $c eq "Oscalar");     # 7
65 test (!($c eq $a));             # 8
66 test ($c eq "94");              # 9
67
68 $b=$a;
69
70 test (ref $a eq "Oscalar");     # 10
71
72 $b++;
73
74 test (ref $b eq "Oscalar");     # 11
75 test ( $a eq "087");            # 12
76 test ( $b eq "88");             # 13
77 test (ref $a eq "Oscalar");     # 14
78
79 $c=$b;
80 $c-=$a;
81
82 test (ref $c eq "Oscalar");     # 15
83 test ( $a eq "087");            # 16
84 test ( $c eq "1");              # 17
85 test (ref $a eq "Oscalar");     # 18
86
87 $b=1;
88 $b+=$a;
89
90 test (ref $b eq "Oscalar");     # 19
91 test ( $a eq "087");            # 20
92 test ( $b eq "88");             # 21
93 test (ref $a eq "Oscalar");     # 22
94
95 eval q[ package Oscalar; use overload ('++' => sub { $ {$_[0]}++;$_[0] } ) ];
96
97 $b=$a;
98
99 test (ref $a eq "Oscalar");     # 23
100
101 $b++;
102
103 test (ref $b eq "Oscalar");     # 24
104 test ( $a eq "087");            # 25
105 test ( $b eq "88");             # 26
106 test (ref $a eq "Oscalar");     # 27
107
108 package Oscalar;
109 $dummy=bless \$dummy;           # Now cache of method should be reloaded
110 package main;
111
112 $b=$a;
113 $b++;                           
114
115 test (ref $b eq "Oscalar");     # 28
116 test ( $a eq "087");            # 29
117 test ( $b eq "88");             # 30
118 test (ref $a eq "Oscalar");     # 31
119
120
121 eval q[package Oscalar; use overload ('++' => sub { $ {$_[0]} += 2; $_[0] } ) ];
122
123 $b=$a;
124
125 test (ref $a eq "Oscalar");     # 32
126
127 $b++;
128
129 test (ref $b eq "Oscalar");     # 33
130 test ( $a eq "087");            # 34
131 test ( $b eq "88");             # 35
132 test (ref $a eq "Oscalar");     # 36
133
134 package Oscalar;
135 $dummy=bless \$dummy;           # Now cache of method should be reloaded
136 package main;
137
138 $b++;                           
139
140 test (ref $b eq "Oscalar");     # 37
141 test ( $a eq "087");            # 38
142 test ( $b eq "90");             # 39
143 test (ref $a eq "Oscalar");     # 40
144
145 $b=$a;
146 $b++;
147
148 test (ref $b eq "Oscalar");     # 41
149 test ( $a eq "087");            # 42
150 test ( $b eq "89");             # 43
151 test (ref $a eq "Oscalar");     # 44
152
153
154 test ($b? 1:0);                 # 45
155
156 eval q[ package Oscalar; use overload ('=' => sub {$main::copies++; 
157                                                    package Oscalar;
158                                                    local $new=$ {$_[0]};
159                                                    bless \$new } ) ];
160
161 $b=new Oscalar "$a";
162
163 test (ref $b eq "Oscalar");     # 46
164 test ( $a eq "087");            # 47
165 test ( $b eq "087");            # 48
166 test (ref $a eq "Oscalar");     # 49
167
168 $b++;
169
170 test (ref $b eq "Oscalar");     # 50
171 test ( $a eq "087");            # 51
172 test ( $b eq "89");             # 52
173 test (ref $a eq "Oscalar");     # 53
174 test ($copies == 0);            # 54
175
176 $b+=1;
177
178 test (ref $b eq "Oscalar");     # 55
179 test ( $a eq "087");            # 56
180 test ( $b eq "90");             # 57
181 test (ref $a eq "Oscalar");     # 58
182 test ($copies == 0);            # 59
183
184 $b=$a;
185 $b+=1;
186
187 test (ref $b eq "Oscalar");     # 60
188 test ( $a eq "087");            # 61
189 test ( $b eq "88");             # 62
190 test (ref $a eq "Oscalar");     # 63
191 test ($copies == 0);            # 64
192
193 $b=$a;
194 $b++;
195
196 test (ref $b eq "Oscalar") || print ref $b,"=ref(b)\n"; # 65
197 test ( $a eq "087");            # 66
198 test ( $b eq "89");             # 67
199 test (ref $a eq "Oscalar");     # 68
200 test ($copies == 1);            # 69
201
202 eval q[package Oscalar; use overload ('+=' => sub {$ {$_[0]} += 3*$_[1];
203                                                    $_[0] } ) ];
204 $c=new Oscalar;                 # Cause rehash
205
206 $b=$a;
207 $b+=1;
208
209 test (ref $b eq "Oscalar");     # 70
210 test ( $a eq "087");            # 71
211 test ( $b eq "90");             # 72
212 test (ref $a eq "Oscalar");     # 73
213 test ($copies == 2);            # 74
214
215 $b+=$b;
216
217 test (ref $b eq "Oscalar");     # 75
218 test ( $b eq "360");            # 76
219 test ($copies == 2);            # 77
220 $b=-$b;
221
222 test (ref $b eq "Oscalar");     # 78
223 test ( $b eq "-360");           # 79
224 test ($copies == 2);            # 80
225
226 $b=abs($b);
227
228 test (ref $b eq "Oscalar");     # 81
229 test ( $b eq "360");            # 82
230 test ($copies == 2);            # 83
231
232 $b=abs($b);
233
234 test (ref $b eq "Oscalar");     # 84
235 test ( $b eq "360");            # 85
236 test ($copies == 2);            # 86
237
238 eval q[package Oscalar; 
239        use overload ('x' => sub {new Oscalar ( $_[2] ? "_.$_[1]._" x $ {$_[0]}
240                                               : "_.${$_[0]}._" x $_[1])}) ];
241
242 $a=new Oscalar "yy";
243 $a x= 3;
244 test ($a eq "_.yy.__.yy.__.yy._"); # 87
245
246 eval q[package Oscalar; 
247        use overload ('.' => sub {new Oscalar ( $_[2] ? 
248                                               "_.$_[1].__.$ {$_[0]}._"
249                                               : "_.$ {$_[0]}.__.$_[1]._")}) ];
250
251 $a=new Oscalar "xx";
252
253 test ("b${a}c" eq "_._.b.__.xx._.__.c._"); # 88
254
255 # Here we test blessing to a package updates hash
256
257 eval "package Oscalar; no overload '.'";
258
259 test ("b${a}" eq "_.b.__.xx._"); # 89
260 $x="1";
261 bless \$x, Oscalar;
262 test ("b${a}c" eq "bxxc");      # 90
263 new Oscalar 1;
264 test ("b${a}c" eq "bxxc");      # 91
265
266 # Last test is number 90.
267 sub last {90}