Is there any risk of memory leaking not defining a DESTROY method in perl classes?

user_5687152 0
Viewed 102

I am still working on a Perl 5.8 Foo::Bar package as per this previous question (SO-63595446).

TL;DR Is there any memory leak risk if I do not define a DESTROY method to reset my attributes to undef in a Perl 5.8 Class:Std package?

I have been trying to memoize some instance attributes:

  • initially I did it like BarObj $bbb but in my tests I immediately could see a race condition: I was using a class variable instead of an instance one and the result was shared across multiple instances
  • I implemented as BarObj %aaa and it looks fine now

A simplified version of the code:

#!/usr/bin/env perl

use 5.8.0;
use strict;
use warnings;
use Data::Dumper qw(Dumper);
use Scalar::Util qw(refaddr);

{
  package FooObj;

  use strict;
  use warnings;
  use Class::Std;

  my %ccc :ATTR;

  sub BUILD {
    my ($self, $ident, $args) = @_;
    $ccc{$ident} = $$args{foobar};
  }

  sub retrieve {
    my $args = shift;
    my $foobar = $$args{foobar};
    FooObj->new({foobar => $foobar});
  }
}

{
  package BarObj;
  FooObj->import;

  use strict;
  use warnings;
  use Class::Std;
  use Scalar::Util qw(refaddr);

  my %aaa :ATTR( :get<aaa> );
  my $bbb = {};

  sub doSomething {
    my ($self, $args) = @_;

    my $foo = $$args{foo};
    my $bar = $$args{bar};
    my $cacheKey = "$$args{foo}:$$args{bar}";

    # using ident $self
    my $aaaCache = $aaa{ident $self}->{$cacheKey};
    # not using ident $self
    my $bbbCache = $$bbb{$cacheKey};

    return if $aaaCache && $bbbCache;

    my $f = FooObj::retrieve({foobar => $cacheKey});

    $aaa{ident $self}->{$cacheKey} = refaddr($f) unless $aaaCache;
    $$bbb{$cacheKey} = refaddr($f) unless $bbbCache;
  }

  sub get_bbb {
    return $bbb;
  }
}

my $bar1 = BarObj->new();
my $bar2 = BarObj->new();

my $input1 = { foo => 'aaa', bar => 'aaa' };
my $input2 = { foo => 'bbb', bar => 'bbb' };

print '$bar1 refaddr: ' . refaddr($bar1) .
     ' $bar2 refaddr: ' . refaddr($bar2) . "\n";

$bar1->doSomething($input1);
$bar1->doSomething($input2);

$bar2->doSomething($input1);
$bar2->doSomething($input2);

print '$bar1 %aaa: ' . Dumper($bar1->get_aaa());
print '$bar2 %aaa: ' . Dumper($bar2->get_aaa());

print '$bar1 %bbb: ' . Dumper($bar1->get_bbb());
print '$bar2 %bbb: ' . Dumper($bar2->get_bbb());

Output of the snippet:

$bar1 refaddr: 140467484583408 $bar2 refaddr: 140467484303424
$bar1 %aaa: $VAR1 = {
          'aaa:aaa' => '140467484303784',
          'bbb:bbb' => '140467467923232'
        };
$bar2 %aaa: $VAR1 = {
          'bbb:bbb' => '140467467923520',
          'aaa:aaa' => '140467467923424'
        };
$bar1 %bbb: $VAR1 = {
          'bbb:bbb' => '140467467923232',
          'aaa:aaa' => '140467484303784'
        };
$bar2 %bbb: $VAR1 = {
          'bbb:bbb' => '140467467923232',
          'aaa:aaa' => '140467484303784'
        };

I am wondering how the garbage collector is treating my packages and how the references I am storing are destroyed. According to the doc (https://perldoc.perl.org/perlobj.html#Destructors) I can define a custom destructor (e.g. setting my %aaa back to undef) but I don't know if it is required.

Do you see any memory leak risk related to ATTR usage without explicitly resetting them to undef in a DESTROY method?

perl
1 Answers

What empties %aaa, $bbb and %ccc?

Class::Std actually adds a destructor to your package. Without it, the contents of %aaa and %ccc would only get freed on program exit. (Without the destructor, you could even get an object with incorrect data if a new object was found at the same address as an old object.)

That leaves $bbb. Class::Std doesn't know anything about it, and you haven't taken steps to empty it, so its content aren't emptied until program exit.

use Class::Std;
use Data::Dumper qw( Dumper );

my %foo :ATTR;   # Akin to %aaa and %ccc
my %bar;         # Akin to %$bbb

sub _dump {
   local $Data::Dumper::Indent = 0;
   local $Data::Dumper::Terse  = 1;
   print("%foo: " . Dumper(\%foo) . "\n");
   print("%bar: " . Dumper(\%bar) . "\n");
}

sub do_something {
   my $self = shift;
   my %args = @_;
   $foo{ident $self} = $args{foo};
   $bar{ident $self} = $args{bar};
}

{
   my $obj = __PACKAGE__->new();
   $obj->do_something( foo => 123, bar => 456 );

   print("BEFORE DESTROY:\n");
   _dump();
}

print("\n");
print("After DESTROY:\n");
_dump();

Before DESTROY:
%foo: {'140737100652856' => 123}
%bar: {'140737100652856' => 456}

After DESTROY:
%foo: {}
%bar: {'140737100652856' => 456}

You would need something like

{
   my $old_destroy = \&DESTROY;
   my $new_destroy = sub {
      ... empty the appropriate entry of $bbb ...
      $old_destroy->(@_);
   };

   no warnings qw( redefine );
   *DESTROY = $new_destroy;
}
user_5899240
Related