1# -*- mode: perl; -*-
2
3use strict;
4use warnings;
5
6use Test::More tests => 126;
7
8# Test Math::BigInt->config(), Math::BigFloat->config(), and
9# Math::BigRat->config().
10
11use Math::BigInt lib => 'Calc';
12use Math::BigFloat;
13use Math::BigRat;
14
15my $mbi = 'Math::BigInt';
16my $mbf = 'Math::BigFloat';
17my $mbr = 'Math::BigRat';
18
19my @classes = ($mbi, $mbf, $mbr);
20
21# Default configuration.
22
23my %defaults = (
24  'accuracy'    => undef,
25  'precision'   => undef,
26  'round_mode'  => 'even',
27  'div_scale'   => 40,
28  'trap_inf'    => 0,
29  'trap_nan'    => 0,
30  'upgrade'     => undef,
31  'downgrade'   => undef,
32  'lib'         => 'Math::BigInt::Calc',
33  'lib_version' => $Math::BigInt::Calc::VERSION,
34);
35
36##############################################################################
37# Test config() as a getter.
38
39for my $class (@classes) {
40
41    note <<"EOF";
42
43Verify that $class->config("key") works.
44
45EOF
46
47    can_ok($class, 'config');
48
49    my %table = (%defaults, 'class' => $class);
50
51    # Test getting via the new style $class->config($key).
52
53    subtest qq|New-style getter $class->config("\$key")| => sub {
54        plan tests => scalar keys %table;
55
56        for my $key (sort keys %table) {
57            my $val = $table{$key};
58            is($class->config($key), $val, qq|$class->config("$key")|);
59        }
60    };
61
62    # Test getting via the old style $class->config()->{$key}, which is still
63    # supported:
64
65    my $cfg = $class->config();
66    is(ref($cfg), 'HASH', "ref() of output from $class->config()");
67
68    subtest qq|Old-style getter $class->config()->{"\$key"}| => sub {
69        plan tests => scalar keys %table;
70
71       for my $key (sort keys %table) {
72            my $val = $table{$key};
73            is($cfg->{$key}, $val, qq|$class->config()->{$key}|);
74        }
75    };
76
77    # Can set via hash ref?
78
79    $cfg = $class->config({ trap_nan => 1 });
80    is($cfg->{trap_nan}, 1, 'can set "trap_nan" to 1 via hash ref');
81
82    # Restore for later.
83
84    $cfg = $class->config({ trap_nan => 0 });
85    is($cfg->{trap_nan}, 0, 'can set "trap_nan" to 0 via hash ref');
86}
87
88##############################################################################
89# Test config() as a setter.
90
91# Alternative configuration. All values should be different from the default
92# configuration.
93
94my $test = {
95    accuracy   => 2,
96    precision  => 3,
97    round_mode => 'zero',
98    div_scale  => '100',
99    trap_inf   => 1,
100    trap_nan   => 1,
101    upgrade    => 'Math::BigInt::SomeClass',
102    downgrade  => 'Math::BigInt::SomeClass',
103};
104
105for my $class (@classes) {
106
107    note <<"EOF";
108
109Verify that $class->config("key" => value) works and that
110it doesn't affect the configuration of other classes.
111
112EOF
113
114    for my $key (sort keys %$test) {
115
116        # Get the original value for restoring it later.
117
118        my $orig = $class->config($key);
119
120        # Try setting the new value.
121
122        eval { $class->config($key => $test->{$key}); };
123        die $@ if $@;
124
125        # Verify that the value was set correctly.
126
127        is($class->config($key), $test->{$key},
128           qq|$class->config("$key") set to $test->{$key}|);
129
130        # Verify that setting it in class $class didn't affect other classes.
131
132        for my $other (@classes) {
133            next if $other eq $class;
134
135            isnt($other->config($key), $class->config($key),
136                 qq|$other->config("$key") isn't affected by setting | .
137                 qq|$class->config("$key")|);
138        }
139
140        # Restore the value.
141
142        $class->config($key => $orig);
143
144        # Verify that the value was restored.
145
146        is($class->config($key), $orig,
147           qq|$class->config("$key") reset to | .
148           (defined($orig) ? qq|"$orig"| : "undef"));
149    }
150}
151
152# Verify that setting via a hash doesn't modify the hash.
153
154# In the $test configuration, both accuracy and precision are defined, which
155# won't work, so set one of them to undef.
156
157$test->{accuracy} = undef;
158
159for my $class (@classes) {
160
161    note <<"EOF";
162
163Verify that $class->config({key1 => val1, key2 => val2, ...})
164doesn't modify the hash ref argument.
165
166EOF
167
168    subtest "Verify that $class->config(\$cfg) doesn't modify \$cfg" => sub {
169        plan tests => 2 * keys %$test;
170
171        # Make copy of the configuration hash and use it as input to config().
172
173        my $cfg = { %{ $test } };
174        eval { $class -> config($cfg); };
175        die $@ if $@;
176
177        # Verify that the configuration hash hasn't been modified.
178
179        for my $key (sort keys %$test) {
180            ok(exists $cfg->{$key}, qq|existens of \$cfg->{"$key"}|);
181            is($cfg->{$key}, $test->{$key}, qq|value of \$cfg->{"$key"}|);
182        }
183    };
184}
185
186# Special testing of setting both accuracy and precision simultaneouly with
187# config(). This didn't work correctly before.
188
189for my $class (@classes) {
190
191    note <<"EOF";
192
193Verify that $class->config({accuracy => \$a, precision => \$p})
194works as intended.
195
196EOF
197
198    $class -> config({"accuracy" => 4, "precision" => undef});
199
200    subtest qq|$class -> config({"accuracy" => 4, "precision" => undef})|
201      => sub {
202          plan tests => 2;
203
204          is($class -> config("accuracy"), 4,
205             qq|$class -> config("accuracy")|);
206          is($class -> config("precision"), undef,
207             qq|$class -> config("precision")|);
208      };
209
210    $class -> config({"accuracy" => undef, "precision" => 5});
211
212    subtest qq|$class -> config({"accuracy" => undef, "precision" => 5})|
213      => sub {
214          plan tests => 2;
215
216          is($class -> config("accuracy"), undef,
217             qq|$class -> config("accuracy")|);
218          is($class -> config("precision"), 5,
219             qq|$class -> config("precision")|);
220      };
221}
222
223# Test getting an invalid key (should croak)
224
225note <<"EOF";
226
227Verify behaviour when getting an invalid key.
228
229EOF
230
231for my $class (@classes) {
232    eval { $class->config('some_garbage' => 1); };
233    like($@,
234         qr/ ^ Illegal \s+ key\(s\) \s+ 'some_garbage' \s+ passed \s+ to \s+
235             $class->config\(\) \s+ at
236           /x,
237         "Passing invalid key to $class->config() causes an error.");
238}
239