Change 32968 by [EMAIL PROTECTED] on 2008/01/12 21:57:06
Fix bug whereby length on a tied scalar that returned a UTF-8 value
would not be correct the first time. (And for the more pathological
case, would be incorrect if the UTF-8-ness of the returned value
changed.)
Affected files ...
... //depot/perl/MANIFEST#1666 edit
... //depot/perl/mg.c#520 edit
... //depot/perl/t/op/length.t#11 edit
... //depot/perl/t/uni/tie.t#1 add
Differences ...
==== //depot/perl/MANIFEST#1666 (text) ====
Index: perl/MANIFEST
--- perl/MANIFEST#1665~32954~ 2008-01-11 05:55:07.000000000 -0800
+++ perl/MANIFEST 2008-01-12 13:57:06.000000000 -0800
@@ -4035,6 +4035,7 @@
t/uni/write.t See if Unicode formats work
t/win32/system.t See if system works in Win*
t/win32/system_tests Test runner for system.t
+t/uni/tie.t See if Unicode tie works
t/x2p/s2p.t See if s2p/psed work
uconfig.h Configuration header for microperl
uconfig.sh Configuration script for microperl
==== //depot/perl/mg.c#520 (text) ====
Index: perl/mg.c
--- perl/mg.c#519~32948~ 2008-01-11 02:42:13.000000000 -0800
+++ perl/mg.c 2008-01-12 13:57:06.000000000 -0800
@@ -308,12 +308,15 @@
}
}
- if (DO_UTF8(sv)) {
+ {
+ /* You can't know whether it's UTF-8 until you get the string again...
+ */
const U8 *s = (U8*)SvPV_const(sv, len);
- len = utf8_length(s, s + len);
+
+ if (DO_UTF8(sv)) {
+ len = utf8_length(s, s + len);
+ }
}
- else
- (void)SvPV_const(sv, len);
return len;
}
==== //depot/perl/t/op/length.t#11 (text) ====
Index: perl/t/op/length.t
--- perl/t/op/length.t#10~19961~ 2003-07-03 06:57:47.000000000 -0700
+++ perl/t/op/length.t 2008-01-12 13:57:06.000000000 -0800
@@ -2,10 +2,11 @@
BEGIN {
chdir 't' if -d 't';
+ require './test.pl';
@INC = '../lib';
}
-print "1..20\n";
+plan (tests => 22);
print "not " unless length("") == 0;
print "ok 1\n";
@@ -148,3 +149,15 @@
substr($a, 0, 1) = '';
print length $a == 998 ? "ok 20\n" : "not ok 20\n";
}
+
+curr_test(21);
+
+require Tie::Scalar;
+
+$u = "ASCII";
+
+tie $u, 'Tie::StdScalar', chr 256;
+
+is(length $u, 1, "Length of a UTF-8 scalar returned from tie");
+is(length $u, 1, "Again! Again!");
+
==== //depot/perl/t/uni/tie.t#1 (text) ====
Index: perl/t/uni/tie.t
--- /dev/null 2008-01-07 11:55:40.503091878 -0800
+++ perl/t/uni/tie.t 2008-01-12 13:57:06.000000000 -0800
@@ -0,0 +1,49 @@
+#!perl -w
+
+BEGIN {
+ if ($ENV{'PERL_CORE'}){
+ chdir 't';
+ @INC = '../lib';
+ }
+}
+
+use Test::More tests => 9;
+use strict;
+
+{
+ package UTF8Toggle;
+
+ sub TIESCALAR {
+ my $class = shift;
+ my $value = shift;
+ my $state = shift||0;
+ return bless [$value, $state], $class;
+ }
+
+ sub FETCH {
+ my $self = shift;
+ $self->[1] = ! $self->[1];
+ if ($self->[1]) {
+ utf8::downgrade($self->[0]);
+ } else {
+ utf8::upgrade($self->[0]);
+ }
+ $self->[0];
+ }
+}
+
+foreach my $t ("ASCII", "B\366se") {
+ my $length = length $t;
+
+ my $u;
+ tie $u, 'UTF8Toggle', $t;
+ is (length $u, $length, "length of '$t'");
+ is (length $u, $length, "length of '$t'");
+ is (length $u, $length, "length of '$t'");
+ is (length $u, $length, "length of '$t'");
+}
+
+{
+ local $TODO = "Need more tests!";
+ fail();
+}
End of Patch.
