In perl.git, the branch sprout/pok-bug-hunt has been updated <http://perl5.git.perl.org/perl.git/commitdiff/ae98490637726b9a319ce50e9df885abbdcee25b?hp=e990811cd31b93c2cf0d6f8b5d13c11510de153d>
- Log ----------------------------------------------------------------- commit ae98490637726b9a319ce50e9df885abbdcee25b Author: Father Chrysostomos <[email protected]> Date: Wed Jun 6 23:19:47 2012 -0700 Make warn treat $@=3 and $@="3" the same If we get this: $ ./perl -Ilib -e '$@ = "3"; warn' 3 ...caught at -e line 1. then we shouldnât get this: $ ./perl -Ilib -e '$@ = 3; warn' Warning: something's wrong at -e line 1. as the two scalars hold the same value. M pp_sys.c M t/op/warn.t commit be323fabf3257fb0fa5c382600bd2422dfd443fd Author: Father Chrysostomos <[email protected]> Date: Wed Jun 6 23:07:18 2012 -0700 pp.c:pp_negate: Move looks_like_number where it matters Since we already have a check further down to see whether a string begins with an identifier or sign, and since looks_like_number was added for strings representing negative numbers, move the looks_like_number down to where we already know the string begins with '-'. This is a micro-optimisation, but it also makes the code more straightforward (to me at least). This happens to let magical integers-as-strings fall down to code that they used not to reach, so that has to change to account. M pp.c commit 9ac0b05e77293e0a54c7984664630162dccc846e Author: Father Chrysostomos <[email protected]> Date: Wed Jun 6 23:05:24 2012 -0700 pp_negate: Support magic big ints as strings -$1 was treating $1 as a float even if the string consisted of an integer, due to incorrect flag checks. It was doing the same things with tied variables returning str+int dualvars. Simply checking whether the privates flags consist solely of SVp_IOK (which works for tie variables returning pure integers--so I wasnât entirely wrong in adding that logic a few commits ago), isnât suffi- cient. For gmagical variables that have already had get-magic called on them, the private flags are equivalent to public flags for other variables. M pp.c M t/op/negate.t ----------------------------------------------------------------------- Summary of changes: pp.c | 16 +++++----------- pp_sys.c | 2 +- t/op/negate.t | 14 +++++++++++++- t/op/warn.t | 8 +++++++- 4 files changed, 26 insertions(+), 14 deletions(-) diff --git a/pp.c b/pp.c index 6c7ed71..be34595 100644 --- a/pp.c +++ b/pp.c @@ -2227,12 +2227,8 @@ PP(pp_negate) { SV * const sv = TOPs; - if( !SvNIOK( sv ) && looks_like_number( sv ) ){ - SvIV_please_nomg( sv ); - } - - if (SvIOK(sv) || (SvOKp(sv) == SVp_IOK)) { - /* It's publicly an integer, or privately just an integer */ + if (SvIOK(sv) || (SvGMAGICAL(sv) && SvIOKp(sv))) { + /* It's publicly an integer */ oops_its_an_int: if (SvIsUV(sv)) { if (SvIVX(sv) == IV_MIN) { @@ -2265,16 +2261,14 @@ PP(pp_negate) sv_setpvs(TARG, "-"); sv_catsv(TARG, sv); } - else if (*s == '+' || *s == '-') { + else if (*s == '+' || (*s == '-' && !looks_like_number(sv))) { sv_setsv_nomg(TARG, sv); *SvPV_force_nomg(TARG, len) = *s == '-' ? '+' : '-'; } - else { - SvIV_please_nomg(sv); - if (SvIOK(sv)) + else if (SvIV_please_nomg(sv)) goto oops_its_an_int; + else sv_setnv(TARG, -SvNV_nomg(sv)); - } SETTARG; } else diff --git a/pp_sys.c b/pp_sys.c index 472d65e..c609ef1 100644 --- a/pp_sys.c +++ b/pp_sys.c @@ -453,7 +453,7 @@ PP(pp_warn) } else exsv = ERRSV; } - else if (SvPOKp(ERRSV) && SvCUR(ERRSV)) { + else if (SvPOKp(ERRSV) ? SvCUR(ERRSV) : SvNIOKp(ERRSV)) { exsv = sv_newmortal(); sv_setsv_nomg(exsv, ERRSV); sv_catpvs(exsv, "\t...caught"); diff --git a/t/op/negate.t b/t/op/negate.t index 37987ef..6c355c7 100644 --- a/t/op/negate.t +++ b/t/op/negate.t @@ -6,7 +6,7 @@ BEGIN { require './test.pl'; } -plan tests => 22; +plan tests => 24; # Some of these will cause warnings if left on. Here we're checking the # functionality, not the warnings. @@ -40,8 +40,20 @@ $x = "dogs"; is -$x, '-dogs', 'cached numeric value does not sabotage string negation'; is(-"97656250000000000", -97656250000000000, '-bigint vs -"bigint"'); +"9765625000000000" =~ /(\d+)/; +is -$1, -"$1", '-$1 vs -"$1" with big int'; $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)'; + +sub TIESCALAR { bless[] } +sub STORE { $_[0][0] = $_[1] } +sub FETCH { $_[0][0] } + +tie $t, ""; +$a = "97656250000000000"; +() = 0+$a; +$t = $a; +is -$t, -97656250000000000, 'magic str+int dualvar'; diff --git a/t/op/warn.t b/t/op/warn.t index a0a072e..71de5e2 100644 --- a/t/op/warn.t +++ b/t/op/warn.t @@ -7,7 +7,7 @@ BEGIN { require './test.pl'; } -plan 28; +plan 30; my @warnings; my $wa = []; my $ea = []; @@ -186,4 +186,10 @@ is @warnings, 1; object_ok $warnings[0], 'o', 'warn $tie_returning_object_that_stringifes_emptily'; +@warnings = (); +eval "#line 42 Cholmondeley\n \$\@ = '3'; warn"; +eval "#line 42 Cholmondeley\n \$\@ = 3; warn"; +is @warnings, 2; +is $warnings[1], $warnings[0], 'warn treats $@=3 and $@="3" the same way'; + 1; -- Perl5 Master Repository
