[perl #41484] qr// stack bug

From: knew-p5p@pimb.org (via RT) <perlbug-followup@perl.org>
Message-ID: <rt-3.6.HEAD-14573-1171164736-117.41484-75-0@perl.org>

p4raw-id: //depot/perl@30211

diff --git a/MANIFEST b/MANIFEST
index d671ac0..760c921 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -3581,6 +3581,7 @@ t/op/pow.t                        See if ** works
 t/op/push.t                    See if push and pop work
 t/op/pwent.t                   See if getpw*() functions work
 t/op/qq.t                      See if qq works
+t/op/qrstack.t                 See if qr expands the stack properly
 t/op/quotemeta.t               See if quotemeta works
 t/op/rand.t                    See if rand works
 t/op/range.t                   See if .. works

diff --git a/pp_hot.c b/pp_hot.c
index e88dbb1..5cd01be 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -1172,7 +1172,8 @@ PP(pp_qr)
     if (pm->op_pmdynflags & PMdf_TAINTED)
         SvTAINTED_on(rv);
     sv_magic(sv,(SV*)ReREFCNT_inc(PM_GETRE(pm)), PERL_MAGIC_qr,0,0);
-    RETURNX(PUSHs(rv));
+    XPUSHs(rv);
+    RETURN;
 }
 
 PP(pp_match)

diff --git a/t/op/qrstack.t b/t/op/qrstack.t
new file mode 100644 (file)
index 0000000..6483eba
--- /dev/null
+++ b/t/op/qrstack.t
@@ -0,0 +1,21 @@
+#!./perl
+
+my $test = 1;
+sub ok {
+    my($ok, $name) = @_;
+
+    # You have to do it this way or VMS will get confused.
+    printf "%s %d%s\n", $ok ? "ok" : "not ok",
+                        $test,
+                        defined $name ? " - $name" : '';
+
+    printf "# Failed test at line %d\n", (caller)[2] unless $ok;
+
+    $test++;
+    return $ok;
+}
+
+print "1..1\n";
+
+ok(defined [(1)x127,qr//,1]->[127], "qr// should extend the stack properly");
+