}
}
+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;
}
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));
}
{
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);
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.
() = 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)';
+}