In perl.git, the branch blead has been updated
<http://perl5.git.perl.org/perl.git/commitdiff/f0cf37549cc42506257ecbe810815fc2f537192b?hp=e501306eca0fea1cc9fc53e2eb024ad37e85ce59>
- Log -----------------------------------------------------------------
commit f0cf37549cc42506257ecbe810815fc2f537192b
Author: Aaron Crane <a...@cpan.org>
Date: Fri Feb 22 16:18:33 2013 +0000
B::Deparse: document that `state sub` is unimplemented
M dist/B-Deparse/Deparse.pm
M dist/B-Deparse/t/deparse.t
commit 4545d2f2cf8d44c666a31b8bc4bea3a5c699fd74
Author: Aaron Crane <a...@cpan.org>
Date: Fri Apr 12 16:08:40 2013 +0100
deparse.t: delete now-unneeded __WARN__ suppression
B::Deparse no longer emits the warnings in question.
M dist/B-Deparse/t/deparse.t
commit 735828216cfe97cd2d2a0dbae72eec7f153e2cc2
Author: Aaron Crane <a...@cpan.org>
Date: Fri Feb 22 16:15:46 2013 +0000
B::Deparse: stub implementation of deparsing lexical subs
This doesn't work properly, but (a) it's better than nothing, and (b) it
suppresses some unsightly "unexpected OP_INTROCV" warnings from the test
suite, fixing RT #116821.
M dist/B-Deparse/Deparse.pm
-----------------------------------------------------------------------
Summary of changes:
dist/B-Deparse/Deparse.pm | 54 +++++++++++++++++++++++++++++++++++++++++--
dist/B-Deparse/t/deparse.t | 17 ++++++-------
2 files changed, 59 insertions(+), 12 deletions(-)
diff --git a/dist/B-Deparse/Deparse.pm b/dist/B-Deparse/Deparse.pm
index 0241c14..d62fe3b 100644
--- a/dist/B-Deparse/Deparse.pm
+++ b/dist/B-Deparse/Deparse.pm
@@ -1323,7 +1323,8 @@ sub scopeop {
push @kids, $kid;
}
if ($cx > 0) { # inside an expression, (a do {} while for lineseq)
- return "do {\n\t" . $self->lineseq($op, 0, @kids) . "\n\b}";
+ my $body = $self->lineseq($op, 0, @kids);
+ return is_lexical_subs(@kids) ? $body : "do {\n\t$body\n\b}";
} else {
my $lineseq = $self->lineseq($op, $cx, @kids);
return (length ($lineseq) ? "$lineseq;" : "");
@@ -3426,7 +3427,7 @@ sub is_subscriptable {
$kid = $kid->sibling until null $kid->sibling;
return 0 if is_scope($kid);
$kid = $kid->first;
- return 0 if $kid->name eq "gv";
+ return 0 if $kid->name eq "gv" || $kid->name eq "padcv";
return 0 if is_scalar($kid);
return is_subscriptable($kid);
} else {
@@ -3790,7 +3791,7 @@ sub pp_entersub {
$kid = $self->deparse($kid, 24);
} else {
$prefix = "";
- my $arrow = is_subscriptable($kid->first) ? "" : "->";
+ my $arrow = is_subscriptable($kid->first) || $kid->first->name eq
"padcv" ? "" : "->";
$kid = $self->deparse($kid, 24) . $arrow;
}
@@ -4889,6 +4890,36 @@ sub pp_subst {
}
}
+sub is_lexical_subs {
+ my (@ops) = shift;
+ for my $op (@ops) {
+ return 0 if $op->name !~ /\A(?:introcv|clonecv)\z/;
+ }
+ return 1;
+}
+
+sub pp_introcv {
+ my $self = shift;
+ my($op, $cx) = @_;
+ # For now, deparsing doesn't worry about the distinction between introcv
+ # and clonecv, so pretend this op doesn't exist:
+ return '';
+}
+
+sub pp_clonecv {
+ my $self = shift;
+ my($op, $cx) = @_;
+ my $sv = $self->padname_sv($op->targ);
+ my $name = substr $sv->PVX, 1; # skip &/$/@/%, like $self->padany
+ return "my sub $name";
+}
+
+sub pp_padcv {
+ my $self = shift;
+ my($op, $cx) = @_;
+ return $self->padany($op);
+}
+
1;
__END__
@@ -5380,6 +5411,23 @@ defined within a different scope, although L<PadWalker>
is a good start.
There are probably many more bugs on non-ASCII platforms (EBCDIC).
+=item *
+
+Lexical C<my> subroutines are not deparsed properly at the moment. They are
+emitted as pure declarations, without their body; and the declaration may
+appear in the wrong place (before any lexicals the body closes over, or
+before the C<use feature> declaration that permits use of this feature).
+
+We expect to resolve this before the lexical-subroutine feature is no longer
+considered experimental.
+
+=item *
+
+Lexical C<state> subroutines are not deparsed at all at the moment.
+
+We expect to resolve this before the lexical-subroutine feature is no longer
+considered experimental.
+
=back
=head1 AUTHOR
diff --git a/dist/B-Deparse/t/deparse.t b/dist/B-Deparse/t/deparse.t
index af5c574..dd50f1f 100644
--- a/dist/B-Deparse/t/deparse.t
+++ b/dist/B-Deparse/t/deparse.t
@@ -1380,16 +1380,15 @@ my($a, $b, $c) = @_;
# SKIP ?$] < 5.017004 && "lexical subs not implemented on this Perl version"
# TODO unimplemented in B::Deparse; RT #116553
# lexical subroutine
-
-# XXX remove this __WARN__ once the ops are correctly implemented
-BEGIN {
- $SIG{__WARN__} = sub {
- return if $_[0] =~ /unexpected OP_(CLONE|INTRO|PAD)CV/;
- print STDERR @_;
- }
-}
-
use feature 'lexical_subs';
no warnings "experimental::lexical_subs";
my sub f {}
print f();
+####
+# SKIP ?$] < 5.017004 && "lexical subs not implemented on this Perl version"
+# TODO unimplemented in B::Deparse; RT #116553
+# lexical "state" subroutine
+use feature 'state', 'lexical_subs';
+no warnings 'experimental::lexical_subs';
+state sub f {}
+print f();
--
Perl5 Master Repository
