[perl #75812] kill $1 broken in 5.12.1

[email protected] ("Tony Cook via RT")
Newsgroups perl.perl5.porters
Message-ID <[email protected]>
On Wed Jun 16 13:08:00 2010, [email protected] wrote:
> We've discovered that this snippet will break in perl 5.12
> 
> my $pid = "12345  ";
> if($pid =~ m/(\d+)/) {
> 	kill 9, $1;
> }
> 
> it dies with this message:
> Can't kill a non-numeric process ID at test.pl line 7.
> 
> 
> The reason appears to be a result of this commit.
>
http://perl5.git.perl.org/perl.git/commitdiff/e2c0f81f627951896aca833460887e6e8f20aba6?hp=32878f30ba1216461c8932946f0868cda9920d62
> 
> Using Devel::Peek, I'm guessing the problem is that IV doesn't get set
> on a $1 variable?
> 
> For some reason I can't understand,  I can make this problem go away
> if I do 'use 5.12.1' at the beginning of my code. $1+0 also forces
> kill to work.

$1 is magic, so until SvGETMAGIC() is called it has no flags.

Patch calls SvGETMAGIC() before checking the flags, and uses the no
magic variant of SvIV() avoid to double magic.

looks_like_number() can also call SvGETMAGIC() via SvPV_const(), but
that's a different problem.

Tony
0001-RT-75812-apply-get-magic-before-checking-flags-PV.patch (text/x-patch, 2.4 KB)
From 322ed3e750982361473addd7d45edcbace447752 Mon Sep 17 00:00:00 2001
From: Tony Cook <[email protected]>
Date: Thu, 17 Jun 2010 18:58:04 +1000
Subject: [PATCH] RT #75812: apply get magic before checking flags, PVX

The code was checking flags with applying any get magic, so when a
match was doing putting a numeric string into $1, none of the flags
checked were set, so producing the "non-numeric process ID" error.
---
 doio.c       |    9 ++++++---
 t/op/kill0.t |    9 ++++++++-
 2 files changed, 14 insertions(+), 4 deletions(-)

diff --git a/doio.c b/doio.c
index 98861af..06f2d3d 100644
--- a/doio.c
+++ b/doio.c
@@ -1721,9 +1721,10 @@ nothing in the core.
 	    while (++mark <= sp) {
 		I32 proc;
 		register unsigned long int __vmssts;
+		SvGETMAGIC(*mark);
 		if (!(SvIOK(*mark) || SvNOK(*mark) || looks_like_number(*mark)))
 		    Perl_croak(aTHX_ "Can't kill a non-numeric process ID");
-		proc = SvIV(*mark);
+		proc = SvIV_nomg(*mark);
 		APPLY_TAINT_PROPER();
 		if (!((__vmssts = sys$delprc(&proc,0)) & 1)) {
 		    tot--;
@@ -1748,9 +1749,10 @@ nothing in the core.
 	    val = -val;
 	    while (++mark <= sp) {
 		I32 proc;
+		SvGETMAGIC(*mark);
 		if (!(SvIOK(*mark) || SvNOK(*mark) || looks_like_number(*mark)))
 		    Perl_croak(aTHX_ "Can't kill a non-numeric process ID");
-		proc = SvIV(*mark);
+		proc = SvIV_nomg(*mark);
 		APPLY_TAINT_PROPER();
 #ifdef HAS_KILLPG
 		if (PerlProc_killpg(proc,val))	/* BSD */
@@ -1763,9 +1765,10 @@ nothing in the core.
 	else {
 	    while (++mark <= sp) {
 		I32 proc;
+		SvGETMAGIC(*mark);
 		if (!(SvIOK(*mark) || SvNOK(*mark) || looks_like_number(*mark)))
 		    Perl_croak(aTHX_ "Can't kill a non-numeric process ID");
-		proc = SvIV(*mark);
+		proc = SvIV_nomg(*mark);
 		APPLY_TAINT_PROPER();
 		if (PerlProc_kill(proc, val))
 		    tot--;
diff --git a/t/op/kill0.t b/t/op/kill0.t
index eadf15d..d3ef8f7 100644
--- a/t/op/kill0.t
+++ b/t/op/kill0.t
@@ -14,7 +14,7 @@ BEGIN {
 
 use strict;
 
-plan tests => 5;
+plan tests => 6;
 
 ok( kill(0, $$), 'kill(0, $pid) returns true if $pid exists' );
 
@@ -43,3 +43,10 @@ for my $case ( @bad_pids ) {
   like( $@, qr/^Can't kill a non-numeric process ID/, "dies killing $name pid");
 }
 
+# Verify that killing a magic variable containing a number doesn't
+# trigger the above
+{
+  my $x = $$ . " ";
+  $x =~ /(\d+)/;
+  ok(eval { kill 0, $1 }, "can kill a number string in a magic variable");
+}
-- 
1.5.6.5
lmpx.com only provides a reader for public news (NNTP) servers. It is not affiliated with the servers or forums shown here and is not responsible for the content of articles, which is written by their respective authors.