From: Rafael Garcia-Suarez <rgarciasuarez@gmail.com>
Date: Sun, 18 May 2008 08:37:02 +0000 (+0000)
Subject: Fix for [perl #51848] Deparse interpolation in regex literal
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=03b22f1b10d67ab063304de6dc37c76d815ca050;p=p5sagit%2Fp5-mst-13.2.git

Fix for [perl #51848] Deparse interpolation in regex literal

p4raw-id: //depot/perl@33851
---

diff --git a/ext/B/B/Deparse.pm b/ext/B/B/Deparse.pm
index c7ed82d..b70a17c 100644
--- a/ext/B/B/Deparse.pm
+++ b/ext/B/B/Deparse.pm
@@ -4062,6 +4062,16 @@ sub pp_trans {
     return "tr" . double_delim($from, $to) . $flags;
 }
 
+sub re_dq_disambiguate {
+    my ($first, $last) = @_;
+    # Disambiguate "${foo}bar", "${foo}{bar}", "${foo}[1]"
+    ($last =~ /^[A-Z\\\^\[\]_?]/ &&
+	$first =~ s/([\$@])\^$/${1}{^}/)  # "${^}W" etc
+	|| ($last =~ /^[{\[\w_]/ &&
+	    $first =~ s/([\$@])([A-Za-z_]\w*)$/${1}{$2}/);
+    return $first . $last;
+}
+
 # Like dq(), but different
 sub re_dq {
     my $self = shift;
@@ -4077,14 +4087,7 @@ sub re_dq {
     } elsif ($type eq "concat") {
 	my $first = $self->re_dq($op->first, $extended);
 	my $last  = $self->re_dq($op->last,  $extended);
-
-	# Disambiguate "${foo}bar", "${foo}{bar}", "${foo}[1]"
-	($last =~ /^[A-Z\\\^\[\]_?]/ &&
-	    $first =~ s/([\$@])\^$/${1}{^}/)  # "${^}W" etc
-	    || ($last =~ /^[{\[\w_]/ &&
-		$first =~ s/([\$@])([A-Za-z_]\w*)$/${1}{$2}/);
-
-	return $first . $last;
+	return re_dq_disambiguate($first, $last);
     } elsif ($type eq "uc") {
 	return '\U' . $self->re_dq($op->first->sibling, $extended) . '\E';
     } elsif ($type eq "lc") {
@@ -4156,7 +4159,9 @@ sub regcomp {
 	my $str = '';
 	$kid = $kid->first->sibling;
 	while (!null($kid)) {
-	    $str .= $self->re_dq($kid, $extended);
+	    my $first = $str;
+	    my $last = $self->re_dq($kid, $extended);
+	    $str = re_dq_disambiguate($first, $last);
 	    $kid = $kid->sibling;
 	}
 	return $str, 1;
diff --git a/ext/B/t/deparse.t b/ext/B/t/deparse.t
index dce5034..13c6e2c 100644
--- a/ext/B/t/deparse.t
+++ b/ext/B/t/deparse.t
@@ -27,7 +27,7 @@ BEGIN {
     require feature;
     feature->import(':5.10');
 }
-use Test::More tests => 60;
+use Test::More tests => 61;
 
 use B::Deparse;
 my $deparse = B::Deparse->new();
@@ -416,3 +416,7 @@ elsif ($b) { x(); }
 elsif ($a and $b) { x(); }
 elsif ($a or $b) { x(); }
 else { x(); }
+####
+# 54 interpolation in regexps
+my($y, $t);
+/x${y}z$t/;