Re: 'use threads::shared' noisy with -w

Message-Id: <20020510235227.J12298@fdgroup.com>

p4raw-id: //depot/perl@16572

diff --git a/ext/threads/shared/shared.pm b/ext/threads/shared/shared.pm
index ef1aeff..4ffe261 100644 (file)
--- a/ext/threads/shared/shared.pm
+++ b/ext/threads/shared/shared.pm
@@ -32,9 +32,6 @@ our @ISA = qw(Exporter);
 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;
@@ -64,11 +61,6 @@ 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__
 
 =head1 NAME

diff --git a/ext/threads/shared/t/0nothread.t b/ext/threads/shared/t/0nothread.t
index af83a41..2042db3 100644 (file)
--- a/ext/threads/shared/t/0nothread.t
+++ b/ext/threads/shared/t/0nothread.t
@@ -1,4 +1,5 @@
 use strict;
+use warnings;
 use Config;
 BEGIN {
     require Test::More;

diff --git a/ext/threads/shared/t/av_refs.t b/ext/threads/shared/t/av_refs.t
index 334af6b..9a2ec91 100644 (file)
--- a/ext/threads/shared/t/av_refs.t
+++ b/ext/threads/shared/t/av_refs.t
@@ -1,3 +1,5 @@
+use warnings;
+
 BEGIN {
 #    chdir 't' if -d 't';
 #    push @INC ,'../lib';
@@ -12,6 +14,7 @@ BEGIN {
 sub ok {
     my ($id, $ok, $name) = @_;
 
+    $name = '' unless defined $name;
     # You have to do it this way or VMS will get confused.
     print $ok ? "ok $id - $name\n" : "not ok $id - $name\n";
 

diff --git a/ext/threads/shared/t/av_simple.t b/ext/threads/shared/t/av_simple.t
index eb39f8a..f89efee 100644 (file)
--- a/ext/threads/shared/t/av_simple.t
+++ b/ext/threads/shared/t/av_simple.t
@@ -1,3 +1,5 @@
+use warnings;
+
 BEGIN {
 #    chdir 't' if -d 't';
 #    push @INC ,'../lib';
@@ -12,6 +14,7 @@ BEGIN {
 sub ok {
     my ($id, $ok, $name) = @_;
 
+    $name = '' unless defined $name;
     # You have to do it this way or VMS will get confused.
     print $ok ? "ok $id - $name\n" : "not ok $id - $name\n";
 
@@ -35,10 +38,10 @@ $foo[0] = "hi";
 ok(3, $foo[0] eq 'hi', "Check assignment works");
 $foo[0] = "bar";
 ok(4, $foo[0] eq 'bar', "Check overwriting works");
-ok(5, $foo[1] == undef, "Check undef value");
+ok(5, !defined $foo[1], "Check undef value");
 $foo[2] = "test";
 ok(6, $foo[2] eq "test", "Check extending the array works");
-ok(7, $foo[1] == undef, "Check undef value again");
+ok(7, !defined $foo[1], "Check undef value again");
 ok(8, scalar(@foo) == 3, "Check the length of the array");
 ok(9,$#foo == 2, "Check last element of array");
 threads->create(sub { $foo[0] = "thread1" })->join;
@@ -74,9 +77,9 @@ ok(26, $var == 2, "Check shift after thread");
     my @foo2;
     share @foo2;
     my $empty = shift @foo2;
-    ok(27, $empty == undef , "Check shift on empty array");
+    ok(27, !defined $empty, "Check shift on empty array");
     $empty = pop @foo2;
-    ok(28, $empty == undef , "Check pop on empty array");
+    ok(28, !defined $empty, "Check pop on empty array");
 }
 my $i = 0;
 foreach my $var (@foo) {
@@ -99,7 +102,7 @@ $foo[20] = "sky";
 ok(36, delete($foo[20]) eq "sky", "Check delete works");
 
 threads->create(sub { delete($foo[0])})->join();
-ok(37, delete($foo[0]) == undef, "Check that delete works from a thread");
+ok(37, !defined delete($foo[0]), "Check that delete works from a thread");
 
 @foo = (1,2,3,4,5);
 

diff --git a/ext/threads/shared/t/cond.t b/ext/threads/shared/t/cond.t
index 71f6012..28de99c 100644 (file)
--- a/ext/threads/shared/t/cond.t
+++ b/ext/threads/shared/t/cond.t
@@ -1,3 +1,5 @@
+use warnings;
+
 BEGIN {
     chdir 't' if -d 't';
     push @INC ,'../lib';

diff --git a/ext/threads/shared/t/hv_refs.t b/ext/threads/shared/t/hv_refs.t
index 9d9a47b..421ed94 100644 (file)
--- a/ext/threads/shared/t/hv_refs.t
+++ b/ext/threads/shared/t/hv_refs.t
@@ -1,3 +1,5 @@
+use warnings;
+
 BEGIN {
 #    chdir 't' if -d 't';
 #    push @INC ,'../lib';
@@ -12,6 +14,7 @@ BEGIN {
 sub ok {
     my ($id, $ok, $name) = @_;
 
+    $name = '' unless defined $name;
     # You have to do it this way or VMS will get confused.
     print $ok ? "ok $id - $name\n" : "not ok $id - $name\n";
 
@@ -36,7 +39,7 @@ share($foo);
 my %foo;
 share(%foo);
 $foo{"foo"} = \$foo;
-ok(2, ${$foo{foo}} == undef, "Check deref");
+ok(2, !defined ${$foo{foo}}, "Check deref");
 $foo = "test";
 ok(3, ${$foo{foo}} eq "test", "Check deref after assign");
 threads->create(sub{${$foo{foo}} = "test2";})->join();
@@ -58,7 +61,7 @@ ok(9, ${$foo{test}} eq "test", "Check reference");
 skip(10, _thrcnt($gg) == 2, "Check refcount");
 my $gg2 = delete($foo{test});
 skip(11, _thrcnt($gg) == 1, "Check refcount");
-ok(12, _id($gg) == _id($gg2),
+ok(12, _id($$gg) == _id($$gg2),
        sprintf("Check we get the same thing (%x vs %x)",
        _id($$gg),_id($$gg2)));
 ok(13, $$gg eq $$gg2, "And check the values are the same");

diff --git a/ext/threads/shared/t/hv_simple.t b/ext/threads/shared/t/hv_simple.t
index c64988c..fe1ee21 100644 (file)
--- a/ext/threads/shared/t/hv_simple.t
+++ b/ext/threads/shared/t/hv_simple.t
@@ -1,3 +1,4 @@
+use warnings;
 
 BEGIN {
 #    chdir 't' if -d 't';
@@ -13,6 +14,7 @@ BEGIN {
 sub ok {
     my ($id, $ok, $name) = @_;
 
+    $name = '' unless defined $name;
     # You have to do it this way or VMS will get confused.
     print $ok ? "ok $id - $name\n" : "not ok $id - $name\n";
 
@@ -44,15 +46,15 @@ threads->create(sub { ok(3,$hash{"bar"} eq "thread1", "Check thread get and writ
     my $foo = delete($hash{"bar"});
     ok(4, $foo eq "thread1", "Check delete, want 'thread1' got '$foo'");
     $foo = delete($hash{"bar"});
-    ok(5, $foo == undef, "Check delete on empty value");
+    ok(5, !defined $foo, "Check delete on empty value");
 }
 ok(6, keys %hash == 1, "Check keys");
 $hash{"1"} = 1;
 $hash{"2"} = 2;
 $hash{"3"} = 3;
 ok(7, keys %hash == 4, "Check keys");
-ok(8, exists($hash{"1"}) == 1, "Exist on existing key");
-ok(9, exists($hash{"4"}) == undef, "Exists on non existing key");
+ok(8, exists($hash{"1"}), "Exist on existing key");
+ok(9, !exists($hash{"4"}), "Exists on non existing key");
 my %seen;
 foreach my $key ( keys %hash) {
     $seen{$key}++;

diff --git a/ext/threads/shared/t/no_share.t b/ext/threads/shared/t/no_share.t
index 20d598c..7e5a80f 100644 (file)
--- a/ext/threads/shared/t/no_share.t
+++ b/ext/threads/shared/t/no_share.t
@@ -1,3 +1,5 @@
+use warnings;
+
 BEGIN {
 #    chdir 't' if -d 't';
 #    push @INC ,'../lib';
@@ -13,6 +15,7 @@ BEGIN {
 sub ok {
     my ($id, $ok, $name) = @_;
 
+    $name = '' unless defined $name;
     # You have to do it this way or VMS will get confused.
     print $ok ? "ok $id - $name\n" : "not ok $id - $name\n";
 

diff --git a/ext/threads/shared/t/queue.t b/ext/threads/shared/t/queue.t
index e5c0208..259f7f5 100644 (file)
--- a/ext/threads/shared/t/queue.t
+++ b/ext/threads/shared/t/queue.t
@@ -1,4 +1,4 @@
-
+use warnings;
 
 BEGIN {
     chdir 't' if -d 't';
@@ -10,11 +10,11 @@ BEGIN {
     }
 }
 
-
+use strict;
 use threads;
 use threads::shared::queue;
 
-$q = new threads::shared::queue;
+my $q = new threads::shared::queue;
 $|++;
 print "1..26\n";
 

diff --git a/ext/threads/shared/t/semaphore.t b/ext/threads/shared/t/semaphore.t
index 9865e23..12b0a36 100644 (file)
--- a/ext/threads/shared/t/semaphore.t
+++ b/ext/threads/shared/t/semaphore.t
@@ -1,3 +1,5 @@
+use warnings;
+
 BEGIN {
     chdir 't' if -d 't';
     push @INC ,'../lib';

diff --git a/ext/threads/shared/t/shared_attr.t b/ext/threads/shared/t/shared_attr.t
index 63b32a0..367424c 100644 (file)
--- a/ext/threads/shared/t/shared_attr.t
+++ b/ext/threads/shared/t/shared_attr.t
@@ -1,3 +1,4 @@
+use warnings;
 
 BEGIN {
 #    chdir 't' if -d 't';
@@ -13,6 +14,7 @@ BEGIN {
 sub ok {
     my ($id, $ok, $name) = @_;
 
+    $name = '' unless defined $name;
     # You have to do it this way or VMS will get confused.
     print $ok ? "ok $id - $name\n" : "not ok $id - $name\n";
 

diff --git a/ext/threads/shared/t/sv_refs.t b/ext/threads/shared/t/sv_refs.t
index 402ff60..ae4d237 100644 (file)
--- a/ext/threads/shared/t/sv_refs.t
+++ b/ext/threads/shared/t/sv_refs.t
@@ -1,3 +1,5 @@
+use warnings;
+
 BEGIN {
 #    chdir 't' if -d 't';
 #    push @INC ,'../lib';
@@ -12,6 +14,7 @@ BEGIN {
 sub ok {
     my ($id, $ok, $name) = @_;
 
+    $name = '' unless defined $name;
     # You have to do it this way or VMS will get confused.
     print $ok ? "ok $id - $name\n" : "not ok $id - $name\n";
 

diff --git a/ext/threads/shared/t/sv_simple.t b/ext/threads/shared/t/sv_simple.t
index 5c13c6e..0abd2de 100644 (file)
--- a/ext/threads/shared/t/sv_simple.t
+++ b/ext/threads/shared/t/sv_simple.t
@@ -1,6 +1,4 @@
-
-
-
+use warnings;
 
 BEGIN {
 #    chdir 't' if -d 't';
@@ -16,6 +14,7 @@ BEGIN {
 sub ok {
     my ($id, $ok, $name) = @_;
 
+    $name = '' unless defined $name;
     # You have to do it this way or VMS will get confused.
     print $ok ? "ok $id - $name\n" : "not ok $id - $name\n";
 

diff --git a/xsutils.c b/xsutils.c
index f044b6e..b924c48 100644 (file)
--- a/xsutils.c
+++ b/xsutils.c
@@ -116,6 +116,14 @@ modify_SV_attributes(pTHX_ SV *sv, SV **retlist, SV **attrlist, int numattrs)
            switch ((int)len) {
            case 6:
                switch (*name) {
+               case 's':
+                   if (strEQ(name, "shared")) {
+                       if (negated)
+                           Perl_croak(aTHX_ "A variable may not be unshared");
+                       SvSHARE(sv);
+                        continue;
+                    }
+                   break;
                case 'u':
                    if (strEQ(name, "unique")) {
                        if (SvTYPE(sv) == SVt_PVGV) {