From 2e6f7c2a540619c950910021996e1e6c54dcd4e2 Mon Sep 17 00:00:00 2001 From: Tony Cook Date: Mon, 5 May 2014 11:58:56 +1000 Subject: [PATCH] [perl #121771] Revert the new warning for ++ on non- /\A[a-zA-Z]+[0-9]*\z/ This failed as in it was producing: Argument "123abc" treated as 0 in increment (++) at -e line 1. when the user incremented that value (which is a lie). This reverts commits 8140a7a801e37d147db0e5a8d89551d9d77666e0 and 2cd5095e471e1d84dc9e0b79900ebfd66aabc909. I expect to revert this commit, and add fixes, after 5.20 is released. Conflicts: pod/perldiag.pod --- embed.fnc | 2 -- embed.h | 2 -- lib/diagnostics.t | 3 +++ pod/perldiag.pod | 7 ------- proto.h | 11 ----------- sv.c | 58 +++++++++++++------------------------------------------ t/lib/warnings/sv | 14 -------------- t/op/inc.t | 9 +++------ 8 files changed, 19 insertions(+), 87 deletions(-) diff --git a/embed.fnc b/embed.fnc index 567e587..1545bd2 100644 --- a/embed.fnc +++ b/embed.fnc @@ -2245,9 +2245,7 @@ pX |void |sv_del_backref |NN SV *const tsv|NN SV *const sv #if defined(PERL_IN_SV_C) nsR |char * |uiv_2buf |NN char *const buf|const IV iv|UV uv|const int is_uv|NN char **const peob i |void |sv_unglob |NN SV *const sv|U32 flags -s |const char *|sv_display |NN SV *const sv|NN char *tmpbuf|STRLEN tmpbuf_size s |void |not_a_number |NN SV *const sv -s |void |not_incrementable |NN SV *const sv s |I32 |visit |NN SVFUNC_t f|const U32 flags|const U32 mask # ifdef DEBUGGING s |void |del_sv |NN SV *p diff --git a/embed.h b/embed.h index 0ddaca7..d4b1752 100644 --- a/embed.h +++ b/embed.h @@ -1612,11 +1612,9 @@ #define glob_assign_ref(a,b) S_glob_assign_ref(aTHX_ a,b) #define more_sv() S_more_sv(aTHX) #define not_a_number(a) S_not_a_number(aTHX_ a) -#define not_incrementable(a) S_not_incrementable(aTHX_ a) #define ptr_table_find S_ptr_table_find #define sv_2iuv_common(a) S_sv_2iuv_common(aTHX_ a) #define sv_add_arena(a,b,c) S_sv_add_arena(aTHX_ a,b,c) -#define sv_display(a,b,c) S_sv_display(aTHX_ a,b,c) #define sv_pos_b2u_midway(a,b,c,d) S_sv_pos_b2u_midway(aTHX_ a,b,c,d) #define sv_pos_u2b_cached(a,b,c,d,e,f,g) S_sv_pos_u2b_cached(aTHX_ a,b,c,d,e,f,g) #define sv_pos_u2b_forwards S_sv_pos_u2b_forwards diff --git a/lib/diagnostics.t b/lib/diagnostics.t index 367424e..8868eda 100644 --- a/lib/diagnostics.t +++ b/lib/diagnostics.t @@ -134,12 +134,15 @@ like $warning, 'spaces in warnings with periods at the end are matched lightly'; # Wrapped links +SKIP: { +skip("We no longer have any multi-line links", 1); seek STDERR, 0,0; $warning = ''; warn "Argument \"%s\" treated as 0 in increment (++)"; like $warning, qr/Auto-increment.*Auto-decrement/s, 'multiline links are not truncated'; +} { # Find last warning in perldiag.pod, and last items if any diff --git a/pod/perldiag.pod b/pod/perldiag.pod index bca95e2..f87ca9c 100644 --- a/pod/perldiag.pod +++ b/pod/perldiag.pod @@ -186,13 +186,6 @@ point and did not attempt to push this layer. If your program didn't explicitly request the failing operation, it may be the result of the value of the environment variable PERLIO. -=item Argument "%s" treated as 0 in increment (++) - -(W numeric) The indicated string was fed as an argument to the C<++> -operator which expects either a number or a string matching -C. See L for details. - =item Array @%s missing the @ in argument %d of %s() (D deprecated) Really old Perl let you omit the @ on array names in some diff --git a/proto.h b/proto.h index dd5edde..a553202 100644 --- a/proto.h +++ b/proto.h @@ -7345,11 +7345,6 @@ STATIC void S_not_a_number(pTHX_ SV *const sv) #define PERL_ARGS_ASSERT_NOT_A_NUMBER \ assert(sv) -STATIC void S_not_incrementable(pTHX_ SV *const sv) - __attribute__nonnull__(pTHX_1); -#define PERL_ARGS_ASSERT_NOT_INCREMENTABLE \ - assert(sv) - STATIC PTR_TBL_ENT_t * S_ptr_table_find(PTR_TBL_t *const tbl, const void *const sv) __attribute__warn_unused_result__ __attribute__nonnull__(1); @@ -7366,12 +7361,6 @@ STATIC void S_sv_add_arena(pTHX_ char *const ptr, const U32 size, const U32 flag #define PERL_ARGS_ASSERT_SV_ADD_ARENA \ assert(ptr) -STATIC const char * S_sv_display(pTHX_ SV *const sv, char *tmpbuf, STRLEN tmpbuf_size) - __attribute__nonnull__(pTHX_1) - __attribute__nonnull__(pTHX_2); -#define PERL_ARGS_ASSERT_SV_DISPLAY \ - assert(sv); assert(tmpbuf) - STATIC STRLEN S_sv_pos_b2u_midway(pTHX_ const U8 *const s, const U8 *const target, const U8 *end, STRLEN endu) __attribute__nonnull__(pTHX_1) __attribute__nonnull__(pTHX_2) diff --git a/sv.c b/sv.c index 85f91f1..395431a 100644 --- a/sv.c +++ b/sv.c @@ -1722,24 +1722,26 @@ Perl_sv_setnv_mg(pTHX_ SV *const sv, const NV num) SvSETMAGIC(sv); } -/* Return a cleaned-up, printable version of sv, for non-numeric, or - * not incrementable warning display. - * Originally part of S_not_a_number(). - * The return value may be != tmpbuf. +/* Print an "isn't numeric" warning, using a cleaned-up, + * printable version of the offending string */ -STATIC const char * -S_sv_display(pTHX_ SV *const sv, char *tmpbuf, STRLEN tmpbuf_size) { - const char *pv; +STATIC void +S_not_a_number(pTHX_ SV *const sv) +{ + dVAR; + SV *dsv; + char tmpbuf[64]; + const char *pv; - PERL_ARGS_ASSERT_SV_DISPLAY; + PERL_ARGS_ASSERT_NOT_A_NUMBER; if (DO_UTF8(sv)) { - SV *dsv = newSVpvs_flags("", SVs_TEMP); + dsv = newSVpvs_flags("", SVs_TEMP); pv = sv_uni_display(dsv, sv, 10, UNI_DISPLAY_ISPRINT); } else { char *d = tmpbuf; - const char * const limit = tmpbuf + tmpbuf_size - 8; + const char * const limit = tmpbuf + sizeof(tmpbuf) - 8; /* each *s can expand to 4 chars + "...\0", i.e. need room for 8 chars */ @@ -1790,24 +1792,6 @@ S_sv_display(pTHX_ SV *const sv, char *tmpbuf, STRLEN tmpbuf_size) { pv = tmpbuf; } - return pv; -} - -/* Print an "isn't numeric" warning, using a cleaned-up, - * printable version of the offending string - */ - -STATIC void -S_not_a_number(pTHX_ SV *const sv) -{ - dVAR; - char tmpbuf[64]; - const char *pv; - - PERL_ARGS_ASSERT_NOT_A_NUMBER; - - pv = sv_display(sv, tmpbuf, sizeof(tmpbuf)); - if (PL_op) Perl_warner(aTHX_ packWARN(WARN_NUMERIC), /* diag_listed_as: Argument "%s" isn't numeric%s */ @@ -1819,20 +1803,6 @@ S_not_a_number(pTHX_ SV *const sv) "Argument \"%s\" isn't numeric", pv); } -STATIC void -S_not_incrementable(pTHX_ SV *const sv) { - dVAR; - char tmpbuf[64]; - const char *pv; - - PERL_ARGS_ASSERT_NOT_INCREMENTABLE; - - pv = sv_display(sv, tmpbuf, sizeof(tmpbuf)); - - Perl_warner(aTHX_ packWARN(WARN_NUMERIC), - "Argument \"%s\" treated as 0 in increment (++)", pv); -} - /* =for apidoc looks_like_number @@ -8446,11 +8416,11 @@ Perl_sv_inc_nomg(pTHX_ SV *const sv) while (isALPHA(*d)) d++; while (isDIGIT(*d)) d++; if (d < SvEND(sv)) { - const int numtype = grok_number(SvPVX_const(sv), SvCUR(sv), NULL); #ifdef PERL_PRESERVE_IVUV /* Got to punt this as an integer if needs be, but we don't issue warnings. Probably ought to make the sv_iv_please() that does the conversion if possible, and silently. */ + const int numtype = grok_number(SvPVX_const(sv), SvCUR(sv), NULL); if (numtype && !(numtype & IS_NUMBER_INFINITY)) { /* Need to try really hard to see if it's an integer. 9.22337203685478e+18 is an integer. @@ -8481,8 +8451,6 @@ Perl_sv_inc_nomg(pTHX_ SV *const sv) #endif } #endif /* PERL_PRESERVE_IVUV */ - if (!numtype && ckWARN(WARN_NUMERIC)) - not_incrementable(sv); sv_setnv(sv,Atof(SvPVX_const(sv)) + 1.0); return; } diff --git a/t/lib/warnings/sv b/t/lib/warnings/sv index 87bc368..41a4fab 100644 --- a/t/lib/warnings/sv +++ b/t/lib/warnings/sv @@ -397,17 +397,3 @@ sprintf "%vd", new version v1.1_0; EXPECT vector argument not supported with alpha versions at - line 2. vector argument not supported with alpha versions at - line 4. -######## -# sv.c -my $x = "a_c"; -++$x; -use warnings "numeric"; -$x = "a_c"; ++$x; -$x = ${ qr/abc/ }; ++$x; -$x = 0; ++$x; # none of these should warn -$x = "ABC"; ++$x; -$x = "ABC123"; ++$x; -$x = " +10"; ++$x; -EXPECT -Argument "a_c" treated as 0 in increment (++) at - line 5. -Argument "(?^:abc)" treated as 0 in increment (++) at - line 6. diff --git a/t/op/inc.t b/t/op/inc.t index 5135ab7..8db0660 100644 --- a/t/op/inc.t +++ b/t/op/inc.t @@ -274,12 +274,9 @@ isnt(scalar eval { my $pvbm = PVBM; --$pvbm }, undef, "predecrement defined"); $_ = ${qr //}; $_--; is($_, -1, 'regexp--'); -{ - no warnings 'numeric'; - $_ = ${qr //}; - $_++; - is($_, 1, 'regexp++'); -} +$_ = ${qr //}; +$_++; +is($_, 1, 'regexp++'); $_ = v97; $_++; -- 2.7.4