From: knew-p5p@pimb.org <knew-p5p@pimb.org>
Date: Sat, 10 Feb 2007 19:32:17 +0000 (-0800)
Subject: [perl #41484] qr// stack bug
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=c8c13c2248f0124bc4c3d1625cab2bdb0be6c8da;p=p5sagit%2Fp5-mst-13.2.git

[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
--- 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
--- 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
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");
+