Subject: | named subs containing references to @_ $_ or %_ are not Deparsable |
I recently discovered an interesting little problem where
subname( $anyname , sub { @_ } ); creates sub, that when deparsed,
produces an Assertion Error.
died: Assertion !((((_svi)->sv_flags & (0x00004000|0x00008000)) ==
0x00008000) && (((svtype)((_svi)->sv_flags & 0xff)) == SVt_PVGV ||
((svtype)((_svi)->sv_flags & 0xff)) == SVt_PVLV)) failed: file "B.c",
line 3896 at /usr/lib/perl5/5.10.0/x86_64-linux/B/Deparse.pm line 1292
The functions still *work* normally, they just confuse Deparse a bit.
Attached is a series of tests that replicate this behaviour ( At least
on my $arch )
Its set up with TODO: { and todo_skipping by default , for the sake of
convenience.
Thanks,
Kent.
Subject: | SubName.t |
#!/usr/bin/perl
#
# Checks are skipped by default
# set ENV{CHECK_DEPARSE} to make them into TODO
#
use strict;
use warnings;
use Sub::Name;
use B::Deparse;
use Test::More;
use Test::Exception;
our (@tests);
sub build_test {
my ( $name, $code ) = @_;
push @tests, { name => $name, code => $code };
}
build_test default_double_ref_array => sub { return \\@_; }; # fail
build_test default_array_ref => sub { return \@_; }; # fail
build_test default_array => sub { return @_; }; # fail
build_test const_scalar => sub { return 1; }; # win
build_test default_scalar => sub { return $_; }; # fail
build_test assign_const_scalar => sub { my ($self) = 1; return $self }; # win
build_test default_hash => sub { return %_ }; # fail
build_test default_array_item => sub { return $_[0] }; # fail
my $ntests = ( $#tests + 1 ) * 2;
plan tests => $ntests;
TODO: {
local $TODO = "NonCritical Deparse Annoyances";
todo_skip 'CHECK_DEPARSE is undef', $ntests if !exists $ENV{CHECK_DEPARSE};
for (@tests) {
can_deparse($_);
}
# These tests are just a failsafe to prove that its not dying because the code in the sub is bogus
for (@tests) {
can_run($_);
}
}
#
# This Does ALL the failing
#
sub generate_mop {
my $test = shift;
return Sub::Name::subname( 'main::fake_' . $test->{name}, $test->{code} );
}
#
# Is Deparsable
#
sub can_deparse {
my $test = shift;
lives_ok(
sub {
B::Deparse->new()->coderef2text( generate_mop($test) );
},
$test->{name} . " is deparsable"
);
}
#
# Is Executable
#
sub can_run {
my $test = shift;
ok( defined generate_mop($test)->(qw( 1 2 3 4 5)),
$test->{name} . " returns a value" );
}