[perl #113012] String negation under ‘use integer’

This makes the negation operator under the integer pragma (i_int) use
the same logic for determining whether to do string negation as the
regular negation operator.

Before, this did not happen at all under the integer pragma, except
for barewords, resulting in strange inconsistencies:

$ perl -le 'use integer; print -foo'
-foo
$ perl -le 'use integer; print -"foo"'
0

The code for string negation is now in a static routine in pp.c and is
used by both types of negation.

diff --git a/pp.c b/pp.c
index 1742baa..0324c19 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -2149,10 +2149,34 @@ PP(pp_bit_or)
     }
 }
 
+PERL_STATIC_INLINE bool
+S_negate_string(pTHX)
+{
+    dTARGET; dSP;
+    STRLEN len;
+    const char *s;
+    SV * const sv = TOPs;
+    if (!SvPOKp(sv) || SvNIOK(sv) || (!SvPOK(sv) && SvNIOKp(sv)))
+       return FALSE;
+    s = SvPV_nomg_const(sv, len);
+    if (isIDFIRST(*s)) {
+       sv_setpvs(TARG, "-");
+       sv_catsv(TARG, sv);
+    }
+    else if (*s == '+' || (*s == '-' && !looks_like_number(sv))) {
+       sv_setsv_nomg(TARG, sv);
+       *SvPV_force_nomg(TARG, len) = *s == '-' ? '+' : '-';
+    }
+    else return FALSE;
+    SETTARG; PUTBACK;
+    return TRUE;
+}
+
 PP(pp_negate)
 {
     dVAR; dSP; dTARGET;
     tryAMAGICun_MG(neg_amg, AMGf_numeric);
+    if (S_negate_string(aTHX)) return NORMAL;
     {
        SV * const sv = TOPs;
 
@@ -2183,23 +2207,8 @@ PP(pp_negate)
        }
        if (SvNIOKp(sv) && (SvNIOK(sv) || !SvPOK(sv)))
            SETn(-SvNV_nomg(sv));
-       else if (SvPOKp(sv)) {
-           STRLEN len;
-           const char * const s = SvPV_nomg_const(sv, len);
-           if (isIDFIRST(*s)) {
-               sv_setpvs(TARG, "-");
-               sv_catsv(TARG, sv);
-           }
-           else if (*s == '+' || (*s == '-' && !looks_like_number(sv))) {
-               sv_setsv_nomg(TARG, sv);
-               *SvPV_force_nomg(TARG, len) = *s == '-' ? '+' : '-';
-           }
-           else if (SvIV_please_nomg(sv))
+       else if (SvPOKp(sv) && SvIV_please_nomg(sv))
                  goto oops_its_an_int;
-           else
-               sv_setnv(TARG, -SvNV_nomg(sv));
-           SETTARG;
-       }
        else
            SETn(-SvNV_nomg(sv));
     }
@@ -2550,6 +2559,7 @@ PP(pp_i_negate)
 {
     dVAR; dSP; dTARGET;
     tryAMAGICun_MG(neg_amg, 0);
+    if (S_negate_string(aTHX)) return NORMAL;
     {
        SV * const sv = TOPs;
        IV const i = SvIV_nomg(sv);

diff --git a/t/op/negate.t b/t/op/negate.t
index 6c355c7..033beb5 100644 (file)
--- a/t/op/negate.t
+++ b/t/op/negate.t
@@ -6,7 +6,7 @@ BEGIN {
     require './test.pl';
 }
 
-plan tests => 24;
+plan tests => 45;
 
 # Some of these will cause warnings if left on.  Here we're checking the
 # functionality, not the warnings.
@@ -57,3 +57,48 @@ $a = "97656250000000000";
 () = 0+$a;
 $t = $a;
 is -$t, -97656250000000000, 'magic str+int dualvar';
+
+{ # Repeat most of the tests under use integer
+    use integer;
+    is(- 10, -10, "Simple numeric negation to negative");
+    is(- -10, 10, "Simple numeric negation to positive");
+    is(-"10", -10, "Negation of a positive string to negative");
+    is(-"10.0", -10, "Negation of a positive decimal sting to negative");
+    is(-"10foo", -10,
+        "Negation of a numeric-lead string returns negation of numeric");
+    is(-"-10", 10,
+        'Negation of string starting with "-" returns a positive number -'
+       .' integer');
+    "-10" =~ /(.*)/;
+    is(-$1, 10, 'Negation of magical string starting with "-" - integer');
+    is(-"-10.0", 10,
+        'Negation of string starting with "-" returns a positive number - '
+       .'decimal');
+    "-10.0" =~ /(.*)/;
+    is(-$1, 10, 'Negation of magical string starting with "-" - decimal');
+    is(-"-10foo", "+10foo",
+       'Negation of string starting with "-" returns a string starting '
+      .'with "+" - non-numeric');
+    is(-"xyz", "-xyz",
+       'Negation of a negative string adds "-" to the front');
+    is(-"-xyz", "+xyz", "Negation of a negative string to positive");
+    is(-"+xyz", "-xyz", "Negation of a positive string to negative");
+    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");
+
+    $x = "dogs";
+    ()=0+$x;
+    is -$x, '-dogs',
+        'cached numeric value does not sabotage string negation';
+
+    $a = "%apples";
+    chop($au = "%apples\x{100}");
+    is(-$au, -$a, 'utf8 flag makes no difference for string negation');
+    is -"\x{100}", 0, '-(non-ASCII) is equivalent to -(punct)';
+}