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 (file)
--- 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 (executable)
--- 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 (file)
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";