在 Perl 中测试 SUPER:: 方法的分支分配

Question

我即将完成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";
  }
# ...
}

经过几次不成功的尝试，我根据this answer:

写了这个测试

# 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 } 也影响了前一个块中的测试。

你知道有什么方法可以确保方法重定义按预期工作吗？

谢谢

Answer 1

这应该设置 removed/redefined 子例程直到封闭块结束，

{
  # 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;

  # ..
}

在 Perl 中测试 SUPER:: 方法的分支分配

Testing branch assignment in Perl for SUPER:: methods

testing

perl

unit-testing

mocking

test-coverage