use strict;
use warnings;
use Test::More;
BEGIN { use_ok('Math::SimpleHisto::XS') };
use lib 't/lib', 'lib';
use Test_Functions;
my $h = Math::SimpleHisto::XS->new(nbins => 23, min => 13.1, max => 99.2);
$h->fill(20.11, 12.4);
$h->fill(29.31, 123);
$h->fill(59., 59.);
$h->fill(32.91, 9,);
$h->fill(89.01, -2);
$h->fill(99.01, 1000);
$h->fill(59.01, -5);
$h->set_overflow(12.);
$h->set_underflow(1.);
my $h_var = Math::SimpleHisto::XS->new(bins => [132., 133., 139, 141.1, 150.9, 200.]);
$h_var->fill(133.11, 12.4);
$h_var->fill(199.31, 123);
$h_var->fill(151, 59.);
$h_var->fill(140, 9,);
$h_var->fill(89, -2);
$h_var->fill(100000, 1000);
$h_var->fill(151, -5);
$h_var->set_overflow(12.);
$h_var->set_underflow(1.);
my @test_histos = (
[$h, 'constant bins'],
[$h_var, 'variable bins'],
);
# simple dump
test_dump_undump($_->[0], 'simple', $_->[1]) for @test_histos;
# native_pack
test_dump_undump($_->[0], 'native_pack', $_->[1]) for @test_histos;
# Storable
SKIP: {
if (not eval "require Storable; 1;") {
diag("Could not load Storable, not testing Storable related features");
last SKIP;
}
foreach my $test_histo (@test_histos) {
my ($h, $name) = @$test_histo;
my $cloned = Storable::thaw(Storable::nfreeze($h));
isa_ok($cloned, 'Math::SimpleHisto::XS');
histo_eq($h, $cloned, "Storable thaw(nfreeze()) ($name)");
$cloned = Storable::dclone($h);
isa_ok($cloned, 'Math::SimpleHisto::XS');
histo_eq($h, $cloned, "Storable dclone ($name)");
}
}
# JSON
SKIP: {
if (not defined $Math::SimpleHisto::XS::JSON) {
diag("Could not load JSON support module, not testing JSON related features");
last SKIP;
}
diag("Using $Math::SimpleHisto::XS::JSON_Implementation for testing JSON support");
test_dump_undump($_->[0], 'json', $_->[1]) for @test_histos;
}
# YAML
SKIP: {
if (not eval "require YAML::Tiny; 1;") {
diag("Could not load YAML::Tiny, not testing YAML::Tiny related features");
last SKIP;
}
test_dump_undump($_->[0], 'yaml', $_->[1]) for @test_histos;
}
if (grep {/^--print-dumps$/} @ARGV) {
open my $fh, ">", "dumps.$Math::SimpleHisto::XS::VERSION.txt"
or die $!;
binmode $fh;
foreach my $dump_type (qw(simple native_pack json yaml)) {
print $fh $dump_type, ':', $h->dump($dump_type), "\n\n";
}
close $fh;
}
done_testing();
sub test_dump_undump {
my $histo = shift;
my $type = shift;
my $name = shift;
my $dump = $histo->dump($type);
ok(defined($dump), "'$type' dump is defined ($name)");
my $clone = Math::SimpleHisto::XS->new_from_dump($type, $dump);
isa_ok($clone, 'Math::SimpleHisto::XS');
histo_eq($histo, $clone, "'$type' histo dump is same as original ($name)");
}