Testing branch assignment in Perl for SUPER:: methods

Question

I am about to finish to study the Intermediate Perl book.

In chapter 18 Object Destruction is introduced the following DESTROY method definition:

# 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";
  }
# ...
}

After a few unsuccessfully attempt, I wrote this test based on 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');
}

I cannot test the output correctly for both cases since the method redefinition sub Animal::DESTROY { undef } is affecting also the test in the previous block.

Do you know any way to ensure the method redefinition to work as expected?

Thanks

If you are writing the `Animal` class and `Animal` is always used together with `Horse`, then you know that `Animal` provides a DESTROY method – the `->can('SUPER::DESTROY') check becomes a bit unnecessary. I'd just call `$self->SUPER::DESTROY` directly. — amon, Aug 28 '17 at 08:27
Btw don't trigger the DESTROY method in your tests by calling it directly, this might call DESTROY multiple times. Instead, `undef $tv_horse` to clear the variable which will trigger the destructor. — amon, Aug 28 '17 at 08:30
Tip: One shouldn't call DESTROY explicity (because you get into a situation where DESTROY gets called twice), so replace `my $tv_horse = Horse->named('Mr. Ed'); stdout_is( sub { $tv_horse->DESTROY }, ...)` with `stdout_is( sub { my $tv_horse = Horse->named('Mr. Ed'); 1; }, ...)`. (The `1;` is probably unneeded. It's there to ensure the object isn't returned.) — ikegami, Aug 28 '17 at 09:21

mpapec · Accepted Answer · 2017-08-28T09:23:15.583

7

This should set removed/redefined subroutine only until the end of enclosing block,

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

  # ..
}

edited Aug 28 '17 at 09:23

answered Aug 28 '17 at 08:15

mpapec

50,217
8
67
127

Thank you for your quick reply. This solution is working! However `Devel::Cover` doesn't detect this branch case as tested: blib/lib/Horse.pm line | % | coverage | branch 14 | 50 | T(green) | F(red) | if $self->can('SUPER::DESTROY') – mabe02 Aug 28 '17 at 08:20
Do you want `DESTROY` to return `undef`, or to remove `DESTROY` altogether? – mpapec Aug 28 '17 at 08:23
2

@mabe02 To entirely remove the method, just localize the glob without assigning a new sub: `local *Animal::DESTROY;` would be sufficient. – amon Aug 28 '17 at 08:23
I wanted to remove the definition, so this solution is perfect. Thank you! – mabe02 Aug 28 '17 at 08:27
`no warnings 'redefine';` not needed. – ikegami Aug 28 '17 at 09:18

Testing branch assignment in Perl for SUPER:: methods

1 Answers1