#!/usr/bin/perl
#
# round.t
#
# This test compares two Rlists compiled with different compile options.
#
# $Writestamp: 2007-12-05 19:58:25 eh2sper$
# $Compile: perl -M'constant standalone => 1' round.t$
use strict;
use Test;
BEGIN { plan tests => 7 + 1203 }
BEGIN { unshift @INC, '../lib' if $constant::declared{'main::standalone'} }
use Data::Rlist qw/:options/;
our $Pi = 3.14159_26535_89793_23846_26433_83279_50288_41971_69399_37510;
#########################
{
ok(${[KeelhaulData([-.00057260], complete_options({precision => 4}, 'squeezed'))]->[1]} eq '(-0.0006)');
ok(OutlineData(sub{sub{\\'Greetings, earthlings!'}}, { code_refs => 1 }) eq '"Greetings, earthlings!"');
ok(OutlineData(0.994, { precision => 2 }) == 0.99);
ok(OutlineData(0.0010710000000000, { precision => 2 }) eq '0.00');
ok(Data::Rlist::round($Pi) == 3.141593); # default accuracy is 6 places
ok(Data::Rlist::round($Pi, 15) == 3.141592653589793);
my ($deep_copy, $as_text) = Data::Rlist->new(-data => [-.00057260])->keelhaul({precision => 4});
ok($deep_copy->[0] == -0.0006);
my $quote = \\"And death shall have no dominion. (Dylan Thomas)";
my $data = KeelhaulData($quote);
ok(exists $data->{$$$quote});
$quote = sub { sub { q'The time to repair the roof is when the sun is shining. John F. Kennedy' } };
$data = KeelhaulData($quote);
ok([keys %$data]->[0] eq '?CODE?'); # code_refs shall be disabled
$data = KeelhaulData($quote, { code_refs => 1 });
ok(exists $data->{$quote->()->()});
}
#########################
{
my(%A, %B);
my %org =
(
messages => <<___,
SectorModel 1.8.14-RELEASE multi-threaded
___
db_instance => 2006073104,
runtime_in_seconds => 34471,
hello => sub { 'Greetings, earthlings!' },
numerical_precisions =>
{
standard_deviation => 703320386.52728247642517,
expected_loss_diff => 0.00193048336651,
Pi => $Pi
},
foo => 'bar',
numbers =>
[
.23E-10, # a very small number
3.14_15_92, # a very important number
4_294_967_296, # underscore for legibility
0xff, # hex
0xdead_beef, # more hex
0377, # octal (only numbers, begins with 0)
0b011011, # binary
0b1010_0110, # binary, maybe more legible
[ 0.00000000000000, 0.00000000001495,
0.12674123095023, 0.99980376022990 ]
],
"\\ü" => [ "ßöü^!", ";\"\'^" ]
);
my $info;
our($prea, $preb, $scntfc, $oo, $prec, $to_string);
our($opta, $optb);
our @predefd = qw/default string squeezed outlined fast/;
our $tempfile = "$0.tmp";
our $obj;
our $stop = sub($$) {
die "$_[0] != $_[1] $prea<=>$preb oo=$oo prec=$prec ${\($scntfc ? 'scientific' : '')}\n"
};
sub getab(@) {
my($a, $b) = (\%A, \%B); $info = '';
foreach (@_) {
$info.= "$_ => ";
$a = exists $a->{$_} ? $a->{$_} : $stop->("$info: not exists in \%A\n");
$b = exists $b->{$_} ? $b->{$_} : $stop->("$info: not exists in \%B\n");
} ($a, $b)
}
sub okcmps(@) { my($a, $b) = getab(@_); ok($a eq $b) || $stop->($a, $b); }
sub okcmpn(@) { my($a, $b) = getab(@_); ok($a == $b) || $stop->($a, $b); }
sub okdata($$) { my($a, $b) = @_; ok(not CompareData($a, $b)); }
sub compopts($;$$) {
my($s, $prec, $scn) = @_;
return $s if (not ref $s) && $s =~ /^(fast|perl)$/;
my $opts = Data::Rlist::complete_options($s);
$opts->{precision} = $prec;
$opts->{scientific} = $scn;
$opts->{auto_quote} = $scn;
$opts
}
foreach $prea (@predefd) {
foreach $preb (reverse @predefd) {
next if $prea eq $preb;
foreach $oo (0..1) {
$to_string = !$oo;
$scntfc = $oo;
foreach $prec (undef, qw/0 2 12 15/) {
# Get compile-options that determine how to make %A and %B
# from %org. For non-refinable compile options "fast" and
# "perl" clear the precision for both option sets
# (undef). Also, when one set uses a precision of 0 use
# this precision also in the other set. Reason: numbers
# with different precisions are not comparable.
$opta = compopts($prea, $prec, $scntfc);
$optb = compopts($preb, $prec, $scntfc);
if ((not ref $opta) or
(not ref $optb) or
(not defined $opta->{precision}) or
(not defined $optb->{precision})) {
# Note that from all predefined option sets only
# "squeezed" defines a precision.
$opta = compopts($opta, undef, $scntfc);
$optb = compopts($optb, undef, $scntfc);
} elsif ($opta->{precision} == 0) {
$optb = compopts($optb, 0, $scntfc)
} elsif ($optb->{precision} == 0) {
$opta = compopts($opta, 0, $scntfc);
}
# Make %A from %org by writing the hash to disk (with
# $opta), then reload it. Make %B from %org by keelhauling
# the hash (with $optb).
if ($oo) {
# Object-oriented interface.
$obj = new Data::Rlist(-data => \%org, -options => $opta);
if ($to_string) {
$obj->set(-input => $obj->write);
} else {
$obj->set(-input => $tempfile, -output => $tempfile);
$obj->write;
}
%A = %{$obj->read};
%B = %{$obj->keelhaul($optb)};
} else {
# Functional interface.
if ($to_string) {
%A = %{Data::Rlist::read_string(Data::Rlist::write_string(\%org, $opta))};
} else {
Data::Rlist::write(\%org, $tempfile, $opta);
%A = %{Data::Rlist::read($tempfile)};
}
%B = %{KeelhaulData(\%org, $optb)};
}
# Compare if %A and %B are equal (they should).
okdata(\%A, \%B);
okcmps(qw/db_instance/);
okcmps(qw/messages/);
okcmpn(qw/runtime_in_seconds/);
okcmpn(qw/numerical_precisions expected_loss_diff/);
okcmpn(qw/numerical_precisions standard_deviation/);
}
}
}
}
}
### Local Variables:
### buffer-file-coding-system: iso-latin-1
### End: