Change 16572 by sky@sky-tibook on 2002/05/13 12:30:35
Subject: [PATCH] Re: 'use threads::shared' noisy with -w
From: Dave Mitchell <[EMAIL PROTECTED]>
Date: lör maj 11, 2002 12:52:27 Europe/Stockholm
Message-Id: <[EMAIL PROTECTED]>
Affected files ...
.... //depot/perl/ext/threads/shared/shared.pm#18 edit
.... //depot/perl/ext/threads/shared/t/0nothread.t#3 edit
.... //depot/perl/ext/threads/shared/t/av_refs.t#2 edit
.... //depot/perl/ext/threads/shared/t/av_simple.t#3 edit
.... //depot/perl/ext/threads/shared/t/cond.t#6 edit
.... //depot/perl/ext/threads/shared/t/hv_refs.t#5 edit
.... //depot/perl/ext/threads/shared/t/hv_simple.t#3 edit
.... //depot/perl/ext/threads/shared/t/no_share.t#3 edit
.... //depot/perl/ext/threads/shared/t/queue.t#8 edit
.... //depot/perl/ext/threads/shared/t/semaphore.t#4 edit
.... //depot/perl/ext/threads/shared/t/shared_attr.t#2 edit
.... //depot/perl/ext/threads/shared/t/sv_refs.t#4 edit
.... //depot/perl/ext/threads/shared/t/sv_simple.t#3 edit
.... //depot/perl/xsutils.c#20 edit
Differences ...
==== //depot/perl/ext/threads/shared/shared.pm#18 (text) ====
Index: perl/ext/threads/shared/shared.pm
--- perl/ext/threads/shared/shared.pm#17~16500~ Wed May 8 15:25:01 2002
+++ perl/ext/threads/shared/shared.pm Mon May 13 05:30:35 2002
@@ -32,9 +32,6 @@
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;
@@ -62,11 +59,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__
==== //depot/perl/ext/threads/shared/t/0nothread.t#3 (text) ====
Index: perl/ext/threads/shared/t/0nothread.t
--- perl/ext/threads/shared/t/0nothread.t#2~14464~ Mon Jan 28 05:04:58 2002
+++ perl/ext/threads/shared/t/0nothread.t Mon May 13 05:30:35 2002
@@ -1,4 +1,5 @@
use strict;
+use warnings;
use Config;
BEGIN {
require Test::More;
==== //depot/perl/ext/threads/shared/t/av_refs.t#2 (text) ====
Index: perl/ext/threads/shared/t/av_refs.t
--- perl/ext/threads/shared/t/av_refs.t#1~15933~ Mon Apr 15 14:26:16 2002
+++ perl/ext/threads/shared/t/av_refs.t Mon May 13 05:30:35 2002
@@ -1,3 +1,5 @@
+use warnings;
+
BEGIN {
# chdir 't' if -d 't';
# push @INC ,'../lib';
@@ -12,6 +14,7 @@
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";
==== //depot/perl/ext/threads/shared/t/av_simple.t#3 (text) ====
Index: perl/ext/threads/shared/t/av_simple.t
--- perl/ext/threads/shared/t/av_simple.t#2~14416~ Fri Jan 25 07:04:25 2002
+++ perl/ext/threads/shared/t/av_simple.t Mon May 13 05:30:35 2002
@@ -1,3 +1,5 @@
+use warnings;
+
BEGIN {
# chdir 't' if -d 't';
# push @INC ,'../lib';
@@ -12,6 +14,7 @@
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 @@
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 @@
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 @@
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);
==== //depot/perl/ext/threads/shared/t/cond.t#6 (text) ====
Index: perl/ext/threads/shared/t/cond.t
--- perl/ext/threads/shared/t/cond.t#5~16529~ Thu May 9 14:39:04 2002
+++ perl/ext/threads/shared/t/cond.t Mon May 13 05:30:35 2002
@@ -1,3 +1,5 @@
+use warnings;
+
BEGIN {
chdir 't' if -d 't';
push @INC ,'../lib';
==== //depot/perl/ext/threads/shared/t/hv_refs.t#5 (text) ====
Index: perl/ext/threads/shared/t/hv_refs.t
--- perl/ext/threads/shared/t/hv_refs.t#4~14416~ Fri Jan 25 07:04:25 2002
+++ perl/ext/threads/shared/t/hv_refs.t Mon May 13 05:30:35 2002
@@ -1,3 +1,5 @@
+use warnings;
+
BEGIN {
# chdir 't' if -d 't';
# push @INC ,'../lib';
@@ -12,6 +14,7 @@
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 @@
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 @@
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");
==== //depot/perl/ext/threads/shared/t/hv_simple.t#3 (text) ====
Index: perl/ext/threads/shared/t/hv_simple.t
--- perl/ext/threads/shared/t/hv_simple.t#2~14416~ Fri Jan 25 07:04:25 2002
+++ perl/ext/threads/shared/t/hv_simple.t Mon May 13 05:30:35 2002
@@ -1,3 +1,4 @@
+use warnings;
BEGIN {
# chdir 't' if -d 't';
@@ -13,6 +14,7 @@
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 @@
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}++;
==== //depot/perl/ext/threads/shared/t/no_share.t#3 (text) ====
Index: perl/ext/threads/shared/t/no_share.t
--- perl/ext/threads/shared/t/no_share.t#2~14416~ Fri Jan 25 07:04:25 2002
+++ perl/ext/threads/shared/t/no_share.t Mon May 13 05:30:35 2002
@@ -1,3 +1,5 @@
+use warnings;
+
BEGIN {
# chdir 't' if -d 't';
# push @INC ,'../lib';
@@ -13,6 +15,7 @@
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";
==== //depot/perl/ext/threads/shared/t/queue.t#8 (text) ====
Index: perl/ext/threads/shared/t/queue.t
--- perl/ext/threads/shared/t/queue.t#7~16450~ Tue May 7 13:24:08 2002
+++ perl/ext/threads/shared/t/queue.t Mon May 13 05:30:35 2002
@@ -1,4 +1,4 @@
-
+use warnings;
BEGIN {
chdir 't' if -d 't';
@@ -10,11 +10,11 @@
}
}
-
+use strict;
use threads;
use threads::shared::queue;
-$q = new threads::shared::queue;
+my $q = new threads::shared::queue;
$|++;
print "1..26\n";
==== //depot/perl/ext/threads/shared/t/semaphore.t#4 (text) ====
Index: perl/ext/threads/shared/t/semaphore.t
--- perl/ext/threads/shared/t/semaphore.t#3~16323~ Wed May 1 19:47:22 2002
+++ perl/ext/threads/shared/t/semaphore.t Mon May 13 05:30:35 2002
@@ -1,3 +1,5 @@
+use warnings;
+
BEGIN {
chdir 't' if -d 't';
push @INC ,'../lib';
==== //depot/perl/ext/threads/shared/t/shared_attr.t#2 (text) ====
Index: perl/ext/threads/shared/t/shared_attr.t
--- perl/ext/threads/shared/t/shared_attr.t#1~15938~ Mon Apr 15 15:13:17 2002
+++ perl/ext/threads/shared/t/shared_attr.t Mon May 13 05:30:35 2002
@@ -1,3 +1,4 @@
+use warnings;
BEGIN {
# chdir 't' if -d 't';
@@ -13,6 +14,7 @@
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";
==== //depot/perl/ext/threads/shared/t/sv_refs.t#4 (text) ====
Index: perl/ext/threads/shared/t/sv_refs.t
--- perl/ext/threads/shared/t/sv_refs.t#3~14416~ Fri Jan 25 07:04:25 2002
+++ perl/ext/threads/shared/t/sv_refs.t Mon May 13 05:30:35 2002
@@ -1,3 +1,5 @@
+use warnings;
+
BEGIN {
# chdir 't' if -d 't';
# push @INC ,'../lib';
@@ -12,6 +14,7 @@
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";
==== //depot/perl/ext/threads/shared/t/sv_simple.t#3 (text) ====
Index: perl/ext/threads/shared/t/sv_simple.t
--- perl/ext/threads/shared/t/sv_simple.t#2~14416~ Fri Jan 25 07:04:25 2002
+++ perl/ext/threads/shared/t/sv_simple.t Mon May 13 05:30:35 2002
@@ -1,6 +1,4 @@
-
-
-
+use warnings;
BEGIN {
# chdir 't' if -d 't';
@@ -16,6 +14,7 @@
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";
==== //depot/perl/xsutils.c#20 (text) ====
Index: perl/xsutils.c
--- perl/xsutils.c#19~14802~ Wed Feb 20 14:55:25 2002
+++ perl/xsutils.c Mon May 13 05:30:35 2002
@@ -116,6 +116,14 @@
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) {
End of Patch.
