From cd84013aab030da47b76a44fb3f7b6016be85b78 Mon Sep 17 00:00:00 2001 From: Father Chrysostomos Date: Sat, 27 Oct 2012 23:30:28 -0700 Subject: [PATCH] sv.c: !SvLEN does not mean undefined MIME-Version: 1.0 Content-Type: text/plain; charset=utf8 Content-Transfer-Encoding: 8bit There are various SvPOKp(sv) && SvLEN(sv) checks in numeric conversion routines in sv.c, which date back to perl 1. (See .) Back then it did not matter, as str->len (later SvLEN) was always set when there was a PV. It was not until perl 5.003_01 (1edc1566d5) that we got the SvLEN==0 mechanism for PVs not owned by the scalar. (I don’t believe it was actually used till later, so when this became a problem I don’t know--but that’s enough digging.) A regexp returned by ${qr//} is POK but does not own its string. This means that nummifying a regexp will result in a uninitialized warning. The SvLEN check is redundant and problematic, so I am removing it. (This also means I can remove the sv_force_normal calls in the next commit, since shared hash key scalars, which also have SvLEN==0 will no longer need it to pass the SvLEN checks.) This does mean, however, that SVt_REGEXP can reach code paths that expect to be able to use Sv[IN]VX (not valid for regexps), so I actu- ally have to check that the type != SVt_REGEXP as well. We already have code for handling fbm scalars (for which Sv[IN]VX fields are also unusable), so we can send regexps through those paths. --- sv.c | 24 ++++++++++++++---------- t/lib/warnings/9uninit | 14 ++++++++++++++ 2 files changed, 28 insertions(+), 10 deletions(-) diff --git a/sv.c b/sv.c index 7d67981..66eae2c 100644 --- a/sv.c +++ b/sv.c @@ -2063,7 +2063,7 @@ S_sv_2iuv_common(pTHX_ SV *const sv) SvUVX(sv))); } } - else if (SvPOKp(sv) && SvLEN(sv)) { + else if (SvPOKp(sv)) { UV value; const int numtype = grok_number(SvPVX_const(sv), SvCUR(sv), &value); /* We want to avoid a possible problem when we cache an IV/ a UV which @@ -2273,18 +2273,20 @@ Perl_sv_2iv_flags(pTHX_ register SV *const sv, const I32 flags) return PTR2IV(SvRV(sv)); } - if (SvVALID(sv)) { + if (SvVALID(sv) || SvTYPE(sv) == SVt_REGEXP) { /* FBMs use the space for SvIVX and SvNVX for other purposes, and use the same flag bit as SVf_IVisUV, so must not let them cache IVs. In practice they are extremely unlikely to actually get anywhere accessible by user Perl code - the only way that I'm aware of is when a constant subroutine which is used as the second argument to index. + + Regexps have no SvIVX and SvNVX fields. */ if (SvIOKp(sv)) return SvIVX(sv); if (SvNOKp(sv)) return I_V(SvNVX(sv)); - if (SvPOKp(sv) && SvLEN(sv)) { + if (SvPOKp(sv)) { UV value; const int numtype = grok_number(SvPVX_const(sv), SvCUR(sv), &value); @@ -2366,14 +2368,15 @@ Perl_sv_2uv_flags(pTHX_ register SV *const sv, const I32 flags) return PTR2UV(SvRV(sv)); } - if (SvVALID(sv)) { + if (SvVALID(sv) || SvTYPE(sv) == SVt_REGEXP) { /* FBMs use the space for SvIVX and SvNVX for other purposes, and use - the same flag bit as SVf_IVisUV, so must not let them cache IVs. */ + the same flag bit as SVf_IVisUV, so must not let them cache IVs. + Regexps have no SvIVX and SvNVX fields. */ if (SvIOKp(sv)) return SvUVX(sv); if (SvNOKp(sv)) return U_V(SvNVX(sv)); - if (SvPOKp(sv) && SvLEN(sv)) { + if (SvPOKp(sv)) { UV value; const int numtype = grok_number(SvPVX_const(sv), SvCUR(sv), &value); @@ -2432,14 +2435,15 @@ Perl_sv_2nv_flags(pTHX_ register SV *const sv, const I32 flags) dVAR; if (!sv) return 0.0; - if (SvGMAGICAL(sv) || SvVALID(sv)) { + if (SvGMAGICAL(sv) || SvVALID(sv) || SvTYPE(sv) == SVt_REGEXP) { /* FBMs use the space for SvIVX and SvNVX for other purposes, and use - the same flag bit as SVf_IVisUV, so must not let them cache NVs. */ + the same flag bit as SVf_IVisUV, so must not let them cache NVs. + Regexps have no SvIVX and SvNVX fields. */ if (flags & SV_GMAGIC) mg_get(sv); if (SvNOKp(sv)) return SvNVX(sv); - if ((SvPOKp(sv) && SvLEN(sv)) && !SvIOKp(sv)) { + if (SvPOKp(sv) && !SvIOKp(sv)) { if (!SvIOKp(sv) && ckWARN(WARN_NUMERIC) && !grok_number(SvPVX_const(sv), SvCUR(sv), NULL)) not_a_number(sv); @@ -2523,7 +2527,7 @@ Perl_sv_2nv_flags(pTHX_ register SV *const sv, const I32 flags) SvNOKp_on(sv); #endif } - else if (SvPOKp(sv) && SvLEN(sv)) { + else if (SvPOKp(sv)) { UV value; const int numtype = grok_number(SvPVX_const(sv), SvCUR(sv), &value); if (!SvIOKp(sv) && !numtype && ckWARN(WARN_NUMERIC)) diff --git a/t/lib/warnings/9uninit b/t/lib/warnings/9uninit index d1450d5..2877f14 100644 --- a/t/lib/warnings/9uninit +++ b/t/lib/warnings/9uninit @@ -2072,3 +2072,17 @@ Use of uninitialized value $h{"17"} in sprintf at - line 5. Use of uninitialized value $h{"18"} in sprintf at - line 5. Use of uninitialized value $h{"19"} in sprintf at - line 5. Use of uninitialized value $h{"20"} in sprintf at - line 5. +######## +# NAME SvPOK && SvLEN==0 should not produce uninit warning +use warnings 'uninitialized'; + +$v = int(${qr||}); # sv_2iv on a regexp +$v = 1.1 * ${qr||}; # sv_2nv on a regexp +$v = ${qr||} << 2; # sv_2uv on a regexp + +sub TIESCALAR{bless[]} +sub FETCH {${qr||}} +tie $t, ""; +$v = 1.1 * $t; # sv_2nv on a tied regexp + +EXPECT -- 2.7.4