The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
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)");
}