From: Stephen McCamant <smcc@mit.edu>
Date: Tue, 14 Jul 1998 19:56:47 +0000 (-0500)
Subject: applied patch, regen headers
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=90be192fcd319e5ef82ee20d910d431c4f328350;p=p5sagit%2Fp5-mst-13.2.git

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
--- 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
--- 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
--- 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