From: Jerry D. Hedden Date: Thu, 3 Jul 2008 10:02:30 +0000 (-0400) Subject: threads::shared 1.24 (phase 2) X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=a13351642e6a26cfc620bdb31b15678fd22d224f;p=p5sagit%2Fp5-mst-13.2.git threads::shared 1.24 (phase 2) From: "Jerry D. Hedden" Message-ID: <1ff86f510807030702q74132e14ne6434876a7138f17@mail.gmail.com> Additional changes to threads::shared for UTF-8 hash keys. p4raw-id: //depot/perl@34102 --- diff --git a/ext/threads/shared/shared.xs b/ext/threads/shared/shared.xs index b744796..0848da9 100644 --- a/ext/threads/shared/shared.xs +++ b/ext/threads/shared/shared.xs @@ -876,7 +876,10 @@ sharedsv_elem_mg_FETCH(pTHX_ SV *sv, MAGIC *mg) STRLEN len = mg->mg_len; assert ( mg->mg_ptr != 0 ); if (mg->mg_len == HEf_SVKEY) { - key = SvPVutf8((SV *)mg->mg_ptr, len); + key = SvPV((SV *)mg->mg_ptr, len); + if (SvUTF8((SV *)mg->mg_ptr)) { + len = -len; + } } SHARED_CONTEXT; svp = hv_fetch((HV*) saggregate, key, len, 0); @@ -926,8 +929,12 @@ sharedsv_elem_mg_STORE(pTHX_ SV *sv, MAGIC *mg) char *key = mg->mg_ptr; STRLEN len = mg->mg_len; assert ( mg->mg_ptr != 0 ); - if (mg->mg_len == HEf_SVKEY) - key = SvPVutf8((SV *)mg->mg_ptr, len); + if (mg->mg_len == HEf_SVKEY) { + key = SvPV((SV *)mg->mg_ptr, len); + if (SvUTF8((SV *)mg->mg_ptr)) { + len = -len; + } + } SHARED_CONTEXT; svp = hv_fetch((HV*) saggregate, key, len, 1); } @@ -957,8 +964,12 @@ sharedsv_elem_mg_DELETE(pTHX_ SV *sv, MAGIC *mg) char *key = mg->mg_ptr; STRLEN len = mg->mg_len; assert ( mg->mg_ptr != 0 ); - if (mg->mg_len == HEf_SVKEY) - key = SvPVutf8((SV *)mg->mg_ptr, len); + if (mg->mg_len == HEf_SVKEY) { + key = SvPV((SV *)mg->mg_ptr, len); + if (SvUTF8((SV *)mg->mg_ptr)) { + len = -len; + } + } SHARED_CONTEXT; hv_delete((HV*) saggregate, key, len, G_DISCARD); } @@ -1277,6 +1288,9 @@ EXISTS(SV *obj, SV *index) } else { STRLEN len; char *key = SvPVutf8(index, len); + if (SvUTF8(index)) { + len = -len; + } SHARED_EDIT; exists = hv_exists((HV*) sobj, key, len); } @@ -1298,9 +1312,10 @@ FIRSTKEY(SV *obj) hv_iterinit((HV*) sobj); entry = hv_iternext((HV*) sobj); if (entry) { + I32 utf8 = HeKUTF8(entry); key = hv_iterkey(entry,&len); CALLER_CONTEXT; - ST(0) = sv_2mortal(newSVpvn_utf8(key, len, 1)); + ST(0) = sv_2mortal(newSVpvn_utf8(key, len, utf8)); } else { CALLER_CONTEXT; ST(0) = &PL_sv_undef; @@ -1324,9 +1339,10 @@ NEXTKEY(SV *obj, SV *oldkey) SHARED_CONTEXT; entry = hv_iternext((HV*) sobj); if (entry) { + I32 utf8 = HeKUTF8(entry); key = hv_iterkey(entry,&len); CALLER_CONTEXT; - ST(0) = sv_2mortal(newSVpvn_utf8(key, len, 1)); + ST(0) = sv_2mortal(newSVpvn_utf8(key, len, utf8)); } else { CALLER_CONTEXT; ST(0) = &PL_sv_undef; diff --git a/ext/threads/shared/t/utf8.t b/ext/threads/shared/t/utf8.t index f2e0ac3..42e7c3f 100644 --- a/ext/threads/shared/t/utf8.t +++ b/ext/threads/shared/t/utf8.t @@ -51,42 +51,47 @@ binmode STDOUT, ":utf8"; my $plain = 'foo'; my $utf8 = "\x{123}\x{84}\x{20F}\x{2C1}"; +my $code = \&is; my %a :shared; $a{$plain} = $plain; $a{$utf8} = $utf8; -$a{\&is} = 'code'; +$a{$code} = 'code'; is(exists($a{$plain}), 1, 'Found plain key in shared hash'); is(exists($a{$utf8}), 1, 'Found UTF-8 key in shared hash'); -is(exists($a{\&is}), 1, 'Found code ref key in shared hash'); +is(exists($a{$code}), 1, 'Found code ref key in shared hash'); while (my ($key, $value) = each (%a)) { if ($key eq $plain) { is($key, $plain, 'Plain key in shared hash'); } elsif ($key eq $utf8) { is($key, $utf8, 'UTF-8 key in shared hash'); + } elsif ($key eq "$code") { + is($key, "$code", 'Code ref key in shared hash'); } else { - is($key, \&is, 'Code ref key in shared hash'); + is($key, "???", 'Bad key'); } } my $a = &share({}); $$a{$plain} = $plain; $$a{$utf8} = $utf8; -$$a{\&is} = 'code'; +$$a{$code} = 'code'; is(exists($$a{$plain}), 1, 'Found plain key in shared hash ref'); is(exists($$a{$utf8}), 1, 'Found UTF-8 key in shared hash ref'); -is(exists($$a{\&is}), 1, 'Found code ref key in shared hash ref'); +is(exists($$a{$code}), 1, 'Found code ref key in shared hash ref'); while (my ($key, $value) = each (%$a)) { if ($key eq $plain) { is($key, $plain, 'Plain key in shared hash ref'); } elsif ($key eq $utf8) { is($key, $utf8, 'UTF-8 key in shared hash ref'); + } elsif ($key eq "$code") { + is($key, "$code", 'Code ref key in shared hash ref'); } else { - is($key, \&is, 'Code ref key in shared hash ref'); + is($key, "???", 'Bad key'); } } diff --git a/ext/threads/shared/t/wait.t b/ext/threads/shared/t/wait.t index de8d9f1..e8a7a36 100644 --- a/ext/threads/shared/t/wait.t +++ b/ext/threads/shared/t/wait.t @@ -2,26 +2,21 @@ use strict; use warnings; BEGIN { - # Import test.pl into its own package - if ($ENV{'PERL_CORE'}){ chdir 't'; unshift @INC, '../lib'; - { - package Test; - require 'test.pl'; - } - } else { - { - package Test; - require 't/test.pl'; - } } use Config; if (! $Config{'useithreads'}) { Test::skip_all(q/Perl not compiled with 'useithreads'/); } + + # Import test.pl into its own package + { + package Test; + require($ENV{PERL_CORE} ? 'test.pl' : 't/test.pl'); + } } use ExtUtils::testlib; @@ -51,7 +46,7 @@ use threads::shared; my $TEST = 1; ok($TEST++, 1, 'Loaded'); -Test::watchdog(600); # In case we get stuck +Test::watchdog(60); # In case we get stuck ### Start of Testing ### diff --git a/ext/threads/shared/t/waithires.t b/ext/threads/shared/t/waithires.t index 82913ca..8bb7b05 100644 --- a/ext/threads/shared/t/waithires.t +++ b/ext/threads/shared/t/waithires.t @@ -2,20 +2,9 @@ use strict; use warnings; BEGIN { - # Import test.pl into its own package - if ($ENV{'PERL_CORE'}){ chdir 't'; unshift @INC, '../lib'; - { - package Test; - require 'test.pl'; - } - } else { - { - package Test; - require 't/test.pl'; - } } use Config; @@ -23,6 +12,12 @@ BEGIN { Test::skip_all(q/Perl not compiled with 'useithreads'/); } + # Import test.pl into its own package + { + package Test; + require($ENV{PERL_CORE} ? 'test.pl' : 't/test.pl'); + } + eval { require Time::HiRes; Time::HiRes->import('time');