B::Deparse: stub implementation of deparsing lexical subs
authorAaron Crane <arc@cpan.org>
Fri, 22 Feb 2013 16:15:46 +0000 (16:15 +0000)
committerAaron Crane <arc@cpan.org>
Fri, 12 Apr 2013 15:07:41 +0000 (16:07 +0100)
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.

dist/B-Deparse/Deparse.pm

index 0241c14..533a98a 100644 (file)
@@ -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,16 @@ 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.
+
 =back
 
 =head1 AUTHOR