From 8a5decd86e575fa785c97ea9b6642e4e87294101 Mon Sep 17 00:00:00 2001
From: Father Chrysostomos <sprout@cpan.org>
Date: Tue, 5 Jun 2012 22:38:12 -0700
Subject: [PATCH] =?utf8?q?pp=5Fnegate:=20Don=E2=80=99t=20treat=20nummified?=
 =?utf8?q?=20str=20as=20num?=
MIME-Version: 1.0
Content-Type: text/plain; charset=utf8
Content-Transfer-Encoding: 8bit

I think it’s a bug that this prints 0:

$ ./perl -lIlib -MDevel::Peek -e '$x = "dogs"; 0+$x; Dump $x; print -$x'
SV = PVNV(0x802340) at 0x821b90
  REFCNT = 1
  FLAGS = (POK,pIOK,pNOK,pPOK)
  IV = 0
  NV = 0
  PV = 0x301620 "dogs"\0
  CUR = 4
  LEN = 16
0

This variable is a string, not a number.  The number 0 is just a
cached value.  It lacks the IOK flag precisely because the IV is not
representative of the actual value of the scalar.

This logic here is a little bit odd:

        if( !SvNIOK( sv ) && looks_like_number( sv ) ){
           SvIV_please( sv );
        }

	if ((flags & SVf_IOK) || ((flags & (SVp_IOK | SVp_NOK)) == SVp_IOK)) {

SvIV_please sets the flags on sv but then they are ignored when check-
ing for integrality.

To fix the bug mentioned above, I had to change this logic to use sv
directly, rather than the saved flags.

That meant that this bug was also fixed at the same time, since the
integer code is no longer bypassed when it is SvIV_please that sets
the integer flags:

$ ./perl -Ilib -le 'print -97656250000000000'
-97656250000000000
$ ./perl -Ilib -le 'print -"97656250000000000"'
-9.765625e+16
---
 pp.c          |  7 +++----
 t/op/negate.t | 11 +++++++++--
 2 files changed, 12 insertions(+), 6 deletions(-)

diff --git a/pp.c b/pp.c
index fbeb3ae..48fd8c6 100644
--- a/pp.c
+++ b/pp.c
@@ -2156,14 +2156,13 @@ PP(pp_negate)
     tryAMAGICun_MG(neg_amg, AMGf_numeric);
     {
 	SV * const sv = TOPs;
-	const int flags = SvFLAGS(sv);
 
         if( !SvNIOK( sv ) && looks_like_number( sv ) ){
            SvIV_please( sv );
         }   
 
-	if ((flags & SVf_IOK) || ((flags & (SVp_IOK | SVp_NOK)) == SVp_IOK)) {
-	    /* It's publicly an integer, or privately an integer-not-float */
+	if (SvIOK(sv) || (SvOKp(sv) == SVp_IOK)) {
+	    /* It's publicly an integer, or privately just an integer */
 	oops_its_an_int:
 	    if (SvIsUV(sv)) {
 		if (SvIVX(sv) == IV_MIN) {
@@ -2187,7 +2186,7 @@ PP(pp_negate)
 	    }
 #endif
 	}
-	if (SvNIOKp(sv))
+	if (SvNIOKp(sv) && (SvNIOK(sv) || !SvPOK(sv)))
 	    SETn(-SvNV_nomg(sv));
 	else if (SvPOKp(sv)) {
 	    STRLEN len;
diff --git a/t/op/negate.t b/t/op/negate.t
index 8a0ef2b..62dc418 100644
--- a/t/op/negate.t
+++ b/t/op/negate.t
@@ -6,7 +6,7 @@ BEGIN {
     require './test.pl';
 }
 
-plan tests => 16;
+plan tests => 18;
 
 # Some of these will cause warnings if left on.  Here we're checking the
 # functionality, not the warnings.
@@ -28,4 +28,11 @@ is(-bareword, "-bareword", "Negation of bareword treated like a string");
 is(- -bareword, "+bareword", "Negation of -bareword returns string +bareword");
 is(-" -10", 10, "Negation of a whitespace-lead numeric string");
 is(-" -10.0", 10, "Negation of a whitespace-lead decimal string");
-is(-" -10foo", 10, "Negation of a whitespace-lead sting starting with a numeric")
+is(-" -10foo", 10,
+    "Negation of a whitespace-lead sting starting with a numeric");
+
+$x = "dogs";
+()=0+$x;
+is -$x, '-dogs', 'cached numeric value does not sabotage string negation';
+
+is(-"97656250000000000", -97656250000000000, '-bigint vs -"bigint"');
-- 
1.8.3.1