xref: /openbsd-src/gnu/usr.bin/perl/lib/overload64.t (revision a28daedfc357b214be5c701aa8ba8adb29a7f1c2) 
1#!./perl
2
3BEGIN {
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;
14use Test::More 'tests' => 100;
15
16
17my $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}
25my $oo = bless(\do{my $x = 0}, 'Oobj');
26my $cnt = 1;
27
28is("$oo", "$ii", '0+ overload with stringification');
29is($$oo, $cnt++, 'overload called once');
30
31is($oo>>3, $ii>>3, '0+ overload with bit shift right');
32is($$oo, $cnt++, 'overload called once');
33
34is($oo<<2, $ii<<2, '0+ overload with bit shift left');
35is($$oo, $cnt++, 'overload called once');
36
37is($oo|0xFF00, $ii|0xFF00, '0+ overload with bitwise or');
38is($$oo, $cnt++, 'overload called once');
39
40is($oo&0xFF03, $ii&0xFF03, '0+ overload with bitwise and');
41is($$oo, $cnt++, 'overload called once');
42
43ok($oo == $ii, '0+ overload with equality');
44is($$oo, $cnt++, 'overload called once');
45
46is(int($oo), $ii, '0+ overload with int()');
47is($$oo, $cnt++, 'overload called once');
48
49is(abs($oo), $ii, '0+ overload with abs()');
50is($$oo, $cnt++, 'overload called once');
51
52is(-$oo, -$ii, '0+ overload with unary minus');
53is($$oo, $cnt++, 'overload called once');
54
55is(0+$oo, $ii, '0+ overload with addition');
56is($$oo, $cnt++, 'overload called once');
57is($oo+0, $ii, '0+ overload with addition');
58is($$oo, $cnt++, 'overload called once');
59is($oo+$oo, 2*$ii, '0+ overload with addition');
60$cnt++;
61is($$oo, $cnt++, 'overload called once');
62
63is(0-$oo, -$ii, '0+ overload with subtraction');
64is($$oo, $cnt++, 'overload called once');
65is($oo-99, $ii-99, '0+ overload with subtraction');
66is($$oo, $cnt++, 'overload called once');
67
68is(2*$oo, 2*$ii, '0+ overload with multiplication');
69is($$oo, $cnt++, 'overload called once');
70is($oo*3, 3*$ii, '0+ overload with multiplication');
71is($$oo, $cnt++, 'overload called once');
72
73is($oo/1, $ii, '0+ overload with division');
74is($$oo, $cnt++, 'overload called once');
75is($ii/$oo, 1, '0+ overload with division');
76is($$oo, $cnt++, 'overload called once');
77
78is($oo%100, $ii%100, '0+ overload with modulo');
79is($$oo, $cnt++, 'overload called once');
80is($ii%$oo, 0, '0+ overload with modulo');
81is($$oo, $cnt++, 'overload called once');
82
83is($oo**1, $ii, '0+ overload with exponentiation');
84is($$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
95is(int($oo), -$ii, '0+ overload with int()');
96is($$oo, $cnt++, 'overload called once');
97
98is(abs($oo), $ii, '0+ overload with abs()');
99is($$oo, $cnt++, 'overload called once');
100
101is(-$oo, $ii, '0+ overload with unary -');
102is($$oo, $cnt++, 'overload called once');
103
104is(0+$oo, -$ii, '0+ overload with addition');
105is($$oo, $cnt++, 'overload called once');
106is($oo+0, -$ii, '0+ overload with addition');
107is($$oo, $cnt++, 'overload called once');
108is($oo+$oo, -2*$ii, '0+ overload with addition');
109$cnt++;
110is($$oo, $cnt++, 'overload called once');
111
112is(0-$oo, $ii, '0+ overload with subtraction');
113is($$oo, $cnt++, 'overload called once');
114
115is(2*$oo, -2*$ii, '0+ overload with multiplication');
116is($$oo, $cnt++, 'overload called once');
117is($oo*3, -3*$ii, '0+ overload with multiplication');
118is($$oo, $cnt++, 'overload called once');
119
120is($oo/1, -$ii, '0+ overload with division');
121is($$oo, $cnt++, 'overload called once');
122is($ii/$oo, -1, '0+ overload with division');
123is($$oo, $cnt++, 'overload called once');
124
125is($oo%100, (-$ii)%100, '0+ overload with modulo');
126is($$oo, $cnt++, 'overload called once');
127is($ii%$oo, 0, '0+ overload with modulo');
128is($$oo, $cnt++, 'overload called once');
129
130is($oo**1, -$ii, '0+ overload with exponentiation');
131is($$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
177is(int($oo), $ii, 'int() overload');
178is($$oo, $cnt++, 'overload called once');
179
180is(abs($oo), $ii, 'abs() overload');
181is($$oo, $cnt++, 'overload called once');
182
183is(-$oo, -$ii, 'neg overload');
184is($$oo, $cnt++, 'overload called once');
185
186is(0+$oo, $ii, '+ overload');
187is($$oo, $cnt++, 'overload called once');
188is($oo+0, $ii, '+ overload');
189is($$oo, $cnt++, 'overload called once');
190is($oo+$oo, 2*$ii, '+ overload');
191is($$oo, $cnt++, 'overload called once');
192
193is(0-$oo, -$ii, '- overload');
194is($$oo, $cnt++, 'overload called once');
195is($oo-99, $ii-99, '- overload');
196is($$oo, $cnt++, 'overload called once');
197
198is($oo*2, 2*$ii, '* overload');
199is($$oo, $cnt++, 'overload called once');
200is(-3*$oo, -3*$ii, '* overload');
201is($$oo, $cnt++, 'overload called once');
202
203is($oo/2, ($ii+1)/2, '/ overload');
204is($$oo, $cnt++, 'overload called once');
205is(($ii+1)/$oo, 1, '/ overload');
206is($$oo, $cnt++, 'overload called once');
207
208is($oo%100, $ii%100, '% overload');
209is($$oo, $cnt++, 'overload called once');
210is($ii%$oo, 0, '% overload');
211is($$oo, $cnt++, 'overload called once');
212
213is($oo**1, $ii, '** overload');
214is($$oo, $cnt++, 'overload called once');
215
216# EOF
217