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 (file)
--- 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 (file)
--- 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 (file)
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");
+}