—

              
#!/usr/bin/perl
use v5.14;
use warnings;
use feature qw( say );
use utf8;
use Devel::MAT;
use Devel::MAT::Cmd::Terminal;
use List::Util qw( any );
use List::UtilsBy qw( nsort_by );
# We're drawing pretty graphs with line drawing
STDOUT->binmode( ":encoding(UTF-8)" );
my $progress = ( -t STDERR ) ?
   sub { print STDERR "\r\e[K" . ( shift // "" ); } :
   undef;
my $pmatA = Devel::MAT->load( my $fileA = ( $ARGV[0] // die "Need dumpfile A\n" ),
   progress => $progress,
);
my $pmatB = Devel::MAT->load( my $fileB = ( $ARGV[1] // die "Need dumpfile B\n" ),
   progress => $progress,
);
$progress->( "Sorting,.." ) if $progress;
my @svsA = nsort_by { $_->addr } $pmatA->dumpfile->heap;
my @svsB = nsort_by { $_->addr } $pmatB->dumpfile->heap;
$progress->() if $progress;
my $countC = 0;
my @onlyA;
my @onlyB;
while( @svsA && @svsB ) {
   my $svA = $svsA[0];
   my $svB = $svsB[0];
   my $addrA = $svA->addr;
   my $addrB = $svB->addr;
   if( $addrA < $addrB ) {
      push @onlyA, $svA;
      shift @svsA;
   }
   elsif( $addrB < $addrA ) {
      push @onlyB, $svB;
      shift @svsB;
   }
   else {
      # common - no print
      $countC++;
      shift @svsA;
      shift @svsB;
   }
}
push @onlyA, @svsA;
push @onlyB, @svsB;
my %notesA;
my %notesB;
sub add_notes
{
   my ( $svs, $notes, $pmat ) = @_;
   my %addrs = map { $_->addr => 1 } @$svs;
   foreach my $sv ( $pmat->dumpfile->heap ) {
      next unless $sv->type eq "STASH";
      my $stash = $sv;
      foreach my $field (qw( mro_isa mro_linearcurrent )) {
         my $sv = $stash->$field or next;
         $addrs{ $sv->addr } or next;
         $notes->{ $sv->addr } = "$field of " . Devel::MAT::Cmd->format_symbol( $stash->stashname, $stash );
      }
   }
}
add_notes \@onlyA, \%notesA, $pmatA;
add_notes \@onlyB, \%notesB, $pmatB;
sub svtrees_from_set
{
   my @svs = @_;
   # In general the set of SVs and their cross-linkages are not yet suitable
   # to print in a simple tree, because of cycles and multiple paths. We have
   # to reduce the linkages down to something more well-behaved.
   my %svs_by_addr = map { $_->addr => $_ } @svs;
   my %sv_outrefs; # {$addr} => [other svs here that it refers to]
   foreach my $sv ( @svs ) {
      $sv_outrefs{ $sv->addr } = [];
      foreach my $ref ( $sv->outrefs ) {
         next unless $svs_by_addr{ $ref->sv->addr };
         push $sv_outrefs{ $sv->addr }->@*, $ref->sv;
      }
   }
   my %sv_trees; # {$addr} => [$sv, other SV trees it refers to]
   my %seen;     # {$addr} => bool
   my %toplevel; # {$addr} => bool
   foreach my $origsv ( @svs ) {
      my @queue = $origsv;
      while( @queue ) {
         my $sv = shift @queue;
         my $addr = $sv->addr;
         if( !$sv_trees{ $addr } ) {
            $toplevel{ $addr }++;
         }
         $seen{ $addr }++;
         my $node = $sv_trees{ $addr } //= [ $sv ];
         my @new_outrefs = grep { !$seen{ $_->addr }++ } $sv_outrefs{ $addr }->@*;
         foreach my $outref ( nsort_by { $_->addr } @new_outrefs ) {
            push @queue, $outref;
            push $node->@*, $sv_trees{ $outref->addr } //= [ $outref ];
            delete $toplevel{ $outref->addr };
         }
      }
   }
   return @sv_trees{ sort { $a <=> $b } keys %toplevel };
}
our $Indent = "";
sub print_svtree
{
   my ( $tree, $leader0, $leader1, $notes ) = @_;
   my ( $sv, @subtrees ) = @$tree;
   my $note = $notes->{ $sv->addr } ? " (" . $notes->{ $sv->addr } . ")" : "";
   Devel::MAT::Cmd->printf( "  %s%s%s%s\n",
      $Indent,
      $leader0,
      Devel::MAT::Cmd->format_sv( $sv ),
      $note,
   );
   return unless @subtrees;
   local $Indent = "$Indent$leader1";
   my $final_subtree = pop @subtrees;
   {
      print_svtree( $_, "├─ ", "│  ", $notes ) for @subtrees;
   }
   {
      print_svtree( $final_subtree, "└─ ", "   ", $notes );
   }
}
print "\n";
printf "%d unique to %s:\n", scalar @onlyA, $fileA;
my @treesA = svtrees_from_set @onlyA;
print_svtree $_, "- ", "  ", \%notesA for @treesA;
print "\n";
printf "%d unique to %s:\n", scalar @onlyB, $fileB;
my @treesB = svtrees_from_set @onlyB;
print_svtree $_, "+ ", "  ", \%notesB for @treesB;
print "\n";
printf "%d common\n", $countC;
HideShow 27 lines of Pod
=head1 NAME
pmat-diff - print a list of SVs unique to each of two given files
=head1 SYNOPSIS
   $ pmat-diff test-1.pmat test-1-after.pmat
=head1 DESCRIPTION
Given two F<.pmat> files, compares them and prints a list of SVs unique to
each, and a count of those found common to both. This is only useful if the
two files were generated by the same process, usually at similar times, such
as either side of a memory leak test as created by C<Test::MemoryGrowth>.
For each file, the SVs unique to it are gathered up into a forest of trees by
reference, because in typical usage patterns it usually ends up that several
SVs are all referenced by one container. It often helps when tracking down
memory leaks to focus on those outer containers, rather than the inner SVs
they contain.
=head1 AUTHOR
Paul Evans <leonerd@leonerd.org.uk>
=cut