#!/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;
}

foreach my $sv ( $df->heap ) {
   foreach ( keys %{ $sv } ) {
      next unless m/^(.*)_at$/;
      my $outref = $1;
      my $val = $sv->{$_};
      given( ref $val ) {
         when( undef ) {
            my $addr = $val;
            $addr or next;
            $roots{$addr} and next;
            $df->{heap}{$addr} and next;

            printf "SV %s has no %s SV at addr 0x%x\n", $sv->desc_addr, $outref, $addr;
         }
         when( "ARRAY" ) {
            foreach my $idx ( 0 .. $#$val ) {
               my $addr = $val->[$idx];
               $addr or next;
               $roots{$addr} and next;
               $df->{heap}{$addr} and next;

               printf "SV %s has no %s[%d] SV at addr 0x%x\n", $sv->desc_addr, $outref, $idx, $addr;
            }
         }
         when( "HASH" ) {
            foreach my $key ( keys %$val ) {
               my $addr = $val->{$key};
               $addr or next;
               $roots{$addr} and next;
               $df->{heap}{$addr} and next;

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