diff options
author | Father Chrysostomos <sprout@cpan.org> | 2012-10-16 16:07:19 -0700 |
---|---|---|
committer | Father Chrysostomos <sprout@cpan.org> | 2012-10-16 16:07:19 -0700 |
commit | 0f43fd573c94446b795d95875cb722dd3f61d1fd (patch) | |
tree | 45028462f286a87b798eadf64ae531bee9076d39 | |
parent | 6a97c51d3ccb6044a8e13896ba95a46e330ffa4b (diff) | |
download | perl-0f43fd573c94446b795d95875cb722dd3f61d1fd.tar.gz |
[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.
-rw-r--r-- | pp.c | 35 | ||||
-rw-r--r-- | t/op/length.t | 20 |
2 files changed, 22 insertions, 33 deletions
@@ -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 dffc583d2d..b144b09746 100644 --- 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"; |