The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/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->{heap}{$addr} and next;

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

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

   given( ref $val ) {
      when([ undef, '' ]) {
         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;
      }
      when( "ARRAY" ) {
         foreach my $idx ( 0 .. $#$val ) {
            test_ptr( $sv, "$name\[$idx]", $val->[$idx] );
         }
      }
      when( "HASH" ) {
         foreach my $key ( keys %$val ) {
            test_ptr( $sv, "$name\{$key}", $val->{$key} );
         }
      }
   }
}

foreach my $sv ( $df->heap ) {
   foreach ( keys %{ $sv } ) {
      next unless m/^(.*)_at$/;
      my $outref = $1;
      test_ptr( $sv, $outref, $sv->{$_} );
   }
}