| Subject: | Premature freeing of lexcal argument passed to escape function |
| Date: | Thu, 31 Mar 2011 21:39:43 +0100 |
| To: | bug-Scope-Escape [...] rt.cpan.org |
| From: | "D. Ilmari" Mannsåker <ilmari [...] photobox.com> |
Hi Zefram,
The below test script demonstrates what looks like a refcount bug in
Scope::Escape: When a callback calls a closed-over escape function with
an argument it copied or shifted into a lexical variable, the argument
is freed and undef is returned. However, if the escape function is
called with "shift" or "@_", everything works.
use strict;
use warnings;
use Test::More;
use Scope::Escape qw(current_escape_function);
{
package live;
sub new { bless do { \(my $ok = 0) }, $_[0] }
sub done { ${$_[0]}++ }
sub DESTROY { ::ok ${$_[0]}, "survived return" }
}
sub visitor (&) {
my ($callback) = @_;
$callback->(live->new);
fail "callback returned";
}
my %wrapper = (
'$obj) (copied' => sub {
my $return = current_escape_function;
visitor {
my ($obj) = @_;
isa_ok($obj, "live");
$return->($obj);
};
},
'$obj) (shifted' => sub {
my $return = current_escape_function;
visitor {
my $obj = shift;
isa_ok($obj, "live");
$return->($obj);
};
},
'@_' => sub {
my $return = current_escape_function;
visitor {
isa_ok($_[0], "live");
$return->(@_);
};
},
shift => sub {
my $return = current_escape_function;
visitor {
isa_ok($_[0], "live");
$return->(shift);
};
},
);
foreach my $name (keys %wrapper) {
my $ret = $wrapper{$name}->();
isa_ok($ret, "live", "\$return->($name)") && $ret->done;
}
done_testing();
__END__
# Failed test 'survived return'
# at /home/ilmari/tmp/scope-escape-wtf.t line 10.
# Failed test '$return->($obj) (shifted) isa live'
# at /home/ilmari/tmp/scope-escape-wtf.t line 54.
# $return->($obj) (shifted) isn't defined
# Failed test 'survived return'
# at /home/ilmari/tmp/scope-escape-wtf.t line 10.
# Failed test '$return->($obj) (copied) isa live'
# at /home/ilmari/tmp/scope-escape-wtf.t line 54.
# $return->($obj) (copied) isn't defined
# Looks like you failed 4 tests of 12.
/home/ilmari/tmp/scope-escape-wtf.t ..
ok 1 - The object isa live
ok 2 - $return->(shift) isa live
ok 3 - survived return
ok 4 - The object isa live
not ok 5 - survived return
not ok 6 - $return->($obj) (shifted) isa live
ok 7 - The object isa live
not ok 8 - survived return
not ok 9 - $return->($obj) (copied) isa live
ok 10 - The object isa live
ok 11 - $return->(@_) isa live
ok 12 - survived return
1..12
Dubious, test returned 4 (wstat 1024, 0x400)
Failed 4/12 subtests
Test Summary Report
-------------------
/home/ilmari/tmp/scope-escape-wtf.t (Wstat: 1024 Tests: 12 Failed: 4)
Failed tests: 5-6, 8-9
Non-zero exit status: 4
Files=1, Tests=12, 0 wallclock secs ( 0.03 usr 0.00 sys + 0.02 cusr
0.00 csys = 0.05 CPU)
Result: FAIL