#!perl -w
# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl Devel-Arena.t'

#########################

# change 'tests => 1' to 'tests => last_test_to_print';

use Test;
BEGIN {
  my $tests = 129;
  $tests -= 5 if $] < 5.008;
  plan tests => $tests;
}
use Devel::Arena;
use Config;
ok(1); # If we made it this far, we're ok.

#########################

# Insert your test code below, the Test::More module is use()ed here so read
# its man page ( perldoc Test::More ) for help writing this test script.

my $stats = Devel::Arena::sv_stats();
ok(ref $stats, "HASH");
foreach (sort keys %$stats) {
  my $val = $stats->{$_};
  print "# $_ $val\n";
  if (ref $val eq 'HASH') {
    local $^W = 0;
    foreach my $key (sort {$a <=> $b || $a cmp $b} keys %$val) {
      print "#   $key  \t$val->{$key}\n";
    }
  }
}
ok($stats->{arenas}, qr/^\d+$/);
ok($stats->{total_slots}, qr/^\d+$/);
ok($stats->{free}, qr/^\d+$/);
ok($stats->{fakes}, qr/^\d+$/);
ok($stats->{'sizeof(SV)'}, qr/^\d+$/);
ok($stats->{'sizeof(SV)'} < 128);
ok($stats->{'nice_chunk_size'}, qr/^\d+$/);

ok($stats->{free} <= $stats->{total_slots});
ok($stats->{fakes} <= $stats->{arenas});

ok(ref $stats->{sizes}, 'HASH');

my $bad = 0;
foreach (values %{$stats->{sizes}}) {
  $bad++ unless /^\d+$/;
}
ok($bad, 0, "All the sizes are numbers");

ok(ref $stats->{types}, 'HASH');
# There should be at least 1 PV
ok($stats->{types}{IV}, qr/^\d+$/);

# PVHV returns more detailed stats
ok(ref $stats->{types}{PVHV}, 'HASH');
ok($stats->{types}{PVHV}{total}, qr/^\d+$/);
ok($stats->{types}{PVHV}{has_eiter}, qr/^\d+$/);

ok(ref $stats->{types}{PVHV}{names}, 'HASH');

my $fail = 0;
my $names;
while (my ($name, $count) = each %{$stats->{types}{PVHV}{names}}) {
  $names += $count;
  if ($count !~ qr/^\d+$/) {
    $fail++;
    print STDERR "# '$name' => '$count'\n";
  }
}
ok ($fail, 0);
# Not all the hashes are stashes
ok($names < $stats->{types}{PVHV}{total});

# There will always be a MG entry
ok(ref $stats->{types}{PVHV}{mg}, 'HASH');
# There will always be at least one has with no magic (as we're using them)
ok($stats->{types}{PVHV}{mg}{0}, qr/^\d+$/);

foreach my $thing (map {$_ . 'shared_keys'} '', qw(un symtab_ symtab_un)) {
    my $target = $stats->{types}{PVHV}{$thing};
    ok(ref $target, 'HASH', $thing);
    foreach my $key (qw(total keys keylen)) {
	ok($target->{$key}, qr/^\d+$/);
    }
}
ok($stats->{types}{PVHV}{symtab_unshared_keys}{total}, 0,
   "Symbol tables should all be using shared hash keys");
ok($stats->{types}{PVHV}{symtab_shared_keys}{total}, $names,
   "Found all the symbol tables");
# The shared string table doesn't share keys.
ok($stats->{types}{PVHV}{unshared_keys}{total} > 0);


foreach my $type (qw(PVHV PVMG PVAV)) {
  my $total;
  $total += $_ foreach (values %{$stats->{types}{$type}{mg}});
  # we counted every item?
  ok($total, $stats->{types}{$type}{total});
}

ok($stats->{types}{PVAV}{has_arylen}, qr/^\d+$/);

ok(ref $stats->{types}{PVIO}, 'HASH');
ok($stats->{types}{PVIO}{total}, qr/^\d+$/);
ok($stats->{types}{PVIO}{has_stash}, qr/^\d+$/);

ok(ref $stats->{types}{PVGV}, 'HASH');
ok(ref $stats->{types}{PVGV}{objects}, 'HASH');
ok($stats->{types}{PVGV}{objects}{IO}, qr/^\d+$/);
ok(ref $stats->{types}{PVGV}{thingies}, 'HASH');
my %count;
foreach (qw(SCALAR ARRAY HASH CODE IO)) {
  ok(ref $stats->{types}{PVGV}{thingies}{$_}, 'HASH');
  my $fail = 0;
  while (my ($type, $count) = each %{$stats->{types}{PVGV}{thingies}{$_}}) {
    if ($count !~ /^\d+$/) {
      $fail++;
      print STDERR "# '$type' => '$count'\n";
    }
    $count{$type} += $count
  }
  ok ($fail, 0);
}
# Every IO is an object
ok($stats->{types}{PVGV}{objects}{IO}, $count{PVIO});

ok($stats->{types}{PVGV}{null_name}, qr/^\d+$/);
# Our exported subroutine should be in there somwhere.
ok($stats->{types}{PVGV}{names}{sv_stats}, qr/^\d+$/);
# As should Test's &ok
ok($stats->{types}{PVGV}{names}{ok}, qr/^\d+$/);

ok($stats->{types}{PVGV}{total}, qr/^\d+$/);
{
  my $null_gp;
  my $gps;
  my $fail = 0;
  while (my ($package, $count) = each %{$stats->{types}{PVGV}{null_gp}}) {
    if ($count !~ /^\d+$/) {
      $fail++;
      print STDERR "# '$package' => '$count'\n";
    }
    $null_gp += $count;
  }
  ok($fail, 0);

  $fail = 0;
  while (my ($gp_refcnt, $num_gv) = each %{$stats->{types}{PVGV}{gp_refcnt}}) {
    if ($gp_refcnt !~ /^\d+$/ or $num_gv !~ /^\d+$/) {
      $fail++;
      print STDERR "# '$gp_refcnt' => '$num_gv'\n";
    }
    $gps += $num_gv;
  }
  ok($fail, 0);

  ok($gps + $null_gp, $stats->{types}{PVGV}{total}, "GPs tally with GVs");

  BEGIN {*snap = \*spmamp; *gurgle = \*snap; $spmamp++}

  # There should be at least one GP with a refcnt of 3.
  ok($stats->{types}{PVGV}{gp_refcnt}{3});
}


ok(ref $stats->{PVX}, 'HASH');
foreach $type ('normal', $] >= 5.008 ? 'shared hash key' : ()) {
    print "# PVX $type\n";
    ok(ref $stats->{PVX}{$type}, 'HASH');
    foreach my $key (qw 'length allocated total') {
	ok($stats->{PVX}{$type}{$key}, qr/^\d+$/);
    }
}

ok($stats->{PVX}{normal}{allocated}
   > $stats->{PVX}{normal}{total} + $stats->{PVX}{normal}{'length'});
ok($stats->{PVX}{'shared hash key'}{allocated} == 0) if $] >= 5.008;

sub oryx () {
  # Our filename
  (caller)[1];
}
sub klortho ($@%) {
}

ok($stats->{types}{PVCV}{prototypes}{''}, qr/^\d+$/);
ok($stats->{types}{PVCV}{prototypes}{'$@%'}, qr/^\d+$/);

foreach my $type (qw(PVCV PVFM)) {
  ok(ref $stats->{types}{$type}{files}, 'HASH');
  my $fail = 0;
  my $total;
  while (my ($name, $count) = each %{$stats->{types}{$type}{files}}) {
    if ($count !~ /^\d+$/) {
      $fail++;
      print STDERR "# $type '$name' => '$count'\n";
    }
    $total += $count;
  }
  ok($fail, 0);

  my $null = $stats->{types}{$type}{"NULL files"};
  ok($null, qr/^\d+$/, "$type NULL files is a number");

  ok($total + $null, $stats->{types}{$type}{total}, "All $type accounted for");
}

# We define 2 subroutines
ok($stats->{types}{PVCV}{files}{&oryx}, 2);

format BLINK =
.

# And 1 format
ok($stats->{types}{PVFM}{files}{&oryx}, 1);

# For now this is Cut & Paste
# Also we don't have totals for GPs easily accessible.
{
  my $fail = 0;
  while (my ($name, $count) = each %{$stats->{"gp files"}}) {
    if ($count !~ /^\d+$/) {
      $fail++;
      print STDERR "# '$name' => '$count'\n";
    }
  }
  ok($fail, 0);

  my $null = $stats->{"gp NULL files"};
  ok($null, qr/^\d+$/, "gp NULL files is a number");

}


ok(ref $stats->{'shared string scalars'}, 'HASH');


ok(ref $stats->{magic}, 'HASH');
foreach my $type (qw (e s I)) {
  my $magic = $stats->{magic}{$type};
  print "# Magic $type\n";
  ok(ref $magic, 'HASH');
  ok($magic->{'total'}, qr/^\d+$/);
  exists $magic->{'has ptr'} ? ok($magic->{'has ptr'}, qr/^\d+$/) : ok(1);
  exists $magic->{'has obj'} ? ok($magic->{'has obj'}, qr/^\d+$/) : ok(1);
  foreach my $key (qw(len flags)) {
    my $sum = 0;
    while (my ($len, $count) = each %{$magic->{$key}}) {
      $sum += $count;
    }
    ok($sum, $magic->{'total'});
  }

  my $sum = 0;
  while (my ($len, $count) = each %{$magic->{'vtable'}}) {
    $sum += $count;
  }
  ok($sum <= $magic->{'total'});
}

################

my $nostorable = "Storable is not installed";
unless (eval {
    require Storable;
    $nostorable = "";
    1;
}) {
    die $@ unless $@ =~ /Can't locate Storable/;
}


my $morestats = $nostorable || Devel::Arena::_write_stats_at_END();

if (@ARGV) {
    eval { require Data::Dumper };
    if ($@) {
	print "# no Data::Dumper in this build\n";
    }
    else {
	print "# displaying Devel::Arena output\n";
	Data::Dumper->import;
	# Avoid used only once warnings.
	$Data::Dumper::Sortkeys = $Data::Dumper::Sortkeys = 1;
	$Data::Dumper::Indent = $Data::Dumper::Indent = 1;
	print Dumper($morestats);
    }
}

skip($nostorable, ref $morestats->{info}, 'HASH');
skip($nostorable, ref $morestats->{info}{args}, 'ARRAY');
skip($nostorable, ref $morestats->{info}{inc}, 'ARRAY');

my $sizes = Devel::Arena::sizes();
ok(ref $sizes, "HASH");
ok($sizes->{'void *'}, $Config{ptrsize});
ok($sizes->{'hek_key offset'}, qr/^\d+$/);
my $sst = Devel::Arena::shared_string_table();
ok(ref $sst, "HASH");
ok($sst->{main}, qr/^\d+$/);
my $hek_size = Devel::Arena::HEK_size("perl rocks");
ok($hek_size > (length ("perl rocks") + $sizes->{'hek_key offset'}));