On Wed, 03 May 2000 10:19:47 +0200, "Stefan Eissing" wrote:
>Background: I have patched DBD::Oracle to recognize utf8 locale
>and return utf8 scalars for Perl 5.6.0. It works. In one of the
>standard tests however, a string with utf8 chars is inserted
>into a BLOB, correctly read back again, but not eq to the original
>string.
Perl 5.6.0 has known bugs in Unicode support (which is why it is
marked "experimental"). eq not knowing about SvUTF8 is one of them.
The attached patch should help.
Sarathy
[EMAIL PROTECTED]
-----------------------------------8<-----------------------------------
Change 5921 by gsar@auger on 2000/04/24 06:58:26
make eq unicode-aware (from Gisle Aas); fix bogus tests revealed
by fix
Affected files ...
... //depot/perl/sv.c#226 edit
... //depot/perl/t/lib/charnames.t#9 edit
... //depot/perl/t/pragma/utf8.t#6 edit
Differences ...
==== //depot/perl/sv.c#226 (text) ====
Index: perl/sv.c
--- perl/sv.c.~1~ Wed May 3 08:41:47 2000
+++ perl/sv.c Wed May 3 08:41:47 2000
@@ -3920,10 +3920,19 @@
else
pv1 = SvPV(str1, cur1);
- if (!str2)
- return !cur1;
- else
- pv2 = SvPV(str2, cur2);
+ if (cur1) {
+ if (!str2)
+ return 0;
+ if (SvUTF8(str1) != SvUTF8(str2)) {
+ if (SvUTF8(str1)) {
+ sv_utf8_upgrade(str2);
+ }
+ else {
+ sv_utf8_upgrade(str1);
+ }
+ }
+ }
+ pv2 = SvPV(str2, cur2);
if (cur1 != cur2)
return 0;
==== //depot/perl/t/lib/charnames.t#9 (text) ====
Index: perl/t/lib/charnames.t
--- perl/t/lib/charnames.t.~1~ Wed May 3 08:41:47 2000
+++ perl/t/lib/charnames.t Wed May 3 08:41:47 2000
@@ -42,15 +42,21 @@
$encoded_be = "\320\261";
$encoded_alpha = "\316\261";
$encoded_bet = "\327\221";
+
+sub to_bytes {
+ use bytes;
+ my $bytes = shift;
+}
+
{
use charnames ':full';
- print "not " unless "\N{CYRILLIC SMALL LETTER BE}" eq $encoded_be;
+ print "not " unless to_bytes("\N{CYRILLIC SMALL LETTER BE}") eq $encoded_be;
print "ok 4\n";
use charnames qw(cyrillic greek :short);
- print "not " unless "\N{be},\N{alpha},\N{hebrew:bet}"
+ print "not " unless to_bytes("\N{be},\N{alpha},\N{hebrew:bet}")
eq "$encoded_be,$encoded_alpha,$encoded_bet";
print "ok 5\n";
}
==== //depot/perl/t/pragma/utf8.t#6 (xtext) ====
Index: perl/t/pragma/utf8.t
--- perl/t/pragma/utf8.t.~1~ Wed May 3 08:41:47 2000
+++ perl/t/pragma/utf8.t Wed May 3 08:41:47 2000
@@ -25,64 +25,64 @@
$_ = ">\x{263A}<";
s/([\x{80}-\x{10ffff}])/"&#".ord($1).";"/eg;
ok $_, '>☺<';
- $test++;
+ $test++; # 1
$_ = ">\x{263A}<";
my $rx = "\x{80}-\x{10ffff}";
s/([$rx])/"&#".ord($1).";"/eg;
ok $_, '>☺<';
- $test++;
+ $test++; # 2
$_ = ">\x{263A}<";
my $rx = "\\x{80}-\\x{10ffff}";
s/([$rx])/"&#".ord($1).";"/eg;
ok $_, '>☺<';
- $test++;
+ $test++; # 3
$_ = "alpha,numeric";
m/([[:alpha:]]+)/;
ok $1, 'alpha';
- $test++;
+ $test++; # 4
$_ = "alphaNUMERICstring";
m/([[:^lower:]]+)/;
ok $1, 'NUMERIC';
- $test++;
+ $test++; # 5
$_ = "alphaNUMERICstring";
m/(\p{Ll}+)/;
ok $1, 'alpha';
- $test++;
+ $test++; # 6
$_ = "alphaNUMERICstring";
m/(\p{Lu}+)/;
ok $1, 'NUMERIC';
- $test++;
+ $test++; # 7
$_ = "alpha,numeric";
m/([\p{IsAlpha}]+)/;
ok $1, 'alpha';
- $test++;
+ $test++; # 8
$_ = "alphaNUMERICstring";
m/([^\p{IsLower}]+)/;
ok $1, 'NUMERIC';
- $test++;
+ $test++; # 9
$_ = "alpha123numeric456";
m/([\p{IsDigit}]+)/;
ok $1, '123';
- $test++;
+ $test++; # 10
$_ = "alpha123numeric456";
m/([^\p{IsDigit}]+)/;
ok $1, 'alpha';
- $test++;
+ $test++; # 11
$_ = ",123alpha,456numeric";
m/([\p{IsAlnum}]+)/;
ok $1, '123alpha';
- $test++;
+ $test++; # 12
}
{
use utf8;
@@ -90,80 +90,88 @@
$_ = "\x{263A}>\x{263A}\x{263A}";
ok length, 4;
- $test++;
+ $test++; # 13
ok length((m/>(.)/)[0]), 1;
- $test++;
+ $test++; # 14
ok length($&), 2;
- $test++;
+ $test++; # 15
ok length($'), 1;
- $test++;
+ $test++; # 16
ok length($`), 1;
- $test++;
+ $test++; # 17
ok length($1), 1;
- $test++;
+ $test++; # 18
ok length($tmp=$&), 2;
- $test++;
+ $test++; # 19
ok length($tmp=$'), 1;
- $test++;
+ $test++; # 20
ok length($tmp=$`), 1;
- $test++;
+ $test++; # 21
ok length($tmp=$1), 1;
- $test++;
+ $test++; # 22
+
+ {
+ use bytes;
- ok $&, pack("C*", ord(">"), 0342, 0230, 0272);
- $test++;
+ my $tmp = $&;
+ ok $tmp, pack("C*", ord(">"), 0342, 0230, 0272);
+ $test++; # 23
- ok $', pack("C*", 0342, 0230, 0272);
- $test++;
+ $tmp = $';
+ ok $tmp, pack("C*", 0342, 0230, 0272);
+ $test++; # 24
- ok $`, pack("C*", 0342, 0230, 0272);
- $test++;
+ $tmp = $`;
+ ok $tmp, pack("C*", 0342, 0230, 0272);
+ $test++; # 25
- ok $1, pack("C*", 0342, 0230, 0272);
- $test++;
+ $tmp = $1;
+ ok $tmp, pack("C*", 0342, 0230, 0272);
+ $test++; # 26
+ }
{
use bytes;
no utf8;
ok length, 10;
- $test++;
+ $test++; # 27
ok length((m/>(.)/)[0]), 1;
- $test++;
+ $test++; # 28
ok length($&), 2;
- $test++;
+ $test++; # 29
ok length($'), 5;
- $test++;
+ $test++; # 30
ok length($`), 3;
- $test++;
+ $test++; # 31
ok length($1), 1;
- $test++;
+ $test++; # 32
ok $&, pack("C*", ord(">"), 0342);
- $test++;
+ $test++; # 33
ok $', pack("C*", 0230, 0272, 0342, 0230, 0272);
- $test++;
+ $test++; # 34
ok $`, pack("C*", 0342, 0230, 0272);
- $test++;
+ $test++; # 35
ok $1, pack("C*", 0342);
- $test++;
+ $test++; # 36
}
@@ -174,80 +182,87 @@
}
ok length, 10;
- $test++;
+ $test++; # 37
ok length((m/>(.)/)[0]), 1;
- $test++;
+ $test++; # 38
ok length($&), 2;
- $test++;
+ $test++; # 39
ok length($'), 1;
- $test++;
+ $test++; # 40
ok length($`), 1;
- $test++;
+ $test++; # 41
ok length($1), 1;
- $test++;
+ $test++; # 42
ok length($tmp=$&), 2;
- $test++;
+ $test++; # 43
ok length($tmp=$'), 1;
- $test++;
+ $test++; # 44
ok length($tmp=$`), 1;
- $test++;
+ $test++; # 45
ok length($tmp=$1), 1;
- $test++;
+ $test++; # 46
- ok $&, pack("C*", ord(">"), 0342, 0230, 0272);
- $test++;
+ {
+ use bytes;
- ok $', pack("C*", 0342, 0230, 0272);
- $test++;
+ my $tmp = $&;
+ ok $tmp, pack("C*", ord(">"), 0342, 0230, 0272);
+ $test++; # 47
- ok $`, pack("C*", 0342, 0230, 0272);
- $test++;
+ $tmp = $';
+ ok $tmp, pack("C*", 0342, 0230, 0272);
+ $test++; # 48
- ok $1, pack("C*", 0342, 0230, 0272);
- $test++;
+ $tmp = $`;
+ ok $tmp, pack("C*", 0342, 0230, 0272);
+ $test++; # 49
+ $tmp = $1;
+ ok $tmp, pack("C*", 0342, 0230, 0272);
+ $test++; # 50
+ }
{
use bytes;
no utf8;
ok length, 10;
- $test++;
+ $test++; # 51
ok length((m/>(.)/)[0]), 1;
- $test++;
+ $test++; # 52
ok length($&), 2;
- $test++;
+ $test++; # 53
ok length($'), 5;
- $test++;
+ $test++; # 54
ok length($`), 3;
- $test++;
+ $test++; # 55
ok length($1), 1;
- $test++;
+ $test++; # 56
ok $&, pack("C*", ord(">"), 0342);
- $test++;
+ $test++; # 57
ok $', pack("C*", 0230, 0272, 0342, 0230, 0272);
- $test++;
+ $test++; # 58
ok $`, pack("C*", 0342, 0230, 0272);
- $test++;
+ $test++; # 59
ok $1, pack("C*", 0342);
- $test++;
+ $test++; # 60
}
}
End of Patch.
