Тестирование назначения ветки в Perl для SUPER:: методов
Я собираюсь закончить изучать книгу по Intermediate Perl.
В главе 18 " Уничтожение объектов" вводится следующее DESTROY
определение метода:
# lib/Animal.pm
package Animal {
# ...
sub DESTROY {
my $self = shift;
if ($self->{temp_filename}){
my $fh = $self->{temp_fh};
close $fh;
unlink $self->{temp_filename};
}
print '[', $self->name, " has died.]\n";
}
# ...
}
# lib/Horse.pm
package Horse {
use parent qw(Animal)
# ...
sub DESTROY {
my $self = shift;
$self->SUPER::DESTROY if $self->can( 'SUPER::DESTROY' );
print "[", $self->name, " has gone off to the glue factory.]\n";
}
# ...
}
После нескольких неудачных попыток я написал этот тест на основе этого ответа:
# t/Horse.t
#!perl -T
use strict;
use warnings;
use Test::More tests => 6;
use Test::Output;
# some other tests
# test DESTROY() when SUPER::DESTROY is not defined;
{
my $tv_horse = Horse->named('Mr. Ed');
stdout_is( sub { $tv_horse->DESTROY }, "[Mr. Ed has died.]\n[Mr. Ed has gone off to the glue factory.]\n",
'Horse DESTROY() when SUPER::DESTROY is defined');
}
{
my $tv_horse = Horse->named('Mr. Ed');
sub Animal::DESTROY { undef }
stdout_is( sub { $tv_horse->DESTROY }, "[Mr. Ed has gone off to the glue factory.]\n",
'Horse DESTROY() when SUPER::DESTROY is not defined');
}
Я не могу проверить вывод правильно в обоих случаях, так как переопределение метода sub Animal::DESTROY { undef }
влияет также на тест в предыдущем блоке.
Знаете ли вы какой-нибудь способ обеспечить переопределение метода для работы, как ожидалось?
Спасибо
1 ответ
Решение
Это должно установить удаленную / переопределенную подпрограмму только до конца включающего блока,
{
# not needed when removing method
# no warnings 'redefine';
my $tv_horse = Horse->named('Mr. Ed');
# returns undef
# local *Animal::DESTROY = sub { undef };
# remove the mothod until end of the enclosing block
local *Animal::DESTROY;
# ..
}