B::Concise updates (incl. avoiding use of op_seq)

[p5sagit/p5-mst-13.2.git] / ext / B / B / Deparse.pm

diff --git a/ext/B/B/Deparse.pm b/ext/B/B/Deparse.pm
index 6a57872..37b98a0 100644 (file)
--- a/ext/B/B/Deparse.pm
+++ b/ext/B/B/Deparse.pm
@@ -15,7 +15,7 @@ use B qw(class main_root main_start main_cv svref_2object opnumber perlstring
         OPpTRANS_SQUASH OPpTRANS_DELETE OPpTRANS_COMPLEMENT OPpTARGET_MY
         OPpCONST_ARYBASE OPpEXISTS_SUB OPpSORT_NUMERIC OPpSORT_INTEGER
         OPpSORT_REVERSE
-        SVf_IOK SVf_NOK SVf_ROK SVf_POK SVpad_OUR
+        SVf_IOK SVf_NOK SVf_ROK SVf_POK SVpad_OUR SVf_FAKE
          CVf_METHOD CVf_LOCKED CVf_LVALUE
         PMf_KEEP PMf_GLOBAL PMf_CONTINUE PMf_EVAL PMf_ONCE PMf_SKIPWHITE
         PMf_MULTILINE PMf_SINGLELINE PMf_FOLD PMf_EXTENDED);
@@ -1130,7 +1130,10 @@ sub lex_in_scope {
 sub populate_curcvlex {
     my $self = shift;
     for (my $cv = $self->{'curcv'}; class($cv) eq "CV"; $cv = $cv->OUTSIDE) {
-       my @padlist = $cv->PADLIST->ARRAY;
+       my $padlist = $cv->PADLIST;
+       # an undef CV still in lexical chain
+       next if class($padlist) eq "SPECIAL";
+       my @padlist = $padlist->ARRAY;
        my @ns = $padlist[0]->ARRAY;
 
        for (my $i=0; $i<@ns; ++$i) {
@@ -1141,8 +1144,10 @@ sub populate_curcvlex {
                next;
            }
             my $name = $ns[$i]->PVX;
-           my $seq_st = $ns[$i]->NVX;
-           my $seq_en = int($ns[$i]->IVX);
+           my ($seq_st, $seq_en) =
+               ($ns[$i]->FLAGS & SVf_FAKE)
+                   ? (0, 999999)
+                   : ($ns[$i]->NVX, $ns[$i]->IVX);
 
            push @{$self->{'curcvlex'}{$name}}, [$seq_st, $seq_en];
        }
@@ -2418,7 +2423,7 @@ BEGIN { eval "sub OP_LIST () {" . opnumber("list") . "}" }
 
 sub pp_null {
     my $self = shift;
-    my($op, $cx) = @_;
+    my($op, $cx, $flags) = @_;
     if (class($op) eq "OP") {
        # old value is lost
        return $self->{'ex_const'} if $op->targ == OP_CONST;
@@ -2441,7 +2446,12 @@ sub pp_null {
                                   . $self->deparse($op->first->sibling, 20),
                                   $cx, 20);
     } elsif ($op->flags & OPf_SPECIAL && $cx == 0 && !$op->targ) {
-       return "do {\n\t". $self->deparse($op->first, $cx) ."\n\b};";
+       if ($flags) {
+           return $self->deparse($op->first, $cx);
+       }
+       else {
+           return "do {\n\t". $self->deparse($op->first, $cx) ."\n\b};";
+       }
     } elsif (!null($op->first->sibling) and
             $op->first->sibling->name eq "null" and
             class($op->first->sibling) eq "UNOP" and
@@ -3013,7 +3023,7 @@ sub re_uninterp {
           | \\[uUlLQE]
           )
 
-       /length($4) ? "$1$2$4" : "$1$2\\$3"/xeg;
+       /defined($4) && length($4) ? "$1$2$4" : "$1$2\\$3"/xeg;
 
     return $str;
 }
@@ -3041,7 +3051,7 @@ sub re_uninterp_extended {
           | \\[uUlLQE]
           )
 
-       /length($4) ? "$1$2$4" : "$1$2\\$3"/xeg;
+       /defined($4) && length($4) ? "$1$2$4" : "$1$2\\$3"/xeg;
 
     return $str;
 }
@@ -3735,7 +3745,7 @@ sub pp_subst {
            $flags .= "e";
        }
        if ($op->pmflags & PMf_EVAL) {
-           $repl = $self->deparse($repl, 0);
+           $repl = $self->deparse($repl, 0, 1);
        } else {
            $repl = $self->dq($repl);   
        }