From: Artur Bergman Date: Mon, 15 Apr 2002 22:13:17 +0000 (+0000) Subject: Add support for my $foo : shared; X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=81f1a9214bd437d09b9e480cd1e7f6ac27ee2bcd;p=p5sagit%2Fp5-mst-13.2.git Add support for my $foo : shared; Add testcase for this. Update manifest. p4raw-id: //depot/perl@15938 --- diff --git a/MANIFEST b/MANIFEST index ee11406..6bd5646 100644 --- a/MANIFEST +++ b/MANIFEST @@ -640,9 +640,11 @@ ext/threads/shared/shared.pm thread shared variables ext/threads/shared/shared.xs thread shared variables ext/threads/shared/t/0nothread.t Tests for basic shared array functionality. ext/threads/shared/t/av_simple.t Tests for basic shared array functionality. +ext/threads/shared/t/av_refs.t Tests for arrays containing references ext/threads/shared/t/hv_refs.t Test shared hashes containing references ext/threads/shared/t/hv_simple.t Tests for basic shared hash functionality. ext/threads/shared/t/no_share.t Tests for disabled share on variables. +ext/threads/shared/t/shared_attr.t Test :shared attribute ext/threads/shared/t/sv_refs.t thread shared variables ext/threads/shared/t/sv_simple.t thread shared variables ext/threads/shared/typemap thread::shared types diff --git a/ext/threads/shared/shared.pm b/ext/threads/shared/shared.pm index ec86376..83bd92c 100644 --- a/ext/threads/shared/shared.pm +++ b/ext/threads/shared/shared.pm @@ -5,16 +5,16 @@ use Config; require Exporter; our @ISA = qw(Exporter); -our @EXPORT = qw(share cond_wait cond_broadcast cond_signal unlock); -our @EXPORT_OK = qw(_id _thrcnt _refcnt); +our @EXPORT = qw(share cond_wait cond_broadcast cond_signal _refcnt _id _thrcnt); our $VERSION = '0.90'; +use Attribute::Handlers; + if ($Config{'useithreads'}) { *cond_wait = \&cond_wait_enabled; *cond_signal = \&cond_signal_enabled; *cond_broadcast = \&cond_broadcast_enabled; - *unlock = \&unlock_enabled; require XSLoader; XSLoader::load('threads::shared',$VERSION); } @@ -23,15 +23,12 @@ else { *cond_wait = \&cond_wait_disabled; *cond_signal = \&cond_signal_disabled; *cond_broadcast = \&cond_broadcast_disabled; - *unlock = \&unlock_disabled; } sub cond_wait_disabled { return @_ }; sub cond_signal_disabled { return @_}; sub cond_broadcast_disabled { return @_}; -sub unlock_disabled { 1 }; -sub lock_disabled { 1 } sub share_disabled { return @_} $threads::shared::threads_shared = 1; @@ -43,6 +40,10 @@ sub threads::shared::tie::SPLICE die "Splice not implemented for shared arrays"; } +sub UNIVERSAL::shared : ATTR { + my ($package, $symbol, $referent, $attr, $data, $phase) = @_; + share($referent); +} __END__ diff --git a/ext/threads/shared/t/shared_attr.t b/ext/threads/shared/t/shared_attr.t new file mode 100644 index 0000000..63b32a0 --- /dev/null +++ b/ext/threads/shared/t/shared_attr.t @@ -0,0 +1,53 @@ + +BEGIN { +# chdir 't' if -d 't'; +# push @INC ,'../lib'; + require Config; import Config; + unless ($Config{'useithreads'}) { + print "1..0 # Skip: no useithreads\n"; + exit 0; + } +} + + +sub ok { + my ($id, $ok, $name) = @_; + + # You have to do it this way or VMS will get confused. + print $ok ? "ok $id - $name\n" : "not ok $id - $name\n"; + + printf "# Failed test at line %d\n", (caller)[2] unless $ok; + + return $ok; +} + + +use ExtUtils::testlib; +use strict; +BEGIN { print "1..81\n" }; +use threads; +use threads::shared; +ok(1,1,"loaded"); + +my $test_count; +share($test_count); +$test_count = 2; + +for(1..10) { + my $foo : shared = "foo"; + ok($test_count++, $foo eq "foo"); + threads->create(sub { $foo = "bar" })->join(); + ok($test_count++, $foo eq "bar"); + my @foo : shared = ("foo","bar"); + ok($test_count++, $foo[1] eq "bar"); + threads->create(sub { ok($test_count++, shift(@foo) eq "foo")})->join(); + ok($test_count++, $foo[0] eq "bar"); + my %foo : shared = ( foo => "bar" ); + ok($test_count++, $foo{foo} eq "bar"); + threads->create(sub { $foo{bar} = "foo" })->join(); + ok($test_count++, $foo{bar} eq "foo"); + + threads->create(sub { $foo{array} = \@foo})->join(); + threads->create(sub { push @{$foo{array}}, "baz"})->join(); + ok($test_count++, $foo[-1] eq "baz"); +}