1# -*- mode: perl; -*-
2
3use strict;
4use warnings;
5
6use Test::More tests => 41301;
7
8use Math::BigInt;
9
10use Math::Complex ();
11
12my $inf = $Math::Complex::Inf;
13my $nan = $inf - $inf;
14
15my $scalar_util_ok = eval { require Scalar::Util; };
16Scalar::Util -> import('refaddr') if $scalar_util_ok;
17
18diag "Skipping some tests since Scalar::Util is not installed."
19  unless $scalar_util_ok;
20
21# Return 1 if the input argument is +inf or -inf, and "" otherwise.
22
23sub isinf {
24    my $x = shift;
25    return $x == $inf || $x == -$inf;
26}
27
28# Return 1 if the input argument is a nan (Not-a-Number), and "" otherwise.
29
30sub isnan {
31    my $x = shift;
32    return $x != $x;
33}
34
35# Convert a Perl scalar to a Math::BigInt object. This function is used for
36# consistent comparisons. For instance, a Not-a-Number might be stringified to
37# 'nan', but Math::BigInt uses 'NaN'.
38
39sub pl2mbi {
40    my $x = shift;
41    return Math::BigInt -> binf('+') if $x == $inf;
42    return Math::BigInt -> binf('-') if $x == -$inf;
43    return Math::BigInt -> bnan()    if isnan($x);
44    return Math::BigInt -> new($x);
45}
46
47# Does a truncated division (T-division).
48
49sub tdiv {
50    die "Usage: fdiv X Y\n" if @_ != 2;
51
52    #no integer;
53
54    my $x = shift;              # numerator
55    my $y = shift;              # denominator
56
57    # Convert Perl strings representing nan, +inf, and -inf into Perl numbers.
58
59    if ($x =~ /^\s*nan\s*$/i) {
60        $x = $nan;
61    } elsif ($x =~ /^\s*([+-]?)inf(inity)?\s*$/i) {
62        $x = $1 eq '-' ? -$inf : $inf;
63    }
64
65    if ($y =~ /^\s*nan\s*$/i) {
66        $y = $nan;
67    } elsif ($y =~ /^\s*([+-]?)inf(inity)?\s*$/i) {
68        $y = $1 eq '-' ? -$inf : $inf;
69    }
70
71    # If any input is nan, the output is nan.
72
73    if (isnan($x) || isnan($y)) {
74        return wantarray ? ($nan, $nan) : $nan;
75    }
76
77    # Divide by zero and modulo zero.
78
79    if ($y == 0) {
80
81        # Core Perl gives an "Illegal division by zero" error whenever the
82        # denominator is zero. Math::BigInt, however, has a different
83        # convention.
84
85        my $q = $x < 0 ? -$inf
86              : $x > 0 ?  $inf
87              :           $nan;
88        my $r = $x;
89        return wantarray ? ($q, $r) : $q;
90    }
91
92    # Numerator is +/-infinity, and denominator is finite and non-zero.
93
94    if (isinf($x)) {
95        my $q = int($x / $y);
96        my $r = $x - $y * $q;
97        return wantarray ? ($q, $r) : $q;
98
99        if (isinf($y)) {
100            return wantarray ? ($nan, $nan) : $nan;
101        } else {
102            if (($x <=> 0) == ($y <=> 0)) {
103                return wantarray ? ($inf, $nan) : $inf;
104            } else {
105                return wantarray ? (-$inf, $nan) : -$inf;
106            }
107        }
108    }
109
110    # Denominator is +/- infinity, and the numerator is finite.
111    #
112    # Core Perl:    5 %  Inf =    5
113    #              -5 % -Inf =   -5
114    #              -5 %  Inf =   -5
115    #               5 % -Inf =    5
116
117    if (isinf($y)) {
118        return wantarray ? (0, $x) : 0;
119    }
120
121    # Do a truncated division.
122
123    my $q = int($x / $y);
124    my $r = $x - $y * $q;
125
126    return wantarray ? ($q, $r) : $q;
127}
128
129# Tests where the invocand and the argument are two different objects.
130
131#for my $num (-20 .. 20) {
132#    for my $den (-20 .. -1, 1 .. 20) {
133for my $num (-$inf, -20 .. 20, $inf, $nan) {
134    for my $den (-$inf, -20 .. 20, $inf, $nan) {
135
136        # Compute expected output values.
137
138        my ($quo, $rem) = tdiv($num, $den);
139
140        #######################################################################
141        # btdiv() in list context.
142        #######################################################################
143
144        {
145            note(qq|\n(\$quo, \$rem) = | .
146                 qq|Math::BigInt -> new("$num") -> btdiv("$den")\n\n|);
147
148            # Input values as objects.
149
150            my $mbi_num = Math::BigInt -> new("$num");
151            my $mbi_den = Math::BigInt -> new("$den");
152
153            # Get addresses for later tests.
154
155            my ($mbi_num_addr, $mbi_den_addr);
156            $mbi_num_addr = refaddr($mbi_num) if $scalar_util_ok;
157            $mbi_den_addr = refaddr($mbi_den) if $scalar_util_ok;
158
159            # Compute actual output values.
160
161            my ($mbi_quo, $mbi_rem) = $mbi_num -> btdiv($mbi_den);
162
163            # Check classes.
164
165            is(ref($mbi_num), 'Math::BigInt',
166               "class of numerator is still Math::BigInt");
167            is(ref($mbi_den), 'Math::BigInt',
168               "class of denominator is still Math::BigInt");
169
170            is(ref($mbi_quo), 'Math::BigInt',
171               "class of quotient is Math::BigInt");
172            is(ref($mbi_rem), 'Math::BigInt',
173               "class of remainder is Math::BigInt");
174
175            # Check values.
176
177            is($mbi_quo, pl2mbi($quo), "$num / $den = $quo");
178            is($mbi_rem, pl2mbi($rem), "$num % $den = $rem");
179
180            is($mbi_den, pl2mbi($den), "value of denominator has not change");
181
182            # Check addresses.
183
184            my ($mbi_quo_addr, $mbi_rem_addr);
185            $mbi_quo_addr = refaddr($mbi_quo) if $scalar_util_ok;
186            $mbi_rem_addr = refaddr($mbi_rem) if $scalar_util_ok;
187
188          SKIP: {
189                skip "Scalar::Util not available", 2 unless $scalar_util_ok;
190
191                is($mbi_quo_addr, $mbi_num_addr,
192                   "the quotient object is the numerator object");
193
194                ok($mbi_rem_addr != $mbi_num_addr &&
195                   $mbi_rem_addr != $mbi_den_addr &&
196                   $mbi_rem_addr != $mbi_quo_addr,
197                   "the remainder object is neither the numerator," .
198                   " denominator, nor quotient object");
199            }
200        }
201
202        #######################################################################
203        # btdiv() in scalar context.
204        #######################################################################
205
206        {
207            note(qq|\n\$quo = | .
208                 qq|Math::BigInt -> new("$num") -> btdiv("$den")\n\n|);
209
210            # Input values as objects.
211
212            my $mbi_num = Math::BigInt -> new("$num");
213            my $mbi_den = Math::BigInt -> new("$den");
214
215            # Get addresses for later tests.
216
217            my ($mbi_num_addr, $mbi_den_addr);
218            $mbi_num_addr = refaddr($mbi_num) if $scalar_util_ok;
219            $mbi_den_addr = refaddr($mbi_den) if $scalar_util_ok;
220
221            # Compute actual output values.
222
223            my $mbi_quo = $mbi_num -> btdiv($mbi_den);
224
225            # Check classes.
226
227            is(ref($mbi_num), 'Math::BigInt',
228               "class of numerator is still Math::BigInt");
229            is(ref($mbi_den), 'Math::BigInt',
230               "class of denominator is still Math::BigInt");
231
232            is(ref($mbi_quo), 'Math::BigInt',
233               "class of quotient is Math::BigInt");
234
235            # Check values.
236
237            is($mbi_quo, pl2mbi($quo), "$num / $den = $quo");
238
239            is($mbi_den, pl2mbi($den), "value of numerator has not change");
240
241            # Check addresses.
242
243            my $mbi_quo_addr;
244            $mbi_quo_addr = refaddr($mbi_quo) if $scalar_util_ok;;
245
246          SKIP: {
247                skip "Scalar::Util not available", 1 unless $scalar_util_ok;
248
249                is($mbi_quo_addr, $mbi_num_addr,
250                   "the quotient object is the numerator object");
251            }
252        }
253
254        #######################################################################
255        # btmod() (scalar context only).
256        #######################################################################
257
258        {
259            note(qq|\n\$quo = | .
260                 qq|Math::BigInt -> new("$num") -> btmod("$den")\n\n|);
261
262            # Input values as objects.
263
264            my $mbi_num = Math::BigInt -> new("$num");
265            my $mbi_den = Math::BigInt -> new("$den");
266
267            # Get addresses for later tests.
268
269            my ($mbi_num_addr, $mbi_den_addr);
270            $mbi_num_addr = refaddr($mbi_num) if $scalar_util_ok;
271            $mbi_den_addr = refaddr($mbi_den) if $scalar_util_ok;
272
273            # Compute actual output values.
274
275            my $mbi_rem = $mbi_num -> btmod($mbi_den);
276
277            # Check classes.
278
279            is(ref($mbi_num), 'Math::BigInt',
280               "class of numerator is still Math::BigInt");
281            is(ref($mbi_den), 'Math::BigInt',
282               "class of denominator is still Math::BigInt");
283
284            is(ref($mbi_rem), 'Math::BigInt',
285               "class of remainder is Math::BigInt");
286
287            # Check values.
288
289            is($mbi_rem, pl2mbi($rem), "$num % $den = $rem");
290
291            is($mbi_den, pl2mbi($den), "value of denominator has not change");
292
293            # Check addresses.
294
295            my $mbi_rem_addr;
296            $mbi_rem_addr = refaddr($mbi_rem) if $scalar_util_ok;
297
298          SKIP: {
299                skip "Scalar::Util not available", 1 unless $scalar_util_ok;
300
301                is($mbi_rem_addr, $mbi_num_addr,
302                   "the remainder object is the numerator object");
303            }
304        }
305    }
306}
307
308# Tests where the invocand and the argument is the same object.
309
310for my $num (-$inf, -20 .. -1, 1 .. 20, $inf, $nan) {
311
312    # Compute expected output values.
313
314    my ($quo, $rem) = tdiv($num, $num);
315
316    #######################################################################
317    # btdiv() in list context.
318    #######################################################################
319
320    {
321        note(qq|\n\$x = Math::BigInt -> new("$num"); | .
322             qq|(\$quo, \$rem) = \$x -> btdiv("\$x")\n\n|);
323
324        # Input values as objects.
325
326        my $mbi_num = Math::BigInt -> new("$num");
327
328        # Get addresses for later tests.
329
330        my $mbi_num_addr;
331        $mbi_num_addr = refaddr($mbi_num) if $scalar_util_ok;
332
333        # Compute actual output values.
334
335        my ($mbi_quo, $mbi_rem) = $mbi_num -> btdiv($mbi_num);
336
337        # Check classes.
338
339        is(ref($mbi_num), 'Math::BigInt',
340           "class of numerator is still Math::BigInt");
341
342        is(ref($mbi_quo), 'Math::BigInt',
343           "class of quotient is Math::BigInt");
344        is(ref($mbi_rem), 'Math::BigInt',
345           "class of remainder is Math::BigInt");
346
347        # Check values.
348
349        is($mbi_quo, pl2mbi($quo), "$num / $num = $quo");
350        is($mbi_rem, pl2mbi($rem), "$num % $num = $rem");
351
352        # Check addresses.
353
354        my ($mbi_quo_addr, $mbi_rem_addr);
355        $mbi_quo_addr = refaddr($mbi_quo) if $scalar_util_ok;
356        $mbi_rem_addr = refaddr($mbi_rem) if $scalar_util_ok;
357
358        is($mbi_quo_addr, $mbi_num_addr,
359           "the quotient object is the numerator object");
360
361      SKIP: {
362            skip "Scalar::Util not available", 1 unless $scalar_util_ok;
363
364            ok($mbi_rem_addr != $mbi_num_addr &&
365               $mbi_rem_addr != $mbi_quo_addr,
366               "the remainder object is neither the numerator," .
367               " denominator, nor quotient object");
368        }
369    }
370
371    #######################################################################
372    # btdiv() in scalar context.
373    #######################################################################
374
375    {
376        note(qq|\n\$x = Math::BigInt -> new("$num"); | .
377             qq|\$quo = \$x -> btdiv(\$x)\n\n|);
378
379        # Input values as objects.
380
381        my $mbi_num = Math::BigInt -> new("$num");
382
383        # Get addresses for later tests.
384
385        my $mbi_num_addr;
386        $mbi_num_addr = refaddr($mbi_num) if $scalar_util_ok;
387
388        # Compute actual output values.
389
390        my $mbi_quo = $mbi_num -> btdiv($mbi_num);
391
392        # Check classes.
393
394        is(ref($mbi_num), 'Math::BigInt',
395           "class of numerator is still Math::BigInt");
396
397        is(ref($mbi_quo), 'Math::BigInt',
398           "class of quotient is Math::BigInt");
399
400        # Check values.
401
402        is($mbi_quo, pl2mbi($quo), "$num / $num = $quo");
403
404        # Check addresses.
405
406        my $mbi_quo_addr;
407        $mbi_quo_addr = refaddr($mbi_quo) if $scalar_util_ok;
408
409      SKIP: {
410            skip "Scalar::Util not available", 1 unless $scalar_util_ok;
411
412            is($mbi_quo_addr, $mbi_num_addr,
413               "the quotient object is the numerator object");
414        }
415    }
416
417
418    #######################################################################
419    # btmod() (scalar context only).
420    #######################################################################
421
422    {
423        note(qq|\n\$x = Math::BigInt -> new("$num") | .
424             qq|\$quo = \$x -> btmod(\$x)\n\n|);
425
426        # Input values as objects.
427
428        my $mbi_num = Math::BigInt -> new("$num");
429
430        # Get addresses for later tests.
431
432        my $mbi_num_addr;
433        $mbi_num_addr = refaddr($mbi_num) if $scalar_util_ok;
434
435        # Compute actual output values.
436
437        my $mbi_rem = $mbi_num -> btmod($mbi_num);
438
439        # Check classes.
440
441        is(ref($mbi_num), 'Math::BigInt',
442           "class of numerator is still Math::BigInt");
443
444        is(ref($mbi_rem), 'Math::BigInt',
445           "class of remainder is Math::BigInt");
446
447        # Check values.
448
449        is($mbi_rem, pl2mbi($rem), "$num % $num = $rem");
450
451        # Check addresses.
452
453        my $mbi_rem_addr;
454        $mbi_rem_addr = refaddr($mbi_rem) if $scalar_util_ok;
455
456      SKIP: {
457            skip "Scalar::Util not available", 1 unless $scalar_util_ok;
458
459            is($mbi_rem_addr, $mbi_num_addr,
460               "the remainder object is the numerator object");
461        }
462    }
463}
464