Commit | Line | Data |
---|---|---|
800401ee JH |
1 | #!./perl |
2 | ||
3 | BEGIN { | |
4 | chdir 't' if -d 't'; | |
5 | @INC = '../lib'; | |
6 | require Config; | |
7 | if ($Config::Config{'uvsize'} != 8) { | |
8 | print "1..0 # Skip -- Perl configured with 32-bit ints\n"; | |
9 | exit 0; | |
10 | } | |
11 | } | |
12 | ||
13 | $| = 1; | |
14 | use Test::More 'tests' => 100; | |
15 | ||
16 | ||
17 | my $ii = 36028797018963971; # 2^55 + 3 | |
18 | ||
19 | ||
20 | ### Tests with numerifying large positive int | |
21 | { package Oobj; | |
22 | use overload '0+' => sub { ${$_[0]} += 1; $ii }, | |
23 | 'fallback' => 1; | |
24 | } | |
25 | my $oo = bless(\do{my $x = 0}, 'Oobj'); | |
26 | my $cnt = 1; | |
27 | ||
28 | is("$oo", "$ii", '0+ overload with stringification'); | |
29 | is($$oo, $cnt++, 'overload called once'); | |
30 | ||
31 | is($oo>>3, $ii>>3, '0+ overload with bit shift right'); | |
32 | is($$oo, $cnt++, 'overload called once'); | |
33 | ||
34 | is($oo<<2, $ii<<2, '0+ overload with bit shift left'); | |
35 | is($$oo, $cnt++, 'overload called once'); | |
36 | ||
37 | is($oo|0xFF00, $ii|0xFF00, '0+ overload with bitwise or'); | |
38 | is($$oo, $cnt++, 'overload called once'); | |
39 | ||
40 | is($oo&0xFF03, $ii&0xFF03, '0+ overload with bitwise and'); | |
41 | is($$oo, $cnt++, 'overload called once'); | |
42 | ||
43 | ok($oo == $ii, '0+ overload with equality'); | |
44 | is($$oo, $cnt++, 'overload called once'); | |
45 | ||
46 | is(int($oo), $ii, '0+ overload with int()'); | |
47 | is($$oo, $cnt++, 'overload called once'); | |
48 | ||
49 | is(abs($oo), $ii, '0+ overload with abs()'); | |
50 | is($$oo, $cnt++, 'overload called once'); | |
51 | ||
52 | is(-$oo, -$ii, '0+ overload with unary minus'); | |
53 | is($$oo, $cnt++, 'overload called once'); | |
54 | ||
55 | is(0+$oo, $ii, '0+ overload with addition'); | |
56 | is($$oo, $cnt++, 'overload called once'); | |
57 | is($oo+0, $ii, '0+ overload with addition'); | |
58 | is($$oo, $cnt++, 'overload called once'); | |
59 | is($oo+$oo, 2*$ii, '0+ overload with addition'); | |
60 | $cnt++; | |
61 | is($$oo, $cnt++, 'overload called once'); | |
62 | ||
63 | is(0-$oo, -$ii, '0+ overload with subtraction'); | |
64 | is($$oo, $cnt++, 'overload called once'); | |
65 | is($oo-99, $ii-99, '0+ overload with subtraction'); | |
66 | is($$oo, $cnt++, 'overload called once'); | |
67 | ||
68 | is(2*$oo, 2*$ii, '0+ overload with multiplication'); | |
69 | is($$oo, $cnt++, 'overload called once'); | |
70 | is($oo*3, 3*$ii, '0+ overload with multiplication'); | |
71 | is($$oo, $cnt++, 'overload called once'); | |
72 | ||
73 | is($oo/1, $ii, '0+ overload with division'); | |
74 | is($$oo, $cnt++, 'overload called once'); | |
75 | is($ii/$oo, 1, '0+ overload with division'); | |
76 | is($$oo, $cnt++, 'overload called once'); | |
77 | ||
78 | is($oo%100, $ii%100, '0+ overload with modulo'); | |
79 | is($$oo, $cnt++, 'overload called once'); | |
80 | is($ii%$oo, 0, '0+ overload with modulo'); | |
81 | is($$oo, $cnt++, 'overload called once'); | |
82 | ||
83 | is($oo**1, $ii, '0+ overload with exponentiation'); | |
84 | is($$oo, $cnt++, 'overload called once'); | |
85 | ||
86 | ||
87 | ### Tests with numerifying large negative int | |
88 | { package Oobj2; | |
89 | use overload '0+' => sub { ${$_[0]} += 1; -$ii }, | |
90 | 'fallback' => 1; | |
91 | } | |
92 | $oo = bless(\do{my $x = 0}, 'Oobj2'); | |
93 | $cnt = 1; | |
94 | ||
95 | is(int($oo), -$ii, '0+ overload with int()'); | |
96 | is($$oo, $cnt++, 'overload called once'); | |
97 | ||
98 | is(abs($oo), $ii, '0+ overload with abs()'); | |
99 | is($$oo, $cnt++, 'overload called once'); | |
100 | ||
101 | is(-$oo, $ii, '0+ overload with unary -'); | |
102 | is($$oo, $cnt++, 'overload called once'); | |
103 | ||
104 | is(0+$oo, -$ii, '0+ overload with addition'); | |
105 | is($$oo, $cnt++, 'overload called once'); | |
106 | is($oo+0, -$ii, '0+ overload with addition'); | |
107 | is($$oo, $cnt++, 'overload called once'); | |
108 | is($oo+$oo, -2*$ii, '0+ overload with addition'); | |
109 | $cnt++; | |
110 | is($$oo, $cnt++, 'overload called once'); | |
111 | ||
112 | is(0-$oo, $ii, '0+ overload with subtraction'); | |
113 | is($$oo, $cnt++, 'overload called once'); | |
114 | ||
115 | is(2*$oo, -2*$ii, '0+ overload with multiplication'); | |
116 | is($$oo, $cnt++, 'overload called once'); | |
117 | is($oo*3, -3*$ii, '0+ overload with multiplication'); | |
118 | is($$oo, $cnt++, 'overload called once'); | |
119 | ||
120 | is($oo/1, -$ii, '0+ overload with division'); | |
121 | is($$oo, $cnt++, 'overload called once'); | |
122 | is($ii/$oo, -1, '0+ overload with division'); | |
123 | is($$oo, $cnt++, 'overload called once'); | |
124 | ||
125 | is($oo%100, (-$ii)%100, '0+ overload with modulo'); | |
126 | is($$oo, $cnt++, 'overload called once'); | |
127 | is($ii%$oo, 0, '0+ overload with modulo'); | |
128 | is($$oo, $cnt++, 'overload called once'); | |
129 | ||
130 | is($oo**1, -$ii, '0+ overload with exponentiation'); | |
131 | is($$oo, $cnt++, 'overload called once'); | |
132 | ||
133 | ### Tests with overloading but no fallback | |
134 | { package Oobj3; | |
135 | use overload | |
136 | 'int' => sub { ${$_[0]} += 1; $ii }, | |
137 | 'abs' => sub { ${$_[0]} += 1; $ii }, | |
138 | 'neg' => sub { ${$_[0]} += 1; -$ii }, | |
139 | '+' => sub { | |
140 | ${$_[0]} += 1; | |
141 | my $res = (ref($_[0]) eq __PACKAGE__) ? $ii : $_[0]; | |
142 | $res += (ref($_[1]) eq __PACKAGE__) ? $ii : $_[1]; | |
143 | }, | |
144 | '-' => sub { | |
145 | ${$_[0]} += 1; | |
146 | my ($l, $r) = ($_[2]) ? (1, 0) : (0, 1); | |
147 | my $res = (ref($_[$l]) eq __PACKAGE__) ? $ii : $_[$l]; | |
148 | $res -= (ref($_[$r]) eq __PACKAGE__) ? $ii : $_[$r]; | |
149 | }, | |
150 | '*' => sub { | |
151 | ${$_[0]} += 1; | |
152 | my $res = (ref($_[0]) eq __PACKAGE__) ? $ii : $_[0]; | |
153 | $res *= (ref($_[1]) eq __PACKAGE__) ? $ii : $_[1]; | |
154 | }, | |
155 | '/' => sub { | |
156 | ${$_[0]} += 1; | |
157 | my ($l, $r) = ($_[2]) ? (1, 0) : (0, 1); | |
158 | my $res = (ref($_[$l]) eq __PACKAGE__) ? $ii+1 : $_[$l]; | |
159 | $res /= (ref($_[$r]) eq __PACKAGE__) ? $ii+1 : $_[$r]; | |
160 | }, | |
161 | '%' => sub { | |
162 | ${$_[0]} += 1; | |
163 | my ($l, $r) = ($_[2]) ? (1, 0) : (0, 1); | |
164 | my $res = (ref($_[$l]) eq __PACKAGE__) ? $ii : $_[$l]; | |
165 | $res %= (ref($_[$r]) eq __PACKAGE__) ? $ii : $_[$r]; | |
166 | }, | |
167 | '**' => sub { | |
168 | ${$_[0]} += 1; | |
169 | my ($l, $r) = ($_[2]) ? (1, 0) : (0, 1); | |
170 | my $res = (ref($_[$l]) eq __PACKAGE__) ? $ii : $_[$l]; | |
171 | $res **= (ref($_[$r]) eq __PACKAGE__) ? $ii : $_[$r]; | |
172 | }, | |
173 | } | |
174 | $oo = bless(\do{my $x = 0}, 'Oobj3'); | |
175 | $cnt = 1; | |
176 | ||
177 | is(int($oo), $ii, 'int() overload'); | |
178 | is($$oo, $cnt++, 'overload called once'); | |
179 | ||
180 | is(abs($oo), $ii, 'abs() overload'); | |
181 | is($$oo, $cnt++, 'overload called once'); | |
182 | ||
183 | is(-$oo, -$ii, 'neg overload'); | |
184 | is($$oo, $cnt++, 'overload called once'); | |
185 | ||
186 | is(0+$oo, $ii, '+ overload'); | |
187 | is($$oo, $cnt++, 'overload called once'); | |
188 | is($oo+0, $ii, '+ overload'); | |
189 | is($$oo, $cnt++, 'overload called once'); | |
190 | is($oo+$oo, 2*$ii, '+ overload'); | |
191 | is($$oo, $cnt++, 'overload called once'); | |
192 | ||
193 | is(0-$oo, -$ii, '- overload'); | |
194 | is($$oo, $cnt++, 'overload called once'); | |
195 | is($oo-99, $ii-99, '- overload'); | |
196 | is($$oo, $cnt++, 'overload called once'); | |
197 | ||
198 | is($oo*2, 2*$ii, '* overload'); | |
199 | is($$oo, $cnt++, 'overload called once'); | |
200 | is(-3*$oo, -3*$ii, '* overload'); | |
201 | is($$oo, $cnt++, 'overload called once'); | |
202 | ||
203 | is($oo/2, ($ii+1)/2, '/ overload'); | |
204 | is($$oo, $cnt++, 'overload called once'); | |
205 | is(($ii+1)/$oo, 1, '/ overload'); | |
206 | is($$oo, $cnt++, 'overload called once'); | |
207 | ||
208 | is($oo%100, $ii%100, '% overload'); | |
209 | is($$oo, $cnt++, 'overload called once'); | |
210 | is($ii%$oo, 0, '% overload'); | |
211 | is($$oo, $cnt++, 'overload called once'); | |
212 | ||
213 | is($oo**1, $ii, '** overload'); | |
214 | is($$oo, $cnt++, 'overload called once'); | |
215 | ||
216 | # EOF |