sv.c: !SvLEN does not mean undefined

There are various SvPOKp(sv) && SvLEN(sv) checks in numeric
conversion routines in sv.c, which date back to perl 1.  (See
<http://perl5.git.perl.org/perl.git/blob/8d063cd8450e59e:/str.c#l89>.)
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.

diff --git a/sv.c b/sv.c
index 7d67981..66eae2c 100644 (file)
--- 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 (file)
--- 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