line numbers are given % 64k

[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 7b2358b..3af74bc 100644 (file)
--- a/ext/B/B/Deparse.pm
+++ b/ext/B/B/Deparse.pm
@@ -326,7 +326,14 @@ sub begin_is_use {
 
        return unless $self->const_sv($constop)->PV eq $module;
        $constop = $constop->sibling;
-       $version = $self->const_sv($constop)->int_value;
+       $version = $self->const_sv($constop);
+       if (class($version) ne "PVMG") {
+           # version is either an integer or a double
+           $version = $version->PV;
+       } else {
+           # version specified as a v-string
+           $version = 'v'.join '.', map ord, split //, $version->PV;
+       }
        $constop = $constop->sibling;
        return if $constop->name ne "method_named";
        return if $self->const_sv($constop)->PV ne "VERSION";
@@ -915,6 +922,10 @@ sub maybe_local {
     if ($op->private & (OPpLVAL_INTRO|$our_intro)
        and not $self->{'avoid_local'}{$$op}) {
        my $our_local = ($op->private & OPpLVAL_INTRO) ? "local" : "our";
+       if( $our_local eq 'our' ) {
+           die "Unexpected our($text)\n" unless $text =~ /^\W(\w+::)*\w+\z/;
+           $text =~ s/(\w+::)+//; 
+       }
         if (want_scalar($op)) {
            return "$our_local $text";
        } else {
@@ -2312,7 +2323,7 @@ sub loop_common {
     my $body;
     my $cond = undef;
     if ($kid->name eq "lineseq") { # bare or infinite loop 
-       if (is_state $kid->last) { # infinite
+       if ($kid->last->name eq "unstack") { # infinite
            $head = "while (1) "; # Can't use for(;;) if there's a continue
            $cond = "";
        } else {
@@ -2335,17 +2346,14 @@ sub loop_common {
                $var = $self->pp_threadsv($enter, 1);
            } else { # regular my() variable
                $var = $self->pp_padsv($enter, 1);
-               if ($self->padname_sv($enter->targ)->IVX ==
-                   $kid->first->first->sibling->last->cop_seq)
-               {
-                   # If the scope of this variable closes at the last
-                   # statement of the loop, it must have been
-                   # declared here.
-                   $var = "my " . $var;
-               }
            }
        } elsif ($var->name eq "rv2gv") {
            $var = $self->pp_rv2sv($var, 1);
+           if ($enter->private & OPpOUR_INTRO) {
+               # our declarations don't have package names
+               $var =~ s/^(.).*::/$1/;
+               $var = "our $var";
+           }
        } elsif ($var->name eq "gv") {
            $var = "\$" . $self->deparse($var, 1);
        }
@@ -2361,18 +2369,18 @@ sub loop_common {
        return "{;}"; # {} could be a hashref
     }
     # If there isn't a continue block, then the next pointer for the loop
-    # will point to the unstack, which is kid's penultimate child, except
+    # will point to the unstack, which is kid's last child, except
     # in a bare loop, when it will point to the leaveloop. When neither of
-    # these conditions hold, then the third-to-last child in the continue
+    # these conditions hold, then the second-to-last child is the continue
     # block (or the last in a bare loop).
     my $cont_start = $enter->nextop;
     my $cont;
-    if ($$cont_start != $$op && ${$cont_start->sibling} != ${$body->last}) {
+    if ($$cont_start != $$op && ${$cont_start} != ${$body->last}) {
        if ($bare) {
            $cont = $body->last;
        } else {
            $cont = $body->first;
-           while (!null($cont->sibling->sibling->sibling)) {
+           while (!null($cont->sibling->sibling)) {
                $cont = $cont->sibling;
            }
        }
@@ -3184,7 +3192,7 @@ sub single_delim {
 sub const {
     my $sv = shift;
     if (class($sv) eq "SPECIAL") {
-       return ('undef', '1', '0')[$$sv-1]; # sv_undef, sv_yes, sv_no
+       return ('undef', '1', '(!1)')[$$sv-1]; # sv_undef, sv_yes, sv_no
     } elsif (class($sv) eq "NULL") {
        return 'undef';
     } elsif ($sv->FLAGS & SVf_IOK) {
@@ -3246,10 +3254,10 @@ sub dq {
        my $first = $self->dq($op->first);
        my $last  = $self->dq($op->last);
 
-       # Disambiguate "${foo}bar", "${foo}{bar}", "${foo}[1]"
+       # Disambiguate "${foo}bar", "${foo}{bar}", "${foo}[1]", "$foo\::bar"
        ($last =~ /^[A-Z\\\^\[\]_?]/ &&
            $first =~ s/([\$@])\^$/${1}{^}/)  # "${^}W" etc
-           || ($last =~ /^[{\[\w_]/ &&
+           || ($last =~ /^[:'{\[\w_]/ &&
                $first =~ s/([\$@])([A-Za-z_]\w*)$/${1}{$2}/);
 
        return $first . $last;
@@ -3578,6 +3586,7 @@ sub re_dq {
 
 sub pure_string {
     my ($self, $op) = @_;
+    return 0 if null $op;
     my $type = $op->name;
 
     if ($type eq 'const') {