| Subject: | Demolish and "used only once" errors |
| Date: | Tue, 23 Jan 2018 15:38:24 -0500 |
| To: | bug-Moose [...] rt.cpan.org |
| From: | Jon Rubin <jon.rubin [...] grantstreet.com> |
If you implement DEMOLISH methods on your objects in Moose, it's fairly
easy to get "used only once errors" during global destruction.
This is for the latest versions of Moose (I tested 2.206 and 2.2009), using
perl 5.22.2 on a Centos 6 box:
Linux pexdev002-dev3.grantstreet.com 2.6.32-696.10.3.el6.x86_64 #1 SMP Tue
Sep 26 18:14:22 UTC 2017 x86_64 x86_64 x86_64 GNU/Linux
Judging by http://www.perlmonks.org/?node_id=738531 this has been happening
for at least 9 years.
Fortunately, this appears to be a relatively easy bug to solve.
Patch Request:
diff --git a/lib/Moose/Object.pm b/lib/Moose/Object.pm
index 073d700..6d970e1 100644
--- a/lib/Moose/Object.pm
+++ b/lib/Moose/Object.pm
@@ -78,7 +78,10 @@ sub DEMOLISHALL {
foreach my $class (@isa) {
no strict 'refs';
- my $demolish = *{"${class}::DEMOLISH"}{CODE};
+ my $demolish = do {
+ no warnings 'once';
+ *{"${class}::DEMOLISH"}{CODE};
+ };
$self->$demolish($in_global_destruction)
if defined $demolish;
}
Test Case:
[15:30]-[jrubin@pexdev002-dev3: ~/work/test ]$ find . -type f -print
-exec cat {} \; -printf "\n"
./lib/Demolisher.pm
package Demolisher;
use Moose;
sub DEMOLISH { }
1;
./lib/OnceRemoved.pm
package OnceRemoved;
use strict;
use warnings;
use Demolisher;
my $d = Demolisher->new;
$d->DEMOLISH;
1;
./lib/OnceRemovedKid.pm
package OnceRemovedKid;
use strict;
use warnings;
use DemolisherKid;
my $d = DemolisherKid->new;
$d->DEMOLISH;
1;
./lib/DemolisherKid.pm
package DemolisherParent;
use Moose;
package DemolisherKid;
use Moose;
extends 'DemolisherParent';
sub DEMOLISH {}
1;
./one_demolish.t
use strict;
use warnings;
use Test::More tests => 1;
my @warnings;
BEGIN {
$SIG{__WARN__} = sub { push @warnings, @_ };
}
use OnceRemoved;
is scalar @warnings, 0, "No warnings"
or diag explain \@warnings;
./demolish_inheritance.t
use strict;
use warnings;
use Test::More tests => 1;
my @warnings;
BEGIN {
$SIG{__WARN__} = sub { push @warnings, @_ };
}
use OnceRemovedKid;
is scalar @warnings, 0, "No warnings"
or diag explain \@warnings;
[15:30]-[jrubin@pexdev002-dev3: ~/work/test ]$ carton exec -- prove -l *.t
demolish_inheritance.t .. 1/1
# Failed test 'No warnings'
# at demolish_inheritance.t line 13.
# got: '2'
# expected: '0'
# [
# 'Name "DemolisherParent::DEMOLISH" used only once: possible typo at
/home/jrubin/work/local/centos6/v5.22.2/lib/perl5/x86_64-linux/Moose/Object.pm
line 81.
# ',
# 'Name "Moose::Object::DEMOLISH" used only once: possible typo at
/home/jrubin/work/local/centos6/v5.22.2/lib/perl5/x86_64-linux/Moose/Object.pm
line 81.
# '
# ]
# Looks like you failed 1 test of 1.
demolish_inheritance.t .. Dubious, test returned 1 (wstat 256, 0x100)
Failed 1/1 subtests
one_demolish.t .......... 1/1
# Failed test 'No warnings'
# at one_demolish.t line 13.
# got: '1'
# expected: '0'
# [
# 'Name "Moose::Object::DEMOLISH" used only once: possible typo at
/home/jrubin/work/local/centos6/v5.22.2/lib/perl5/x86_64-linux/Moose/Object.pm
line 81.
# '
# ]
# Looks like you failed 1 test of 1.
one_demolish.t .......... Dubious, test returned 1 (wstat 256, 0x100)
Failed 1/1 subtests
Test Summary Report
-------------------
demolish_inheritance.t (Wstat: 256 Tests: 1 Failed: 1)
Failed test: 1
Non-zero exit status: 1
one_demolish.t (Wstat: 256 Tests: 1 Failed: 1)
Failed test: 1
Non-zero exit status: 1
Files=2, Tests=2, 0 wallclock secs ( 0.02 usr 0.00 sys + 0.32 cusr 0.02
csys = 0.36 CPU)
Result: FAIL
--
Jon Rubin
Grant Street Group
Ph: (412) 391-5555, Ext. 1323