subで参照カウンタが増える。そして意図しない動作

考えてみればそのとおりだけど、subの中にオブジェクトの名前を書いちゃうと参照カウンタが増える。 これによってDESTORY実行のフェーズが変わってしまってしばらくはまってしまったって話。

そのままsay

#!/usr/bin/env perl
use strict;
use warnings;
use feature qw/say/;
use Devel::Peek qw/SvREFCNT/;

my $obj = "obj";

say $obj;
say SvREFCNT($obj);

# obj
# 1

ちょっと使いやすくしちゃったわー系

#!/usr/bin/env perl
use strict;
use warnings;
use feature qw/say/;
use Devel::Peek qw/SvREFCNT/;

my $obj = "obj";
sub say_obj { say $obj; }

say_obj;
say SvREFCNT($obj);

# obj
# 2

後者のほうではsay_objとか定義しちゃってるせいで、参照カウンタが増えてしまってます。

…で何が問題なのかというと、例えば

• scopeから抜けた時に、Test::Objectをcleanしてから終わってくれ
• setupメソッドを叩くと基礎データを入れてくれる

みたいなコードを書いちゃったとします。 なんかよくテストコードとかで使ったりしますよね。

#!/usr/bin/env perl
use strict;
use warnings;

{
    package Test::Object;
    sub new {
        my ($self, $args) = @_;
        bless {
            obj => $args,
        }, $self;
    }
    sub clean {
       #TODO implementation clean
    }
}
{
    package Test::Array;
    sub new {
        my $self = shift;
        bless {
            array => [],
        }, $self;
    }
    sub add {
        my ($self, $obj) = @_;
        push @{$self->{array}}, $obj;
    }
    sub DESTROY {
        my $self = shift;
        $_->clean for @{$self->{array}};
    }
}

package main;

my $obj = Test::Array->new;

sub setup {
    $obj->add(Test::Object->new(1));
    $obj->add(Test::Object->new(1));
    $obj->add(Test::Object->new(1));
}

setup();

xxxx.....

こういう風に書いちゃうと、上手く動かない時があるんです。 というのも、Perlを実行する時のフェーズには色々種類があって、ここに影響を与えちゃう。

はじめのサンプルコードで示すと、前者の方はRUNフェーズでdestoryが呼ばれ、後者の方はDESTRUCTフェーズでdestoryが呼ばれるのです。 DESTRUCTフェーズですが、この場合はもう、「全オブジェクト破棄してやるぜー」ってPerlさんがなってるので、順序を問わず、実行されてしまいます。

…となると、

    sub DESTROY {
        my $self = shift;
        $_->clean for @{$self->{array}};
    }

のcleanを実行しようとしているオブジェクトが既に破棄されてしまってる可能性があるわけです。 なので、実際にはcleanを実行できずアボン！

あんまり影響あるときは無いのですが、例えば、テストで立ち上げたmysqldのデータをクリーンアップするコードがDESTORYで定義されていた場合には、 それらが実行されずに次のテストが走ってテストが全落ちする…とかそういうこともあります。

ハマった。

ちなみに、以下のように書くだけでなおる。 テストコードの一部なのでこれで良いかなーとか思ったり。

my $obj = Test::Array->new;

sub setup {
    my $obj = shift;
    $obj->add(Test::Object->new(1));
    $obj->add(Test::Object->new(1));
    $obj->add(Test::Object->new(1));
}

setup($obj);