Magic increment avoids warning unexpectedly #2051
Comments
From clintp@geeksalad.orgCreated by clintp@geeksalad.orgThe warning for "Argument X isn't numeric" is avoided even when #!/usr/bin/perl -w $m="a"; $m="a,b"; $m="a,b"; I would have expected that since the automagic increment was avoided If the magic autoincrement happens, the warning should be supressed. This also occurs in 5.6 builds as well. Perl Info |
From [Unknown Contact. See original ticket]
|
From @gannett-ggreerOn Mon Jun 05 10:33:42 2000, clintp wrote:
The most likely place to put this warning has a comment nearby that reads: /* Got to punt this as an integer if needs be, but we don't issue so the lack of warning was intentional, probably due to atof() not being As such, I'm not entirely convinced this patch is a good idea but it -- |
From @gannett-ggreer0001-Fix-for-RT-3330-Magic-increment-avoids-warning-unexp.patchFrom 92bd11eccda57f653d1f16528af4b5f6c66d67d9 Mon Sep 17 00:00:00 2001
From: George Greer <perl@greerga.m-l.org>
Date: Sat, 17 Jul 2010 22:59:24 -0400
Subject: [PATCH] Fix for RT#3330: Magic increment avoids warning unexpectedly
The most likely place to put this warning has a comment nearby that reads:
/* 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. */
so the lack of warning was intentional, probably due to atof() not being
able to distinguish between non-numeric strings that result in 0 and
strings like "0a" or ".0x" that legitimately result in 0.
As such, I'm not entirely convinced this patch is a good idea but it
will at least be a point of discussion for whether to change the
behavior or not.
---
sv.c | 8 +++++++-
1 files changed, 7 insertions(+), 1 deletions(-)
diff --git a/sv.c b/sv.c
index f555fc1..0c352d7 100644
--- a/sv.c
+++ b/sv.c
@@ -7508,6 +7508,7 @@ Perl_sv_inc_nomg(pTHX_ register SV *const sv)
while (isALPHA(*d)) d++;
while (isDIGIT(*d)) d++;
if (d < SvEND(sv)) {
+ NV tofloat;
#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
@@ -7543,7 +7544,12 @@ Perl_sv_inc_nomg(pTHX_ register SV *const sv)
#endif
}
#endif /* PERL_PRESERVE_IVUV */
- sv_setnv(sv,Atof(SvPVX_const(sv)) + 1.0);
+
+ d = SvPVX_const(sv);
+ tofloat = Atof(d);
+ if (tofloat == 0.0 && *d != '0' && *d != '.')
+ not_a_number(sv);
+ sv_setnv(sv, tofloat + 1.0);
return;
}
d--;
--
1.7.0.4
|
From @jkeenanOn Sat Jul 17 20:02:48 2010, greerga wrote:
Still true in Perl 5.14.2: ##### $ perl -wE '$m="a";say ++$m;' $ perl -wE '$m="a,b";say $m+0;' $ perl -wE '$m="a,b";say ++$m;' ##### [snip]
Was there any further consideration of this patch or the problem it Thank you very much. |
From @cpansproutOn Fri Apr 20 18:18:24 2012, jkeenan wrote:
I don’t actually understand that part of the code, but I’ve added it to -- Father Chrysostomos |
From @cpansproutOn Sat Jul 17 20:02:48 2010, greerga wrote:
I think it would be better to use looks_like_number to determine whether -- Father Chrysostomos |
From @cpansproutOn Wed May 23 14:55:02 2012, sprout wrote:
issue
Or maybe not. looks_like_number uses grok_number. I think Atof is also -- Father Chrysostomos |
From @tonycozOn Sat Jul 17 20:02:48 2010, greerga wrote:
I tend to think the change is a good idea, but that the patch provided I've added another patch which I think is a better approach that matches The question is - do we? If not, lets close this ticket. Tony |
From @tonycoz0001-perl-3330-warn-on-preincrement-of-an-non-number-non-.patchFrom ca74b01b2ddf6e3546a20c805ce381b1877ae007 Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Tue, 2 Jul 2013 16:13:16 +1000
Subject: [PATCH] [perl #3330] warn on preincrement of an non
number/non-magically incable
This change is incomplete - it needs tests
---
sv.c | 4 +++-
1 file changed, 3 insertions(+), 1 deletion(-)
diff --git a/sv.c b/sv.c
index ec70030..67eea7f 100644
--- a/sv.c
+++ b/sv.c
@@ -8261,11 +8261,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.
@@ -8296,6 +8296,8 @@ Perl_sv_inc_nomg(pTHX_ SV *const sv)
#endif
}
#endif /* PERL_PRESERVE_IVUV */
+ if (!numtype && ckWARN(WARN_NUMERIC))
+ not_a_number(sv);
sv_setnv(sv,Atof(SvPVX_const(sv)) + 1.0);
return;
}
--
1.7.10.4
|
From @rjbs* Tony Cook via RT <perlbug-followup@perl.org> [2013-07-02T02:23:51]
Yes, I think so. -- |
From @tonycozOn Sat Jul 06 12:46:41 2013, perl.p5p@rjbs.manxome.org wrote:
I'll produce a better patch for it sometime. One problem with my patch above is it complains "Argument 'foo!' isn't Tony |
From @tonycozOn Tue Jul 09 22:30:15 2013, tonyc wrote:
Here's an improved change with tests and a different message. Tony |
From @tonycoz0001-perl-3330-warn-on-increment-of-an-non-number-non-mag.patchFrom caee789c8261191f89cb3e3478fffc2f1ec498d3 Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Mon, 5 Aug 2013 16:47:34 +1000
Subject: [PATCH] [perl #3330] warn on increment of an non
number/non-magically incable value
---
embed.fnc | 2 ++
embed.h | 2 ++
pod/perldiag.pod | 7 +++++++
proto.h | 11 ++++++++++
sv.c | 58 +++++++++++++++++++++++++++++++++++++++++------------
t/lib/warnings/sv | 12 +++++++++++
6 files changed, 79 insertions(+), 13 deletions(-)
diff --git a/embed.fnc b/embed.fnc
index f3e351e..07d631f 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -2154,7 +2154,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 9b5125a..d2a0898 100644
--- a/embed.h
+++ b/embed.h
@@ -1572,9 +1572,11 @@
#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/pod/perldiag.pod b/pod/perldiag.pod
index 9c32c04..07536a8 100644
--- a/pod/perldiag.pod
+++ b/pod/perldiag.pod
@@ -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" isn't incrementable (++)
+
+(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 e57f3ea..7c50a2d 100644
--- a/proto.h
+++ b/proto.h
@@ -7101,6 +7101,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);
@@ -7117,6 +7122,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 fcc0761..aa4d296 100644
--- 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\" isn't incrementable (++)", pv);
+}
+
/*
=for apidoc looks_like_number
@@ -8337,11 +8367,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.
@@ -8372,6 +8402,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;
}
diff --git a/t/lib/warnings/sv b/t/lib/warnings/sv
index 41a4fab..b8a3d4a 100644
--- a/t/lib/warnings/sv
+++ b/t/lib/warnings/sv
@@ -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" isn't incrementable (++) at - line 5.
--
1.7.10.4
|
From @cpansproutOn Sun Aug 04 23:48:42 2013, tonyc wrote:
‘Isn’t incrementable’ sounds to me like a croak message, rather than a -- Father Chrysostomos |
From @tonycozOn Mon Aug 05 00:02:29 2013, sprout wrote:
I (mostly) prefer your message. I used just "increment" because sometimes the optimization (I assume) tony@mars:.../git/perl$ ./perl -Ilib -MO=Deparse -e '$x++' so OP_DESC(PL_op) returns the wrong value. An extra improvement might be to report the variable as undefined value Tony |
From @tonycozOn Mon Aug 05 17:22:09 2013, tonyc wrote:
I've pushed a version of this to blead with the rephrased warning. I experiemented with using find_uninit_var() to report the variable (see Is that more due to lack or tuits or an attempt to avoid an explosion of Or is it a bad idea for other reasons? Tony --- a/sv.c PERL_ARGS_ASSERT_NOT_INCREMENTABLE; pv = sv_display(sv, tmpbuf, sizeof(tmpbuf)); - Perl_warner(aTHX_ packWARN(WARN_NUMERIC), |
From @cpansproutOn Sun Aug 11 22:07:13 2013, tonyc wrote:
I don’t think it’s a bad idea in principle, but find_uninit_var would Currently it assumes that if a binop has a defined constant argument I would suggest refactoring parts of find_uninit_var or ck_length or -- Father Chrysostomos |
From @tonycozOn Sun Aug 11 23:48:33 2013, sprout wrote:
For now I've split off the more generic "should we report variable The original issue with this ticket was fixed in Tony |
|
@tonycoz - Status changed from 'open' to 'resolved' |
|
@tonycoz - Status changed from 'resolved' to 'open' |
From @dcollinsnThis was fixed again in 3f7602f and is fixed and tested in blead. Closing. |
From [Unknown Contact. See original ticket]This was fixed again in 3f7602f and is fixed and tested in blead. Closing. |
|
@dcollinsn - Status changed from 'open' to 'resolved' |
Migrated from rt.perl.org#3330 (status was 'resolved')
Searchable as RT3330$
The text was updated successfully, but these errors were encountered: