From: Rick Delaney <rick@consumercontact.com>
Date: Thu, 14 Jul 2005 16:10:00 +0000 (+0000)
Subject: Re: [perl #27028] /$/ not honouring /m in some cases
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=28905b57f48ed7d8802e9adcef28d443eb2b6de4;p=p5sagit%2Fp5-mst-13.2.git

Re: [perl #27028] /$/ not honouring /m in some cases
Message-ID: <20050714141059.GF19090@localhost.localdomain>

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

diff --git a/MANIFEST b/MANIFEST
index 204ffe9..71f207a 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -2905,6 +2905,7 @@ t/op/ref.t			See if refs and objects work
 t/op/regexp_noamp.t		See if regular expressions work with optimizations
 t/op/regexp_notrie.t		See if regular expressions work without trie optimisation
 t/op/regexp_qr.t		See if regular expressions work as qr//
+t/op/regexp_qr_embed.t		See if regular expressions work with embedded qr//
 t/op/regexp.t			See if regular expressions work
 t/op/regexp_trielist.t		See if regular expressions work with trie optimisation
 t/op/regmesg.t			See if one can get regular expression errors
diff --git a/t/op/regexp.t b/t/op/regexp.t
index b4288b2..662be92 100755
--- a/t/op/regexp.t
+++ b/t/op/regexp.t
@@ -74,7 +74,21 @@ while (<TESTS>) {
     $result =~ s/B//i unless $skip;
     for $study ('', 'study \$subject') {
  	$c = $iters;
- 	eval "$study; \$match = (\$subject =~ $OP$pat) while \$c--; \$got = \"$repl\";";
+    if ($qr_embed) {
+ 	    eval qq"
+            my \$RE = qr$pat;
+            $study;
+            \$match = (\$subject =~ /(?:)\$RE(?:)/) while \$c--;
+            \$got = \"$repl\";
+        ";
+    } 
+    else {
+ 	    eval qq"
+            $study;
+            \$match = (\$subject =~ $OP$pat) while \$c--;
+            \$got = \"$repl\";
+        ";
+    }
 	chomp( $err = $@ );
 	if ($result eq 'c') {
 	    if ($err !~ m!^\Q$expect!) { print "not ok $. (compile) $input => `$err'\n"; next TEST }
diff --git a/t/op/regexp_qr_embed.t b/t/op/regexp_qr_embed.t
new file mode 100644
index 0000000..bcd5115
--- /dev/null
+++ b/t/op/regexp_qr_embed.t
@@ -0,0 +1,11 @@
+#!./perl
+
+$qr = 1;
+$qr_embed = 1;
+for $file ('./op/regexp.t', './t/op/regexp.t', ':op:regexp.t') {
+    if (-r $file) {
+	do $file;
+	exit;
+    }
+}
+die "Cannot find ./op/regexp.t or ./t/op/regexp.t\n";