applied patch, regen headers

	Message-ID: <13739.64763.792570.626015@alias-2.pr.mcs.net>
	Subject: B::Deparse update for qr// and regcreset

p4raw-id: //depot/perl@1507

diff --git a/ext/B/B/Deparse.pm b/ext/B/B/Deparse.pm
index 337c173..3b3fb29 100644 (file)
--- a/ext/B/B/Deparse.pm
+++ b/ext/B/B/Deparse.pm
@@ -9,7 +9,7 @@
 package B::Deparse;
 use Carp 'cluck';
 use B qw(class main_root main_start main_cv svref_2object);
-$VERSION = 0.54;
+$VERSION = 0.55;
 use strict;
 
 # Changes between 0.50 and 0.51:
@@ -33,9 +33,13 @@ use strict;
 # Changes between 0.53 and 0.54
 # - added support for new `for (1..100)' optimization,
 #   thanks to Gisle Aas
+# Changes between 0.54 and 0.55
+# - added support for new qr// construct
+# - added support for new pp_regcreset OP
 
 # Todo:
 # - {} around variables in strings ("${var}letters")
+# - left/right context
 # - associativity of &&=, ||=, ?:
 # - ',' => '=>' (auto-unquote?)
 # - break long lines ("\r" as discretionary break?)
@@ -482,6 +486,11 @@ sub pp_regcmaybe { # see also regcomp
     return "XXX";
 }
 
+sub pp_regcreset { # see also regcomp
+    cluck "unexpected OP_REGCRESET";
+    return "XXX";
+}
+
 sub pp_substcont { # see also subst
     cluck "unexpected OP_SUBSTCONT";
     return "XXX";
@@ -2049,15 +2058,20 @@ sub balanced_delim {
 
 sub single_delim {
     my($q, $default, $str) = @_;
-    return "$default$str$default" if index($str, $default) == -1;
+    return "$default$str$default" if $default and index($str, $default) == -1;
     my($succeed, $delim);
     ($succeed, $str) = balanced_delim($str);
     return "$q$str" if $succeed;
     for $delim ('/', '"', '#') {
        return "$q$delim" . $str . $delim if index($str, $delim) == -1;
     }
-    $str =~ s/$default/\\$default/g;
-    return "$default$str$default";
+    if ($default) {
+       $str =~ s/$default/\\$default/g;
+       return "$default$str$default";
+    } else {
+       $str =~ s[/][\\/]g;
+       return "$q/$str/";
+    }
 }
 
 sub SVf_IOK () {0x10000}
@@ -2294,6 +2308,7 @@ sub pp_regcomp {
     my($op, $cx) = @_;
     my $kid = $op->first;
     $kid = $kid->first if $kid->ppaddr eq "pp_regcmaybe";
+    $kid = $kid->first if $kid->ppaddr eq "pp_regcreset";
     return $self->re_dq($kid);
 }
 
@@ -2301,15 +2316,15 @@ sub OPp_RUNTIME () { 64 }
 
 sub PMf_ONCE () { 0x2 }
 sub PMf_SKIPWHITE () { 0x10 }
-sub PMf_FOLD () { 0x20 }
 sub PMf_CONST () { 0x40 }
 sub PMf_KEEP () { 0x80 }
 sub PMf_GLOBAL () { 0x100 }
 sub PMf_CONTINUE () { 0x200 }
 sub PMf_EVAL () { 0x400 }
+sub PMf_LOCALE () { 0x800 }
 sub PMf_MULTILINE () { 0x1000 }
 sub PMf_SINGLELINE () { 0x2000 }
-sub PMf_LOCALE () { 0x4000 }
+sub PMf_FOLD () { 0x4000 }
 sub PMf_EXTENDED () { 0x8000 }
 
 # osmic acid -- see osmium tetroxide
@@ -2319,9 +2334,9 @@ map($matchwords{join "", sort split //, $_} = $_, 'cig', 'cog', 'cos', 'cogs',
     'cox', 'go', 'is', 'ism', 'iso', 'mig', 'mix', 'osmic', 'ox', 'sic', 
     'sig', 'six', 'smog', 'so', 'soc', 'sog', 'xi'); 
 
-sub pp_match {
+sub matchop {
     my $self = shift;
-    my($op, $cx) = @_;
+    my($op, $cx, $name, $delim) = @_;
     my $kid = $op->first;
     my ($binop, $var, $re) = ("", "", "");
     if ($op->flags & OPf_STACKED) {
@@ -2347,7 +2362,7 @@ sub pp_match {
        $re =~ s/\?/\\?/g;
        $re = "?$re?";
     } else {
-       $re = single_delim("m", "/", $re);
+       $re = single_delim($name, $delim, $re);
     }
     $re = $re . $flags;
     if ($binop) {
@@ -2357,7 +2372,9 @@ sub pp_match {
     }
 }
 
-sub pp_pushre { pp_match(@_) }
+sub pp_match { matchop(@_, "m", "/") }
+sub pp_pushre { matchop(@_, "m", "/") }
+sub pp_qr { matchop(@_, "qr", "") }
 
 sub pp_split {
     my $self = shift;

diff --git a/opcode.h b/opcode.h
index a33e500..8f4f00b 100644 (file)
--- a/opcode.h
+++ b/opcode.h
@@ -2205,7 +2205,7 @@ EXT U32 opargs[] = {
        0x00001104,     /* regcreset */
        0x00001304,     /* regcomp */
        0x00000640,     /* match */
-       0x00000004,     /* qr */
+       0x00000604,     /* qr */
        0x00001654,     /* subst */
        0x00000354,     /* substcont */
        0x00001914,     /* trans */

diff --git a/opcode.pl b/opcode.pl
index 4ee7efe..a97bb16 100755 (executable)
--- a/opcode.pl
+++ b/opcode.pl
@@ -277,7 +277,7 @@ regcmaybe   regexp comp once        ck_fun          s1      S
 regcreset      regexp reset interpolation flag ck_fun          s1      S
 regcomp                regexp compilation      ck_null         s|      S
 match          pattern match           ck_match        d/
-qr             pattern quote           ck_match        s0
+qr             pattern quote           ck_match        s/
 subst          substitution            ck_null         dis/    S
 substcont      substitution cont       ck_null         dis|    
 trans          character translation   ck_null         is"     S