This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
[perl #3330] warn on increment of an non number/non-magically incable value
authorTony Cook <tony@develop-help.com>
Mon, 12 Aug 2013 02:02:51 +0000 (12:02 +1000)
committerTony Cook <tony@develop-help.com>
Mon, 12 Aug 2013 03:32:21 +0000 (13:32 +1000)
embed.fnc
embed.h
pod/perldiag.pod
proto.h
sv.c
t/lib/warnings/sv

index 624b2aa..e076893 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -2157,7 +2157,9 @@ 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 605ecd4..d89782f 100644 (file)
--- a/embed.h
+++ b/embed.h
 #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
index 9c32c04..01d6a54 100644 (file)
@@ -198,6 +198,13 @@ or a hash or array slice, such as:
 name, and not a subroutine call.  C<exists &sub()> will generate this
 error.
 
+=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</^[a-zA-Z]*[0-9]*\z/>.  See L<perlop/Auto-increment and
+Auto-decrement> for details.
+
 =item Argument "%s" isn't numeric%s
 
 (W numeric) The indicated string was fed as an argument to an operator
diff --git a/proto.h b/proto.h
index a8c0b6d..e027627 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -7108,6 +7108,11 @@ 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);
@@ -7124,6 +7129,12 @@ 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 175940e..593f942 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -1722,26 +1722,24 @@ Perl_sv_setnv_mg(pTHX_ SV *const sv, const NV num)
     SvSETMAGIC(sv);
 }
 
-/* Print an "isn't numeric" warning, using a cleaned-up,
- * printable version of the offending string
+/* 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.
  */
 
-STATIC void
-S_not_a_number(pTHX_ SV *const sv)
-{
-     dVAR;
-     SV *dsv;
-     char tmpbuf[64];
-     const char *pv;
+STATIC const char *
+S_sv_display(pTHX_ SV *const sv, char *tmpbuf, STRLEN tmpbuf_size) {
+    const char *pv;
 
-     PERL_ARGS_ASSERT_NOT_A_NUMBER;
+     PERL_ARGS_ASSERT_SV_DISPLAY;
 
      if (DO_UTF8(sv)) {
-          dsv = newSVpvs_flags("", SVs_TEMP);
+          SV *dsv = newSVpvs_flags("", SVs_TEMP);
           pv = sv_uni_display(dsv, sv, 10, UNI_DISPLAY_ISPRINT);
      } else {
          char *d = tmpbuf;
-         const char * const limit = tmpbuf + sizeof(tmpbuf) - 8;
+         const char * const limit = tmpbuf + tmpbuf_size - 8;
          /* each *s can expand to 4 chars + "...\0",
             i.e. need room for 8 chars */
        
@@ -1790,6 +1788,24 @@ S_not_a_number(pTHX_ SV *const sv)
          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 */
@@ -1801,6 +1817,20 @@ 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
 
@@ -8334,11 +8364,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.
@@ -8369,6 +8399,8 @@ 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;
     }
index 41a4fab..7116811 100644 (file)
@@ -397,3 +397,15 @@ 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 = 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.