[Date Prev][Date Next] [Thread Prev][Thread Next] [Date Index][Thread Index][Top&Search][Original]
[PATCH] threads::shared 1.24 (phase 2)
Additional changes to threads::shared for UTF-8 hash keys.
(Version not bumped as no CPAN was made.)
--- perl-current/ext/threads/shared/shared.xs 2008-07-03 09:59:13.572855200 -0400
+++ perl-current/ext/threads/shared/shared.xs 2008-07-03 09:59:15.713822700 -0400
@@ -876,7 +876,10 @@
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 @@
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 @@
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 @@
} 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 @@
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 @@
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;
--- perl-current/ext/threads/shared/t/utf8.t 2008-07-03 09:59:13.947915200 -0400
+++ perl-current/ext/threads/shared/t/utf8.t 2008-07-03 09:59:15.745077700 -0400
@@ -51,42 +51,47 @@
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');
}
}
--- perl-current/ext/threads/shared/t/wait.t 2008-07-03 09:59:13.947915200 -0400
+++ perl-current/ext/threads/shared/t/wait.t 2008-07-03 09:59:15.745077700 -0400
@@ -2,26 +2,21 @@
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 @@
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 ###
--- perl-current/ext/threads/shared/t/waithires.t 2008-07-03 09:59:13.947915200 -0400
+++ perl-current/ext/threads/shared/t/waithires.t 2008-07-03 09:59:15.745077700 -0400
@@ -2,20 +2,9 @@
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 @@
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');
- Follow-Ups from:
-
"Rafael Garcia-Suarez" <rgarciasuarez@gmail.com>
[Date Prev][Date Next] [Thread Prev][Thread Next] [Date Index][Thread Index][Top&Search][Original]