Math-BigInt/t/config.t
# -*- mode: perl; -*-
use strict;
use warnings;
use Test::More tests => 246;
use Math::BigInt lib => 'Calc';
use Math::BigFloat;
use Math::BigRat;
my $mbi = 'Math::BigInt';
my $mbf = 'Math::BigFloat';
my $mbr = 'Math::BigRat';
my @classes = ($mbi, $mbf, $mbr);
# Default configuration for all classes.
#
# config() can also return 'lib', 'lib_version', 'class', and 'version' but
# they are read-only.
my %defaults = (
'accuracy' => undef,
'precision' => undef,
'round_mode' => 'even',
'div_scale' => 40,
'trap_inf' => 0,
'trap_nan' => 0,
'upgrade' => undef,
'downgrade' => undef,
);
##############################################################################
# Test config() as a class method getter.
##############################################################################
for my $class (@classes) {
note <<"EOF";
Verify that $class -> config("key") works.
EOF
can_ok($class, 'config');
my %table = (%defaults,
# the following three are read-only
'lib' => 'Math::BigInt::Calc',
'lib_version' => $Math::BigInt::Calc::VERSION,
'class' => $class,
'version' => $Math::BigInt::VERSION,
);
# Test getting via the new style $class -> config($key).
subtest qq|New-style getter $class -> config("\$key")| => sub {
plan tests => scalar keys %table;
for my $key (sort keys %table) {
my $val = $table{$key};
note qq|\n$class -> config("$key")\n\n|;
is($class -> config($key), $val, qq|$class -> config("$key")|);
}
};
# Test getting via the old style $class -> config()->{$key}, which is still
# supported.
my $cfg = $class -> config();
is(ref($cfg), 'HASH', "ref() of output from $class -> config()");
subtest qq|Old-style getter $class -> config()->{"\$key"}| => sub {
plan tests => scalar keys %table;
for my $key (sort keys %table) {
my $val = $table{$key};
note qq|\n$class -> config() -> {$key}\n\n|;
is($cfg->{$key}, $val, qq|$class -> config()->{$key}|);
}
};
}
##############################################################################
# Test config() as a class method setter.
##############################################################################
# Alternative configuration. All values should be different from the default
# configuration. Note that in reality, both "accuracy" and "precision" cannot
# both be set simultaneously. This configuration is just for testing.
my %test = (
'accuracy' => 2,
'precision' => 3,
'round_mode' => 'zero',
'div_scale' => '100',
'trap_inf' => 1,
'trap_nan' => 1,
'upgrade' => 'Math::BigInt::SomeClass',
'downgrade' => 'Math::BigInt::SomeClass',
);
for my $class (@classes) {
note <<"EOF";
Verify that $class -> config("key" => value) works and that
it doesn't affect the configuration of other classes.
EOF
for my $key (sort keys %test) {
# Get the original value for restoring it later.
my $orig = $class -> config($key);
# Try setting the new value.
eval { $class -> config($key => $test{$key}); };
die $@ if $@;
# Verify that the value was set correctly.
is($class -> config($key), $test{$key},
qq|$class -> config("$key") is $test{$key}|);
# Verify that setting it in class $class didn't affect other classes.
for my $other (@classes) {
next if $other eq $class;
isnt($other -> config($key), $class -> config($key),
qq|$other -> config("$key") isn't affected by setting | .
qq|$class -> config("$key")|);
}
# Restore the value.
$class -> config($key => $orig);
# Verify that the value was restored.
is($class -> config($key), $orig,
qq|$class -> config("$key") reset to | .
(defined($orig) ? qq|"$orig"| : "undef"));
}
note <<"EOF";
Verify that $class -> config({"key" => value}) works and that
it doesn't affect the configuration of other classes.
EOF
for my $key (sort keys %test) {
# Get the original value for restoring it later.
my $orig = $class -> config($key);
# Try setting the new value.
eval { $class -> config({ $key => $test{$key} }); };
die $@ if $@;
# Verify that the value was set correctly.
is($class -> config($key), $test{$key},
qq|$class -> config("$key") is $test{$key}|);
# Verify that setting it in class $class didn't affect other classes.
for my $other (@classes) {
next if $other eq $class;
isnt($other -> config($key), $class -> config($key),
qq|$other -> config("$key") isn't affected by setting | .
qq|$class -> config("$key")|);
}
# Restore the value.
$class -> config($key => $orig);
# Verify that the value was restored.
is($class -> config($key), $orig,
qq|$class -> config("$key") reset to | .
(defined($orig) ? qq|"$orig"| : "undef"));
}
}
# Verify that setting via a hash doesn't modify the hash.
# In the %test configuration, both accuracy and precision are defined, which
# won't work, so set one of them to undef.
$test{accuracy} = undef;
for my $class (@classes) {
note <<"EOF";
Verify that $class -> config({key1 => val1, key2 => val2, ...})
doesn't modify the hash ref argument.
EOF
subtest "Verify that $class -> config(\$cfg) doesn't modify \$cfg" => sub {
plan tests => 2 * keys %test;
# Make copy of the configuration hash and use it as input to config().
my $cfg = { %test };
eval { $class -> config($cfg); };
die $@ if $@;
# Verify that the configuration hash hasn't been modified.
for my $key (sort keys %test) {
ok(exists $cfg->{$key}, qq|existens of \$cfg->{"$key"}|);
is($cfg->{$key}, $test{$key}, qq|value of \$cfg->{"$key"}|);
}
};
}
# Special testing of setting both accuracy and precision simultaneouly with
# config(). This didn't work correctly before.
for my $class (@classes) {
note <<"EOF";
Verify that $class -> config({accuracy => \$a, precision => \$p})
works as intended.
EOF
$class -> config({"accuracy" => 4, "precision" => undef});
subtest qq|$class -> config({"accuracy" => 4, "precision" => undef})|
=> sub {
plan tests => 2;
is($class -> config("accuracy"), 4,
qq|$class -> config("accuracy")|);
is($class -> config("precision"), undef,
qq|$class -> config("precision")|);
};
$class -> config({"accuracy" => undef, "precision" => 5});
subtest qq|$class -> config({"accuracy" => undef, "precision" => 5})|
=> sub {
plan tests => 2;
is($class -> config("accuracy"), undef,
qq|$class -> config("accuracy")|);
is($class -> config("precision"), 5,
qq|$class -> config("precision")|);
};
}
# Test getting an invalid key (should croak).
note <<"EOF";
Verify behaviour when getting an invalid key.
EOF
for my $class (@classes) {
eval { $class -> config('some_garbage' => 1); };
like($@,
qr/ ^ Illegal \s+ key\(s\) \s+ 'some_garbage' \s+ passed \s+ to \s+ /x,
"Passing invalid key to $class -> config() causes an error.");
}
# Restore global configuration.
for my $class (@classes) {
my %config = %defaults;
$class -> config(%defaults);
}
##############################################################################
# Test config() as an instance method getter.
##############################################################################
# The following must be extended as global variables are moved into the OO
# interface. XXX
for my $class (@classes) {
note <<"EOF";
$class: Verify that \$x -> config("key") works.
EOF
my $x = $class -> bzero();
#my %table = %defaults;
my %table = map { $_ => $defaults{$_} } 'accuracy', 'precision';
# Test getting via $x -> config($key).
subtest qq|$class: Test getter \$x -> config("\$key") where \$x is a $class|
=> sub {
plan tests => 2;
for my $key (sort keys %table) {
my $val = $table{$key};
is($x -> config($key), $val, qq|\$x -> config("$key")|);
}
};
note <<"EOF";
$class: Verify that \$x -> config() works.
EOF
subtest qq|$class: Test that \$x -> config() where \$x is a $class|
=> sub {
plan tests => 3;
my $cfg = $x -> config();
cmp_ok(scalar(keys(%$cfg)), "==", 2,
qq|configuration hash has correct number of keys|);
for my $key ('accuracy', 'precision') {
ok(exists($cfg->{$key}), qq|configuration has contains key "$key"|);
}
};
}
##############################################################################
# Test config() as an instance method setter.
##############################################################################
# Alternative configuration. All values should be different from the default
# configuration. Note that in reality, both "accuracy" and "precision" cannot
# both be set simultaneously. This configuration is just for testing.
# At the moment, not all variables have been moved into the OO interface. XXX
%test = (
'accuracy' => 2,
'precision' => 3,
#'round_mode' => 'zero',
#'div_scale' => '100',
#'trap_inf' => 1,
#'trap_nan' => 1,
#'upgrade' => 'Math::BigInt::SomeClass',
#'downgrade' => 'Math::BigInt::SomeClass',
);
for my $class (@classes) {
note <<"EOF";
$class: Verify that \$x -> config("key" => value) works and that
it doesn't affect the configuration of other classes.
EOF
my $x = $class -> bone();
for my $key (sort keys %test) {
# Get the original value for restoring it later.
my $orig = $x -> config($key);
# Try setting the new value.
subtest "$class: \$x -> config($key => $test{$key})" => sub {
plan tests => 2;
eval { $x -> config($key => $test{$key}); };
die $@ if $@;
# Verify that the value was set correctly.
is($x -> config($key), $test{$key},
qq|$class: \$x -> config("$key") is $test{$key}|);
# Restore the value.
$x -> config($key => $orig);
# Verify that the value was restored.
is($x -> config($key), $orig,
qq|$class: \$x -> config("$key") reset to | .
(defined($orig) ? qq|"$orig"| : "undef"));
};
}
note <<"EOF";
$class: Verify that \$x -> config({"key" => value}) works and that
it doesn't affect the configuration of other classes.
EOF
for my $key (sort keys %test) {
# Get the original value for restoring it later.
my $orig = $x -> config($key);
# Try setting the new value.
subtest "$class: \$x -> config({ $key => $test{$key} })" => sub {
plan tests => 2;
eval { $x -> config({ $key => $test{$key} }); };
die $@ if $@;
# Verify that the value was set correctly.
is($x -> config($key), $test{$key},
qq|$class: \$x -> config("$key") is $test{$key}|);
# Restore the value.
$x -> config($key => $orig);
# Verify that the value was restored.
is($x -> config($key), $orig,
qq|\$x -> config("$key") reset to | .
(defined($orig) ? qq|"$orig"| : "undef"));
};
}
}
# Verify that setting via a hash doesn't modify the hash.
# In the %test configuration, both accuracy and precision are defined, which
# won't work, so set one of them to undef.
$test{accuracy} = undef;
for my $class (@classes) {
note <<"EOF";
$class: Verify that \$x -> config({key1 => val1, key2 => val2, ...})
doesn't modify the hash ref argument.
EOF
my $x = $class -> bone();
subtest "$class: Verify that \$x -> config(\$cfg) doesn't modify \$cfg"
=> sub {
plan tests => 2 * keys %test;
# Make copy of the configuration hash and use it as input to
# config().
#my $cfg = { %test };
my $cfg = { map { $_ => $test{$_} } 'accuracy', 'precision' };
eval { $x -> config($cfg); };
die $@ if $@;
# Verify that the configuration hash hasn't been modified.
for my $key (sort keys %test) {
ok(exists $cfg->{$key}, qq|existens of \$cfg->{"$key"}|);
is($cfg->{$key}, $test{$key}, qq|value of \$cfg->{"$key"}|);
}
};
}
# Special testing of setting both accuracy and precision simultaneouly with
# config(). This didn't work correctly before.
for my $class (@classes) {
note <<"EOF";
$class: Verify that \$x -> config({accuracy => \$a, precision => \$p})
works as intended.
EOF
my $x = $class -> bone();
$x -> config({"accuracy" => 4, "precision" => undef});
subtest qq|$class: \$x -> config({"accuracy" => 4, "precision" => undef})|
=> sub {
plan tests => 2;
is($x -> config("accuracy"), 4,
qq|\$x -> config("accuracy")|);
is($x -> config("precision"), undef,
qq|\$x -> config("precision")|);
};
$x -> config({"accuracy" => undef, "precision" => 5});
subtest qq|$class: \$x -> config({"accuracy" => undef, "precision" => 5})|
=> sub {
plan tests => 2;
is($x -> config("accuracy"), undef,
qq|\$x -> config("accuracy")|);
is($x -> config("precision"), 5,
qq|\$x -> config("precision")|);
};
}
# Test getting an invalid key (should croak).
note <<"EOF";
Verify behaviour when getting an invalid key.
EOF
for my $class (@classes) {
my $x = $class -> bone();
eval { $x -> config('some_garbage' => 1); };
like($@,
qr/ ^ Illegal \s+ key\(s\) \s+ 'some_garbage' \s+ passed \s+ to \s+ /x,
"$class: Passing invalid key to \$x -> config() causes an error.");
}