[Date Prev][Date Next] [Thread Prev][Thread Next] [Date Index][Thread Index][Top&Search][Original]
[PATCH] threads::shared 1.24
The attached patch upgrades blead to threads::shared 1.24.
Changes:
Support utf8 hash keys - fixes
http://rt.cpan.org/Public/Bug/Display.html?id=37149
Uses new watchdog process in test.pl
--- perl-current/MANIFEST 2008-07-02 10:01:07.934358800 -0400
+++ perl-current/MANIFEST 2008-07-02 10:01:25.139906000 -0400
@@ -1150,6 +1150,7 @@
ext/threads/shared/t/stress.t Stress test
ext/threads/shared/t/sv_refs.t thread shared variables
ext/threads/shared/t/sv_simple.t thread shared variables
+ext/threads/shared/t/utf8.t Test UTF-8 keys in shared hashes
ext/threads/shared/t/waithires.t Test sub-second cond_timedwait
ext/threads/shared/t/wait.t Test cond_wait and cond_timedwait
ext/threads/t/basic.t ithreads
--- perl-current/ext/threads/shared/shared.pm 2008-07-02 10:01:07.778086800 -0400
+++ perl-current/ext/threads/shared/shared.pm 2008-07-02 10:01:08.903245200 -0400
@@ -7,7 +7,7 @@
use Scalar::Util qw(reftype refaddr blessed);
-our $VERSION = '1.23';
+our $VERSION = '1.24';
my $XS_VERSION = $VERSION;
$VERSION = eval $VERSION;
@@ -186,7 +186,7 @@
=head1 VERSION
-This document describes threads::shared version 1.23
+This document describes threads::shared version 1.24
=head1 SYNOPSIS
@@ -540,7 +540,7 @@
L<http://www.cpanforum.com/dist/threads-shared>
Annotated POD for L<threads::shared>:
-L<http://annocpan.org/~JDHEDDEN/threads-shared-1.23/shared.pm>
+L<http://annocpan.org/~JDHEDDEN/threads-shared-1.24/shared.pm>
Source repository:
L<http://code.google.com/p/threads-shared/>
--- perl-current/ext/threads/shared/shared.xs 2008-07-02 10:01:07.793714000 -0400
+++ perl-current/ext/threads/shared/shared.xs 2008-07-02 10:01:08.903245200 -0400
@@ -123,6 +123,7 @@
# define NEED_sv_2pv_flags
# define NEED_vnewSVpvf
# define NEED_warner
+# define NEED_newSVpvn_flags
# include "ppport.h"
# include "shared.h"
#endif
@@ -875,7 +876,7 @@
STRLEN len = mg->mg_len;
assert ( mg->mg_ptr != 0 );
if (mg->mg_len == HEf_SVKEY) {
- key = SvPV((SV *) mg->mg_ptr, len);
+ key = SvPVutf8((SV *)mg->mg_ptr, len);
}
SHARED_CONTEXT;
svp = hv_fetch((HV*) saggregate, key, len, 0);
@@ -926,7 +927,7 @@
STRLEN len = mg->mg_len;
assert ( mg->mg_ptr != 0 );
if (mg->mg_len == HEf_SVKEY)
- key = SvPV((SV *) mg->mg_ptr, len);
+ key = SvPVutf8((SV *)mg->mg_ptr, len);
SHARED_CONTEXT;
svp = hv_fetch((HV*) saggregate, key, len, 1);
}
@@ -957,7 +958,7 @@
STRLEN len = mg->mg_len;
assert ( mg->mg_ptr != 0 );
if (mg->mg_len == HEf_SVKEY)
- key = SvPV((SV *) mg->mg_ptr, len);
+ key = SvPVutf8((SV *)mg->mg_ptr, len);
SHARED_CONTEXT;
hv_delete((HV*) saggregate, key, len, G_DISCARD);
}
@@ -1275,7 +1276,7 @@
exists = av_exists((AV*) sobj, SvIV(index));
} else {
STRLEN len;
- char *key = SvPV(index,len);
+ char *key = SvPVutf8(index, len);
SHARED_EDIT;
exists = hv_exists((HV*) sobj, key, len);
}
@@ -1299,7 +1300,7 @@
if (entry) {
key = hv_iterkey(entry,&len);
CALLER_CONTEXT;
- ST(0) = sv_2mortal(newSVpv(key, len));
+ ST(0) = sv_2mortal(newSVpvn_utf8(key, len, 1));
} else {
CALLER_CONTEXT;
ST(0) = &PL_sv_undef;
@@ -1325,7 +1326,7 @@
if (entry) {
key = hv_iterkey(entry,&len);
CALLER_CONTEXT;
- ST(0) = sv_2mortal(newSVpv(key, len));
+ ST(0) = sv_2mortal(newSVpvn_utf8(key, len, 1));
} else {
CALLER_CONTEXT;
ST(0) = &PL_sv_undef;
--- perl-current/ext/threads/shared/t/utf8.t 1969-12-31 19:00:00.000000000 -0500
+++ perl-current/ext/threads/shared/t/utf8.t 2008-07-02 10:01:08.950126800 -0400
@@ -0,0 +1,95 @@
+use strict;
+use warnings;
+
+BEGIN {
+ if ($ENV{'PERL_CORE'}){
+ chdir 't';
+ unshift @INC, '../lib';
+ }
+ use Config;
+ if (! $Config{'useithreads'}) {
+ print("1..0 # SKIP Perl not compiled with 'useithreads'\n");
+ exit(0);
+ }
+}
+
+use ExtUtils::testlib;
+
+my $TEST = 1;
+
+sub is {
+ my ($got, $exp, $name) = @_;
+
+ my $ok = ($got eq $exp);
+
+ # You have to do it this way or VMS will get confused.
+ if ($ok) {
+ print("ok $TEST - $name\n");
+ } else {
+ print("not ok $TEST - $name\n");
+ printf("# Failed test at line %d\n", (caller)[2]);
+ print("# Got: $got\n");
+ print("# Expected: $exp\n");
+ }
+
+ $TEST++;
+
+ return ($ok);
+}
+
+BEGIN {
+ $| = 1;
+ print("1..12\n"); ### Number of tests that will be run ###
+};
+
+use threads;
+use threads::shared;
+
+### Start of Testing ###
+
+binmode STDOUT, ":utf8";
+
+my $plain = 'foo';
+my $utf8 = "\x{123}\x{84}\x{20F}\x{2C1}";
+
+my %a :shared;
+$a{$plain} = $plain;
+$a{$utf8} = $utf8;
+$a{\&is} = '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');
+
+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');
+ } else {
+ is($key, \&is, 'Code ref key in shared hash');
+ }
+}
+
+my $a = &share({});
+$$a{$plain} = $plain;
+$$a{$utf8} = $utf8;
+$$a{\&is} = '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');
+
+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');
+ } else {
+ is($key, \&is, 'Code ref key in shared hash ref');
+ }
+}
+
+exit(0);
+
+# EOF
--- perl-current/ext/threads/shared/t/wait.t 2008-07-02 10:01:07.918731600 -0400
+++ perl-current/ext/threads/shared/t/wait.t 2008-07-02 10:01:08.950126800 -0400
@@ -1,42 +1,26 @@
use strict;
use warnings;
-use Config;
BEGIN {
+ # Import test.pl into its own package
+ {
+ package Test;
+ require 't/test.pl';
+ }
+
if ($ENV{'PERL_CORE'}){
chdir 't';
unshift @INC, '../lib';
}
+
+ use Config;
if (! $Config{'useithreads'}) {
- print("1..0 # SKIP Perl not compiled with 'useithreads'\n");
- exit(0);
+ Test::skip_all(q/Perl not compiled with 'useithreads'/);
}
}
use ExtUtils::testlib;
-### Self-destruct timer child process
-my $TIMEOUT = 600;
-my $timer_pid;
-
-if ($Config{'d_fork'}) {
- $timer_pid = fork();
- if (defined($timer_pid) && ($timer_pid == 0)) {
- # Child process
- my $ppid = getppid();
-
- # Sleep for timeout period
- sleep($TIMEOUT - 2); # Workaround for perlbug #49073
- sleep(2); # Wait for parent to exit
-
- # Kill parent if it still exists
- kill('KILL', $ppid) if (kill(0, $ppid));
- exit(0);
- }
- # Parent will kill this process if tests finish on time
-}
-
-
sub ok {
my ($id, $ok, $name) = @_;
@@ -62,6 +46,7 @@
my $TEST = 1;
ok($TEST++, 1, 'Loaded');
+Test::watchdog(600); # In case we get stuck
### Start of Testing ###
@@ -355,11 +340,6 @@
} # -- SYNCH_REFS block
-# Kill timer process
-if ($timer_pid && kill(0, $timer_pid)) {
- kill('KILL', $timer_pid);
-}
-
# Done
exit(0);
--- perl-current/ext/threads/shared/t/waithires.t 2008-07-02 10:01:07.918731600 -0400
+++ perl-current/ext/threads/shared/t/waithires.t 2008-07-02 10:01:08.965754000 -0400
@@ -1,50 +1,32 @@
use strict;
use warnings;
-use Config;
BEGIN {
+ # Import test.pl into its own package
+ {
+ package Test;
+ require 't/test.pl';
+ }
+
if ($ENV{'PERL_CORE'}){
chdir 't';
unshift @INC, '../lib';
}
+
+ use Config;
if (! $Config{'useithreads'}) {
- print("1..0 # SKIP Perl not compiled with 'useithreads'\n");
- exit(0);
+ Test::skip_all(q/Perl not compiled with 'useithreads'/);
}
+
eval {
require Time::HiRes;
Time::HiRes->import('time');
};
- if ($@) {
- print("1..0 # SKIP Time::HiRes not available.\n");
- exit(0);
- }
+ Test::skip_all('Time::HiRes not available') if ($@);
}
use ExtUtils::testlib;
-### Self-destruct timer child process
-my $TIMEOUT = 60;
-my $timer_pid;
-
-if ($Config{'d_fork'}) {
- $timer_pid = fork();
- if (defined($timer_pid) && ($timer_pid == 0)) {
- # Child process
- my $ppid = getppid();
-
- # Sleep for timeout period
- sleep($TIMEOUT - 2); # Workaround for perlbug #49073
- sleep(2); # Wait for parent to exit
-
- # Kill parent if it still exists
- kill('KILL', $ppid) if (kill(0, $ppid));
- exit(0);
- }
- # Parent will kill this process if tests finish on time
-}
-
-
sub ok {
my ($id, $ok, $name) = @_;
@@ -70,6 +52,7 @@
my $TEST = 1;
ok($TEST++, 1, 'Loaded');
+Test::watchdog(60); # In case we get stuck
### Start of Testing ###
@@ -297,11 +280,6 @@
} # -- SYNCH_REFS block
-# Kill timer process
-if ($timer_pid && kill(0, $timer_pid)) {
- kill('KILL', $timer_pid);
-}
-
# Done
exit(0);
- Follow-Ups from:
-
"Steve Peters" <steve@fisharerojo.org>
[Date Prev][Date Next] [Thread Prev][Thread Next] [Date Index][Thread Index][Top&Search][Original]