Re: [PATCH] [perl #18175] B::Concise,-exec doesn't handle // operator well

[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 b10c1fb..b54a5af 100644 (file)
--- a/ext/B/B/Deparse.pm
+++ b/ext/B/B/Deparse.pm
@@ -553,9 +553,10 @@ sub compile {
            print qq(BEGIN { \$/ = $fs; \$\\ = $bs; }\n);
        }
        my @BEGINs  = B::begin_av->isa("B::AV") ? B::begin_av->ARRAY : ();
+       my @CHECKs  = B::check_av->isa("B::AV") ? B::check_av->ARRAY : ();
        my @INITs   = B::init_av->isa("B::AV") ? B::init_av->ARRAY : ();
        my @ENDs    = B::end_av->isa("B::AV") ? B::end_av->ARRAY : ();
-       for my $block (@BEGINs, @INITs, @ENDs) {
+       for my $block (@BEGINs, @CHECKs, @INITs, @ENDs) {
            $self->todo($block, 0);
        }
        $self->stash_subs();
@@ -586,7 +587,7 @@ sub compile {
 sub coderef2text {
     my $self = shift;
     my $sub = shift;
-    croak "Usage: ->coderef2text(CODEREF)" unless ref($sub) eq "CODE";
+    croak "Usage: ->coderef2text(CODEREF)" unless UNIVERSAL::isa($sub, "CODE");
 
     $self->init();
     return $self->indent($self->deparse_sub(svref_2object($sub)));
@@ -1951,6 +1952,7 @@ sub logop {
 
 sub pp_and { logop(@_, "and", 3, "&&", 11, "if") }
 sub pp_or  { logop(@_, "or",  2, "||", 10, "unless") }
+sub pp_dor { logop(@_, "err", 2, "//", 10, "") }
 
 # xor is syntactically a logop, but it's really a binop (contrary to
 # old versions of opcode.pl). Syntax is what matters here.
@@ -1967,7 +1969,8 @@ sub logassignop {
 }
 
 sub pp_andassign { logassignop(@_, "&&=") }
-sub pp_orassign { logassignop(@_, "||=") }
+sub pp_orassign  { logassignop(@_, "||=") }
+sub pp_dorassign { logassignop(@_, "//=") }
 
 sub listop {
     my $self = shift;
@@ -2415,7 +2418,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;
@@ -2438,7 +2441,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
@@ -3010,7 +3018,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;
 }
@@ -3038,7 +3046,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;
 }
@@ -3732,7 +3740,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);   
        }