#!/usr/bin/perl

use strict;
use warnings;
use feature qw( say switch );
no if $] >= 5.017011, warnings => 'experimental::smartmatch';

use Devel::MAT;

my $df = Devel::MAT->load( $ARGV[0] // die "Need dumpfile\n" )->dumpfile;

# peeking
my %roots;
foreach ( keys %{ $df } ) {
   next unless m/^(.*)_at$/;
   my $root = $1;
   my $addr = $df->{$_} or next;

   $roots{$addr} = $root;

   next if $root eq "stack";

   $df->sv_at( $addr ) and next;

   printf "DF has no SV at root %s addr 0x%x\n", $root, $addr;
}

sub test_ptr
{
   my ( $sv, $name, $val ) = @_;

   my $addr = $val or return;     # skip NULL
   $roots{$addr} and return;      # known root
   $df->{heap}{$addr} and return; # known heap SV

   printf "SV %s has no %s SV at addr 0x%x\n", $sv->desc_addr, $name, $addr;
}

sub methods_of
{
   my ( $pkg ) = @_;

   no strict 'refs';
   my @syms = keys %{"${pkg}::"};
   return
      grep { *{"${pkg}::$_"}{CODE} } @syms,
      map { methods_of( $_ ) } @{"${pkg}::ISA"};
}

foreach my $sv ( $df->heap ) {
   foreach my $meth ( methods_of ref $sv ) {
      next unless $meth =~ m/^([^_].*)_at$/;
      my $outref = $1;

      if( $outref eq "elem" ) {
         test_ptr( $sv, "$outref [$_]", $sv->$meth( $_ ) ) for 0 .. $sv->elems-1;
      }
      elsif( $outref eq "value" ) {
         test_ptr( $sv, "$outref {$_}", $sv->$meth( $_ ) ) for $sv->keys;
      }
      else {
         test_ptr( $sv, $outref, $sv->$meth );
      }
   }
}