The Perl Toolchain Summit 2025 Needs You: You can help 🙏 Learn more

PJACKLAM / Math-BigInt-2.005002 / xt / author / bxxx-addr-in-3-out-1-mbi-mbf.t 

            

              
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112

              
# -*- mode: perl; -*-
use strict;
use warnings;
use Scalar::Util qw< refaddr >;
use Test::More;
# Not yet: bmodpow bmodinv
use Math::BigFloat;
my @num = qw< 1 2.5 4 4.5 7.5 8 9 Inf >;
@num = ((map { "-$_" } reverse @num), 0, @num, "NaN");
my @methods = qw< bmuladd >;
for my $method (@methods) {
    for my $downgrade (undef, "Math::BigInt") {
        for my $upgrade (undef, "Math::BigFloat") {
            my $title = "";
            if ($downgrade) {
                if ($upgrade) {
                    $title .= "upgrading and downgrading";
                } else {
                    $title .= "downgrading, but no upgrading";
                }
            } else {
                if ($upgrade) {
                    $title .= "upgrading, but no downgrading"
                } else {
                    $title .= "no upgrading or downgrading";
                }
            }
            for my $xclass ("Math::BigInt", "Math::BigFloat") {
                for my $yclass ("Math::BigInt", "Math::BigFloat", "") {
                    for my $zclass ("Math::BigInt", "Math::BigFloat", "") {
                        for my $xs (@num) {
                            for my $ys (@num) {
                                for my $zs (@num) {
                                    # Set default upgrading and downgrading.
                                    my $test;
                                    $test .= 'Math::BigInt -> upgrade(undef);';
                                    $test .= ' Math::BigFloat -> downgrade(undef);';
                                    # Append constructors.
                                    $test .= qq| \$x = $xclass -> new("$xs");|;
                                    if ($yclass) {
                                        $test .= qq| \$y = $yclass -> new("$ys");|
                                    } else {
                                        $test .= $ys =~ /^\+?inf$/i ? qq| \$y = 1e99**1e99;|
                                              :  $ys =~ /^\-inf$/i  ? qq| \$y = -(1e99**1e99);|
                                              :  $ys =~ /^nan$/i    ? qq| \$y = (1e99**1e99)-(1e99**1e99);|
                                              :                       qq| \$y = $ys;|;
                                    }
                                    if ($zclass) {
                                        $test .= qq| \$z = $zclass -> new("$zs");|
                                    } else {
                                        $test .= $zs =~ /^\+?inf$/i ? qq| \$z = 1e99**1e99;|
                                              :  $zs =~ /^\-inf$/i  ? qq| \$z = -(1e99**1e99);|
                                              :  $zs =~ /^nan$/i    ? qq| \$z = (1e99**1e99)-(1e99**1e99);|
                                              :                       qq| \$z = $zs;|;
                                    }
                                    # Get address.
                                    $test .= ' $xa = refaddr($x);';
                                    # Append upgrading and downgrading, if applicable.
                                    $test .= qq| Math::BigInt -> upgrade("$upgrade");|       if $upgrade;
                                    $test .= qq| Math::BigFloat -> downgrade("$downgrade");| if $downgrade;
                                    # Apply method call.
                                    $test .= qq| \$q = \$x -> $method(\$y, \$z);|;
                                    # Wrap test into a one-liner, which is
                                    # displayed before the test is run.
                                    my $note;
                                    $note .= q|perl -Ilib -MMath::BigFloat -MScalar::Util=refaddr -wle '|;
                                    $note .= $test;
                                    $note .= q|'|;
                                    note "\n", $note, "\n\n";
                                    subtest $test => sub {
                                        my ($x, $xa, $y, $z, $q);
                                        eval $test;
                                        is($@, '', '$@ is empty');
                                        is($xa, refaddr($q), 'refaddr($x) = refaddr($q)');
                                    };
                                }
                            }
                        }
                    }
                }
            }
        }
    }
}
done_testing();