From 9c4972d9e75b4597ce8eb071662b3474470a1ada Mon Sep 17 00:00:00 2001 From: Nick Ing-Simmons Date: Fri, 25 Jan 2002 09:35:07 +0000 Subject: [PATCH] threads::shared tidy up: - Add _id() function to shared.xs so we can test refs point at same thing. - Use that rather that comparing stringified ref in shared/t/hv_refs.t - Allow no_share to pass if sharing to works despite mis-ordering. - Change docs of threads to document ->create() (as used in tests), and not mention "new". p4raw-id: //depot/perlio@14410 --- ext/threads/shared/shared.pm | 12 ++++++------ ext/threads/shared/shared.xs | 14 ++++++++++++++ ext/threads/shared/t/hv_refs.t | 24 +++++++++++++----------- ext/threads/shared/t/no_share.t | 11 ++++------- ext/threads/threads.pm | 8 +++----- 5 files changed, 40 insertions(+), 29 deletions(-) diff --git a/ext/threads/shared/shared.pm b/ext/threads/shared/shared.pm index c71dfb3..ec86376 100644 --- a/ext/threads/shared/shared.pm +++ b/ext/threads/shared/shared.pm @@ -6,24 +6,24 @@ 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 $VERSION = '0.90'; -use XSLoader; -XSLoader::load('threads::shared',$VERSION); -BEGIN { - if ($Config{'useithreads'}) { +if ($Config{'useithreads'}) { *cond_wait = \&cond_wait_enabled; *cond_signal = \&cond_signal_enabled; *cond_broadcast = \&cond_broadcast_enabled; *unlock = \&unlock_enabled; - } else { + require XSLoader; + XSLoader::load('threads::shared',$VERSION); +} +else { *share = \&share_disabled; *cond_wait = \&cond_wait_disabled; *cond_signal = \&cond_signal_disabled; *cond_broadcast = \&cond_broadcast_disabled; *unlock = \&unlock_disabled; - } } diff --git a/ext/threads/shared/shared.xs b/ext/threads/shared/shared.xs index 9d9d6d8..5f1b340 100644 --- a/ext/threads/shared/shared.xs +++ b/ext/threads/shared/shared.xs @@ -906,6 +906,20 @@ MODULE = threads::shared PACKAGE = threads::shared PROTOTYPES: ENABLE void +_id(SV *ref) + PROTOTYPE: \[$@%] +CODE: + shared_sv *shared; + if(SvROK(ref)) + ref = SvRV(ref); + if (shared = Perl_sharedsv_find(aTHX_ ref)) { + ST(0) = sv_2mortal(newSViv(PTR2IV(shared))); + XSRETURN(1); + } + XSRETURN_UNDEF; + + +void _refcnt(SV *ref) PROTOTYPE: \[$@%] CODE: diff --git a/ext/threads/shared/t/hv_refs.t b/ext/threads/shared/t/hv_refs.t index cb38d99..9d9a47b 100644 --- a/ext/threads/shared/t/hv_refs.t +++ b/ext/threads/shared/t/hv_refs.t @@ -29,7 +29,7 @@ use ExtUtils::testlib; use strict; BEGIN { print "1..17\n" }; use threads; -use threads::shared; +use threads::shared qw(:DEFAULT _thrcnt _refcnt _id); ok(1,1,"loaded"); my $foo; share($foo); @@ -41,24 +41,26 @@ $foo = "test"; ok(3, ${$foo{foo}} eq "test", "Check deref after assign"); threads->create(sub{${$foo{foo}} = "test2";})->join(); ok(4, $foo eq "test2", "Check after assign in another thread"); -skip(5, threads::shared::_thrcnt($foo) == 2, "Check refcount"); +skip(5, _thrcnt($foo) == 2, "Check refcount"); my $bar = delete($foo{foo}); ok(6, $$bar eq "test2", "check delete"); -skip(7, threads::shared::_thrcnt($foo) == 1, "Check refcount after delete"); +skip(7, _thrcnt($foo) == 1, "Check refcount after delete"); threads->create( sub { -my $test; -share($test); -$test = "thread3"; -$foo{test} = \$test; -})->join(); + my $test; + share($test); + $test = "thread3"; + $foo{test} = \$test; + })->join(); ok(8, ${$foo{test}} eq "thread3", "Check reference created in another thread"); my $gg = $foo{test}; $$gg = "test"; ok(9, ${$foo{test}} eq "test", "Check reference"); -skip(10, threads::shared::_thrcnt($gg) == 2, "Check refcount"); +skip(10, _thrcnt($gg) == 2, "Check refcount"); my $gg2 = delete($foo{test}); -skip(11, threads::shared::_thrcnt($gg) == 1, "Check refcount"); -ok(12, $gg == $gg2, "Check we get the same reference ($gg == $gg2)"); +skip(11, _thrcnt($gg) == 1, "Check refcount"); +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"); ok(14, keys %foo == 0, "And make sure we realy have deleted the values"); { diff --git a/ext/threads/shared/t/no_share.t b/ext/threads/shared/t/no_share.t index 519d9cb..20d598c 100644 --- a/ext/threads/shared/t/no_share.t +++ b/ext/threads/shared/t/no_share.t @@ -1,7 +1,3 @@ - - - - BEGIN { # chdir 't' if -d 't'; # push @INC ,'../lib'; @@ -33,7 +29,7 @@ use threads::shared; use threads; ok(1,1,"loaded"); ok(2,$warnmsg =~ /Warning, threads::shared has already been loaded/, - "threads has warned us"); + "threads has warned us"); my $test = "bar"; share($test); ok(3,$test eq "bar","Test disabled share not interfering"); @@ -42,6 +38,7 @@ threads->create( ok(4,$test eq "bar","Test disabled share after thread"); $test = "baz"; })->join(); -ok(5,$test eq "bar","Test that value hasn't changed in another thread"); +# Value should either remain unchanged or be value set by other thread +ok(5,$test eq "bar" || $test eq 'baz',"Test that value is an expected one"); + - diff --git a/ext/threads/threads.pm b/ext/threads/threads.pm index 7a5a274..a925898 100755 --- a/ext/threads/threads.pm +++ b/ext/threads/threads.pm @@ -61,9 +61,9 @@ sub start_thread { print "Thread started\n"; } -my $thread = threads->new("start_thread","argument"); +my $thread = threads->create("start_thread","argument"); -$thread->new(sub { print "I am a thread"},"argument"); +$thread->create(sub { print "I am a thread"},"argument"); $thread->join(); @@ -100,14 +100,12 @@ a warning if you do it the other way around. =over -=item $thread = new(function, LIST) +=item $thread = threads->create(function, LIST) This will create a new thread with the entry point function and give it LIST as parameters. It will return the corresponding threads object. -create() is an alias to new. - =item $thread->join This will wait for the corresponding thread to join. When it finishes -- 2.7.4