X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/689e417f571b6d714ad62b19aa8883b3b04f59ed..30fcd6c4143961133edf166c63dcc423fbcdb973:/dist/B-Deparse/Deparse.pm

diff --git a/dist/B-Deparse/Deparse.pm b/dist/B-Deparse/Deparse.pm
index 93e250f..61fe293 100644
--- a/dist/B-Deparse/Deparse.pm
+++ b/dist/B-Deparse/Deparse.pm
@@ -16,14 +16,14 @@ 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 OPpSORT_INPLACE OPpSORT_DESCEND OPpITER_REVERSED
-	 OPpREVERSE_INPLACE
+	 OPpREVERSE_INPLACE OPpCONST_NOVER
 	 SVf_IOK SVf_NOK SVf_ROK SVf_POK SVpad_OUR SVf_FAKE SVs_RMG SVs_SMG
          CVf_METHOD CVf_LVALUE
-	 PMf_KEEP PMf_GLOBAL PMf_CONTINUE PMf_EVAL PMf_ONCE
+	 PMf_KEEP PMf_GLOBAL PMf_CONTINUE PMf_EVAL PMf_ONCE PMf_NONDESTRUCT
 	 PMf_MULTILINE PMf_SINGLELINE PMf_FOLD PMf_EXTENDED),
 	 ($] < 5.009 ? 'PMf_SKIPWHITE' : 'RXf_SKIPWHITE'),
 	 ($] < 5.011 ? 'CVf_LOCKED' : ());
-$VERSION = 0.93;
+$VERSION = 0.97;
 use strict;
 use vars qw/$AUTOLOAD/;
 use warnings ();
@@ -610,25 +610,6 @@ sub new {
     }
 }
 
-sub scan_for_constants {
-    my ($self) = @_;
-    my %ret;
-
-    B::walksymtable(\%::, sub {
-        my ($gv) = @_;
-
-        my $cv = $gv->CV;
-        return if !$cv || class($cv) ne 'CV';
-
-        my $const = $cv->const_sv;
-        return if !$const || class($const) eq 'SPECIAL';
-
-        $ret{ 0 + $const->object_2svref } = $gv->NAME;
-    }, sub { 1 });
-
-    return \%ret;
-}
-
 # Initialise the contextual information, either from
 # defaults provided with the ambient_pragmas method,
 # or from perl's own defaults otherwise.
@@ -1399,7 +1380,6 @@ sub pp_nextstate {
     $self->{'curcop'} = $op;
     my @text;
     push @text, $self->cop_subs($op);
-    push @text, $op->label . ": " if $op->label;
     my $stash = $op->stashpv;
     if ($stash ne $self->{'curstash'}) {
 	push @text, "package $stash;\n";
@@ -1453,6 +1433,8 @@ sub pp_nextstate {
 	  ' "' . $op->file, qq'"\n';
     }
 
+    push @text, $op->label . ": " if $op->label;
+
     return join("", @text);
 }
 
@@ -1612,11 +1594,11 @@ sub unop {
     my($op, $cx, $name) = @_;
     my $kid;
     if ($op->flags & OPf_KIDS) {
+	$kid = $op->first;
  	if (not $name) {
  	    # this deals with 'boolkeys' right now
  	    return $self->deparse($kid,$cx);
  	}
-	$kid = $op->first;
 	my $builtinname = $name;
 	$builtinname =~ /^CORE::/ or $builtinname = "CORE::$name";
 	if (defined prototype($builtinname)
@@ -1807,7 +1789,7 @@ sub pp_require {
 	$name =~ s/\.pm//g;
 	return "$opname $name";
     } else {	
-	$self->unop($op, $cx, $opname);
+	$self->unop($op, $cx, $op->first->private & OPpCONST_NOVER ? "no" : $opname);
     }
 }
 
@@ -3673,13 +3655,6 @@ sub const {
     if (class($sv) eq "NULL") {
        return 'undef';
     }
-    if ($cx) {
-	unless ($self->{'inlined_constants'}) {
-	    $self->{'inlined_constants'} = $self->scan_for_constants;
-	}
-	my $const = $self->{'inlined_constants'}->{ 0 + $sv->object_2svref };
-        return $const if $const;
-    }
     # convert a version object into the "v1.2.3" string in its V magic
     if ($sv->FLAGS & SVs_RMG) {
 	for (my $mg = $sv->MAGIC; $mg; $mg = $mg->MOREMAGIC) {
@@ -4311,10 +4286,11 @@ sub pp_split {
     }
 
     # handle special case of split(), and split(' ') that compiles to /\s+/
+    # Under 5.10, the reflags may be undef if the split regexp isn't a constant
     $kid = $op->first;
     if ( $kid->flags & OPf_SPECIAL
 	 and ( $] < 5.009 ? $kid->pmflags & PMf_SKIPWHITE()
-	      : $kid->reflags & RXf_SKIPWHITE() ) ) {
+	      : ($kid->reflags || 0) & RXf_SKIPWHITE() ) ) {
 	$exprs[0] = "' '";
     }
 
@@ -4334,7 +4310,9 @@ my %substwords;
 map($substwords{join "", sort split //, $_} = $_, 'ego', 'egoism', 'em',
     'es', 'ex', 'exes', 'gee', 'go', 'goes', 'ie', 'ism', 'iso', 'me',
     'meese', 'meso', 'mig', 'mix', 'os', 'ox', 'oxime', 'see', 'seem',
-    'seg', 'sex', 'sig', 'six', 'smog', 'sog', 'some', 'xi');
+    'seg', 'sex', 'sig', 'six', 'smog', 'sog', 'some', 'xi',
+    'sir', 'rise', 'smore', 'more', 'seer', 'rome', 'gore', 'grim', 'grime',
+    'or', 'rose', 'rosie');
 
 sub pp_subst {
     my $self = shift;
@@ -4375,6 +4353,7 @@ sub pp_subst {
 	($re) = $self->regcomp($kid, 1, $extended);
     }
     $flags .= "e" if $op->pmflags & PMf_EVAL;
+    $flags .= "r" if $op->pmflags & PMf_NONDESTRUCT;
     $flags .= "g" if $op->pmflags & PMf_GLOBAL;
     $flags .= "i" if $op->pmflags & PMf_FOLD;
     $flags .= "m" if $op->pmflags & PMf_MULTILINE;