summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorFather Chrysostomos <sprout@cpan.org>2012-10-16 16:07:19 -0700
committerFather Chrysostomos <sprout@cpan.org>2012-10-16 16:07:19 -0700
commit0f43fd573c94446b795d95875cb722dd3f61d1fd (patch)
tree45028462f286a87b798eadf64ae531bee9076d39
parent6a97c51d3ccb6044a8e13896ba95a46e330ffa4b (diff)
downloadperl-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.c35
-rw-r--r--t/op/length.t20
2 files changed, 22 insertions, 33 deletions
diff --git a/pp.c b/pp.c
index 28a774eba5..1c68e5af02 100644
--- 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 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";