From 28905b57f48ed7d8802e9adcef28d443eb2b6de4 Mon Sep 17 00:00:00 2001
From: Rick Delaney <rick@consumercontact.com>
Date: Thu, 14 Jul 2005 16:10:00 +0000
Subject: [PATCH] Re: [perl #27028] /$/ not honouring /m in some cases
 Message-ID: <20050714141059.GF19090@localhost.localdomain>

p4raw-id: //depot/perl@25166
---
 MANIFEST               |  1 +
 t/op/regexp.t          | 16 +++++++++++++++-
 t/op/regexp_qr_embed.t | 11 +++++++++++
 3 files changed, 27 insertions(+), 1 deletion(-)
 create mode 100644 t/op/regexp_qr_embed.t

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";
-- 
2.7.4