[perl #115260] Stop length($obj) from returning undef

When commit 9f621bb00 made length(undef) return undef, it also made it
return undef for objects with string overloading that returns undef.

But stringifying as undef is a contradiction in terms, and this makes
length inconsistent with defined, which returns true for such objects.

Changing this allows is to simplify pp_length, as we can now call
sv_len_utf8 on the argument unconditionally (except under the bytes
pragma).  sv_len_utf8 is now careful not to record caches on magical
or overloaded scalars (any non-PV, in fact).

Note that sv_len is now just a wrapper around SvPV_const, so we use
SvPV_const_nomg, as there is no equivalent sv_len_nomg.

diff --git a/pp.c b/pp.c
index 28a774e..1c68e5a 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -2888,35 +2888,16 @@ PP(pp_length)
     dVAR; dSP; dTARGET;
     SV * const sv = TOPs;
 
-    if (SvGAMAGIC(sv)) {
-       /* For an overloaded or magic scalar, we can't know in advance if
-          it's going to be UTF-8 or not. Also, we can't call sv_len_utf8 as
-          it likes to cache the length. Maybe that should be a documented
-          feature of it.
-       */
-       STRLEN len;
-       const char *const p
-           = sv_2pv_flags(sv, &len,
-                          SV_UNDEF_RETURNS_NULL|SV_CONST_RETURN|SV_GMAGIC);
-
-       if (!p) {
-           if (!SvPADTMP(TARG)) {
-               sv_setsv(TARG, &PL_sv_undef);
-               SETTARG;
-           }
-           SETs(&PL_sv_undef);
-       }
-       else if (DO_UTF8(sv)) {
-           SETi(utf8_length((U8*)p, (U8*)p + len));
-       }
-       else
-           SETi(len);
-    } else if (SvOK(sv)) {
-       /* Neither magic nor overloaded.  */
+    SvGETMAGIC(sv);
+    if (SvOK(sv)) {
        if (!IN_BYTES)
-           SETi(sv_len_utf8(sv));
+           SETi(sv_len_utf8_nomg(sv));
        else
-           SETi(sv_len(sv));
+       {
+           STRLEN len;
+           (void)SvPV_nomg_const(sv,len);
+           SETi(len);
+       }
     } else {
        if (!SvPADTMP(TARG)) {
            sv_setsv_nomg(TARG, &PL_sv_undef);

diff --git a/t/op/length.t b/t/op/length.t
index dffc583..b144b09 100644 (file)
--- a/t/op/length.t
+++ b/t/op/length.t
@@ -6,7 +6,7 @@ BEGIN {
     @INC = '../lib';
 }
 
-plan (tests => 39);
+plan (tests => 41);
 
 print "not " unless length("")    == 0;
 print "ok 1\n";
@@ -191,7 +191,12 @@ is($u, undef);
 
 my $uo = bless [], 'U';
 
-is(length($uo), undef, "Length of overloaded reference");
+{
+    my $w;
+    local $SIG{__WARN__} = sub { $w = shift };
+    is(length($uo), 0, "Length of overloaded reference");
+    like $w, qr/uninitialized/, 'uninit warning for stringifying as undef';
+}
 
 my $ul = 3;
 is(($ul = length(undef)), undef, 
@@ -204,11 +209,14 @@ is(($ul = length($u)), undef,
 is($ul, undef, "Assigned length of tied undef with result in TARG");
 
 $ul = 3;
-is(($ul = length($uo)), undef,
+{
+    my $w;
+    local $SIG{__WARN__} = sub { $w = shift };
+    is(($ul = length($uo)), 0,
                 "Returned length of overloaded undef with result in TARG");
-is($ul, undef, "Assigned length of overloaded undef with result in TARG");
-
-# ok(!defined $uo); Turns you can't test this. FIXME for pp_defined?
+    like $w, qr/uninitialized/, 'uninit warning for stringifying as undef';
+}    
+is($ul, 0, "Assigned length of overloaded undef with result in TARG");
 
 {
     my $y = "\x{100}BC";