Change 16389 by jhi@alpha on 2002/05/04 15:40:26
Subject: [PATCH] Re: Data::Dumper tests with -Mutf8
From: Nicholas Clark <[EMAIL PROTECTED]>
Date: Sat, 4 May 2002 00:30:43 +0100
Message-ID: <[EMAIL PROTECTED]>
Affected files ...
.... //depot/perl/ext/Data/Dumper/Dumper.xs#39 edit
.... //depot/perl/ext/Data/Dumper/t/dumper.t#7 edit
Differences ...
==== //depot/perl/ext/Data/Dumper/Dumper.xs#39 (text) ====
Index: perl/ext/Data/Dumper/Dumper.xs
--- perl/ext/Data/Dumper/Dumper.xs.~1~ Sat May 4 09:45:06 2002
+++ perl/ext/Data/Dumper/Dumper.xs Sat May 4 09:45:06 2002
@@ -592,7 +592,8 @@
svp = av_fetch(keys, i, FALSE);
keysv = svp ? *svp : sv_mortalcopy(&PL_sv_undef);
key = SvPV(keysv, keylen);
- svp = hv_fetch((HV*)ival, key, keylen, 0);
+ svp = hv_fetch((HV*)ival, key,
+ SvUTF8(keysv) ? -keylen : keylen, 0);
hval = svp ? *svp : sv_mortalcopy(&PL_sv_undef);
}
else {
@@ -605,15 +606,16 @@
klen = keylen;
if (do_utf8) {
- char *okey = SvPVX(retval) + SvCUR(retval);
+ STRLEN ocur;
I32 nlen;
sv_catsv(retval, totpad);
sv_catsv(retval, ipad);
+ ocur = SvCUR(retval);
nlen = esc_q_utf8(aTHX_ retval, key, klen);
sname = newSVsv(iname);
- sv_catpvn(sname, okey, nlen);
+ sv_catpvn(sname, SvPVX(retval) + ocur, nlen);
sv_catpvn(sname, "}", 1);
}
else {
==== //depot/perl/ext/Data/Dumper/t/dumper.t#7 (xtext) ====
Index: perl/ext/Data/Dumper/t/dumper.t
--- perl/ext/Data/Dumper/t/dumper.t.~1~ Sat May 4 09:45:06 2002
+++ perl/ext/Data/Dumper/t/dumper.t Sat May 4 09:45:06 2002
@@ -67,11 +67,11 @@
$Data::Dumper::Useperl = 1;
if (defined &Data::Dumper::Dumpxs) {
print "### XS extension loaded, will run XS tests\n";
- $TMAX = 339; $XS = 1;
+ $TMAX = 351; $XS = 1;
}
else {
print "### XS extensions not loaded, will NOT run XS tests\n";
- $TMAX = 171; $XS = 0;
+ $TMAX = 177; $XS = 0;
}
print "1..$TMAX\n";
@@ -1310,3 +1310,27 @@
TEST q(Data::Dumper->Dumpxs([$a])), "XS utf8 flag with '";
}
}
+
+# Jarkko found that -Mutf8 caused some tests to fail. Turns out that there
+# was an otherwise untested code path in the XS for utf8 hash keys with purity
+# 1
+
+{
+ $WANT = <<'EOT';
+#$ping = \*::ping;
+#*::ping = \5;
+#*::ping = {
+# "\x{decaf}\x{decaf}\x{decaf}\x{decaf}" => do{my $o}
+#};
+#*::ping{HASH}->{"\x{decaf}\x{decaf}\x{decaf}\x{decaf}"} = *::ping{SCALAR};
+#%pong = %{*::ping{HASH}};
+EOT
+ local $Data::Dumper::Purity = 1;
+ local $Data::Dumper::Sortkeys;
+ $ping = 5;
+ %ping = (chr (0xDECAF) x 4 =>\$ping);
+ for $Data::Dumper::Sortkeys (0, 1) {
+ TEST q(Data::Dumper->Dump([\\*ping, \\%ping], ['*ping', '*pong']));
+ TEST q(Data::Dumper->Dumpxs([\\*ping, \\%ping], ['*ping', '*pong'])) if $XS;
+ }
+}
End of Patch.
