Change 32969 by [EMAIL PROTECTED] on 2008/01/12 22:20:39
For 5.12: saner behaviour for `length`
(Make C<length undef> return undef).
Patch mostly by Rafael, with some fine tuning by me.
Affected files ...
... //depot/perl/pod/perlfunc.pod#589 edit
... //depot/perl/pp.c#618 edit
... //depot/perl/sv.c#1484 edit
... //depot/perl/sv.h#342 edit
... //depot/perl/t/lib/warnings/9uninit#17 edit
... //depot/perl/t/lib/warnings/mg#8 edit
... //depot/perl/t/op/length.t#12 edit
... //depot/perl/t/op/vec.t#18 edit
Differences ...
==== //depot/perl/pod/perlfunc.pod#589 (text) ====
Index: perl/pod/perlfunc.pod
--- perl/pod/perlfunc.pod#588~32945~ 2008-01-11 02:05:49.000000000 -0800
+++ perl/pod/perlfunc.pod 2008-01-12 14:20:39.000000000 -0800
@@ -2667,9 +2667,10 @@
=item length
Returns the length in I<characters> of the value of EXPR. If EXPR is
-omitted, returns length of C<$_>. Note that this cannot be used on
-an entire array or hash to find out how many elements these have.
-For that, use C<scalar @array> and C<scalar keys %hash> respectively.
+omitted, returns length of C<$_>. If EXPR is undefined, returns C<undef>.
+Note that this cannot be used on an entire array or hash to find out how
+many elements these have. For that, use C<scalar @array> and C<scalar keys
+%hash> respectively.
Note the I<characters>: if the EXPR is in Unicode, you will get the
number of characters, not the number of bytes. To get the length
==== //depot/perl/pp.c#618 (text) ====
Index: perl/pp.c
--- perl/pp.c#617~32865~ 2008-01-06 03:05:27.000000000 -0800
+++ perl/pp.c 2008-01-12 14:20:39.000000000 -0800
@@ -3018,25 +3018,35 @@
dVAR; dSP; dTARGET;
SV * const sv = TOPs;
- if (SvAMAGIC(sv)) {
- /* For an overloaded 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.
+ if (!SvOK(sv) && !SvGMAGICAL(sv)) {
+ /* FIXME - this doesn't allow GMAGIC to return undef for consistency.
+ */
+ SETs(&PL_sv_undef);
+ } else 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 = SvPV_const(sv, len);
-
- if (DO_UTF8(sv)) {
+ const char *const p
+ = sv_2pv_flags(sv, &len,
+ SV_UNDEF_RETURNS_NULL|SV_CONST_RETURN|SV_GMAGIC);
+
+ if (!p)
+ SETs(&PL_sv_undef);
+ else if (DO_UTF8(sv)) {
SETi(utf8_length((U8*)p, (U8*)p + len));
}
else
SETi(len);
-
+ } else {
+ /* Neither magic nor overloaded. */
+ if (DO_UTF8(sv))
+ SETi(sv_len_utf8(sv));
+ else
+ SETi(sv_len(sv));
}
- else if (DO_UTF8(sv))
- SETi(sv_len_utf8(sv));
- else
- SETi(sv_len(sv));
RETURN;
}
==== //depot/perl/sv.c#1484 (text) ====
Index: perl/sv.c
--- perl/sv.c#1483~32954~ 2008-01-11 05:55:07.000000000 -0800
+++ perl/sv.c 2008-01-12 14:20:39.000000000 -0800
@@ -2810,10 +2810,12 @@
}
}
if (SvREADONLY(sv) && !SvOK(sv)) {
- if (ckWARN(WARN_UNINITIALIZED))
- report_uninit(sv);
if (lp)
*lp = 0;
+ if (flags & SV_UNDEF_RETURNS_NULL)
+ return NULL;
+ if (ckWARN(WARN_UNINITIALIZED))
+ report_uninit(sv);
return (char *)"";
}
}
@@ -2867,10 +2869,12 @@
if (isGV_with_GP(sv))
return glob_2pv((GV *)sv, lp);
- if (!PL_localizing && !(SvFLAGS(sv) & SVs_PADTMP) &&
ckWARN(WARN_UNINITIALIZED))
- report_uninit(sv);
if (lp)
*lp = 0;
+ if (flags & SV_UNDEF_RETURNS_NULL)
+ return NULL;
+ if (!PL_localizing && !(SvFLAGS(sv) & SVs_PADTMP) &&
ckWARN(WARN_UNINITIALIZED))
+ report_uninit(sv);
if (SvTYPE(sv) < SVt_PV)
/* Typically the caller expects that sv_any is not NULL now. */
sv_upgrade(sv, SVt_PV);
==== //depot/perl/sv.h#342 (text) ====
Index: perl/sv.h
--- perl/sv.h#341~32902~ 2008-01-08 09:55:41.000000000 -0800
+++ perl/sv.h 2008-01-12 14:20:39.000000000 -0800
@@ -1685,6 +1685,8 @@
#define SV_COW_SHARED_HASH_KEYS 512
/* This one is only enabled for PERL_OLD_COPY_ON_WRITE */
#define SV_COW_OTHER_PVS 1024
+/* Make sv_2pv_flags return NULL if something is undefined. */
+#define SV_UNDEF_RETURNS_NULL 2048
/* The core is safe for this COW optimisation. XS code on CPAN may not be.
So only default to doing the COW setup if we're in the core.
==== //depot/perl/t/lib/warnings/9uninit#17 (text) ====
Index: perl/t/lib/warnings/9uninit
--- perl/t/lib/warnings/9uninit#16~32247~ 2007-11-08 16:56:20.000000000
-0800
+++ perl/t/lib/warnings/9uninit 2008-01-12 14:20:39.000000000 -0800
@@ -826,8 +826,8 @@
$v = sqrt $m1;
$v = hex $m1;
$v = oct $m1;
-$v = length $m1;
-$v = length;
+$v = oct;
+$v = length; # does not warn
EXPECT
Use of uninitialized value $g1 in atan2 at - line 5.
Use of uninitialized value $m1 in atan2 at - line 5.
@@ -840,8 +840,7 @@
Use of uninitialized value $m1 in sqrt at - line 12.
Use of uninitialized value $m1 in hex at - line 13.
Use of uninitialized value $m1 in oct at - line 14.
-Use of uninitialized value $m1 in length at - line 15.
-Use of uninitialized value $_ in length at - line 16.
+Use of uninitialized value $_ in oct at - line 15.
########
use warnings 'uninitialized';
my ($m1, $v);
==== //depot/perl/t/lib/warnings/mg#8 (text) ====
Index: perl/t/lib/warnings/mg
--- perl/t/lib/warnings/mg#7~27725~ 2006-04-05 12:45:42.000000000 -0700
+++ perl/t/lib/warnings/mg 2008-01-12 14:20:39.000000000 -0800
@@ -46,15 +46,15 @@
# mg.c
use warnings 'uninitialized';
'foo' =~ /(foo)/;
-length $3;
+oct $3;
EXPECT
-Use of uninitialized value $3 in length at - line 4.
+Use of uninitialized value $3 in oct at - line 4.
########
# mg.c
use warnings 'uninitialized';
-length $3;
+oct $3;
EXPECT
-Use of uninitialized value $3 in length at - line 3.
+Use of uninitialized value $3 in oct at - line 3.
########
# mg.c
use warnings 'uninitialized';
==== //depot/perl/t/op/length.t#12 (text) ====
Index: perl/t/op/length.t
--- perl/t/op/length.t#11~32968~ 2008-01-12 13:57:06.000000000 -0800
+++ perl/t/op/length.t 2008-01-12 14:20:39.000000000 -0800
@@ -6,7 +6,7 @@
@INC = '../lib';
}
-plan (tests => 22);
+plan (tests => 28);
print "not " unless length("") == 0;
print "ok 1\n";
@@ -161,3 +161,38 @@
is(length $u, 1, "Length of a UTF-8 scalar returned from tie");
is(length $u, 1, "Again! Again!");
+$^W = 1;
+
+my $warnings = 0;
+
+$SIG{__WARN__} = sub {
+ $warnings++;
+ warn @_;
+};
+
+is(length(undef), undef, "Length of literal undef");
+
+my $u;
+
+is(length($u), undef, "Length of regular scalar");
+
+$u = "Gotcha!";
+
+tie $u, 'Tie::StdScalar';
+
+is(length($u), undef, "Length of tied scalar (MAGIC)");
+
+is($u, undef);
+
+{
+ package U;
+ use overload '""' => sub {return undef;};
+}
+
+my $uo = bless [], 'U';
+
+is(length($uo), undef, "Length of overloaded reference");
+
+# ok(!defined $uo); Turns you can't test this. FIXME for pp_defined?
+
+is($warnings, 0, "There were no warnings");
==== //depot/perl/t/op/vec.t#18 (xtext) ====
Index: perl/t/op/vec.t
--- perl/t/op/vec.t#17~31493~ 2007-06-28 08:05:42.000000000 -0700
+++ perl/t/op/vec.t 2008-01-12 14:20:39.000000000 -0800
@@ -11,7 +11,7 @@
my $Is_EBCDIC = (ord('A') == 193) ? 1 : 0;
is(vec($foo,0,1), 0);
-is(length($foo), 0);
+is(length($foo), undef);
vec($foo,0,1) = 1;
is(length($foo), 1);
is(unpack('C',$foo), 1);
End of Patch.
