From: Artur Bergman Date: Tue, 12 Feb 2002 14:38:21 +0000 (+0000) Subject: Join support, however something wierd seems to happen with filehandles that are passe... X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=e1c446056ed0878bf6deb2084482fb1f1bdae94e;p=p5sagit%2Fp5-mst-13.2.git Join support, however something wierd seems to happen with filehandles that are passed along threads... p4raw-id: //depot/perl@14659 --- diff --git a/MANIFEST b/MANIFEST index a793e26..eac56da 100644 --- a/MANIFEST +++ b/MANIFEST @@ -633,6 +633,7 @@ ext/threads/shared/t/sv_simple.t thread shared variables ext/threads/shared/typemap thread::shared types ext/threads/t/basic.t ithreads ext/threads/t/libc.t testing libc functions for threadsafetyness +ext/threads/t/join.t Testing the join function ext/threads/t/stress_cv.t Test with multiple threads, coderef cv argument. ext/threads/t/stress_re.t Test with multiple threads, string cv argument and regexes. ext/threads/t/stress_string.t Test with multiple threads, string cv argument. diff --git a/ext/threads/t/join.t b/ext/threads/t/join.t new file mode 100644 index 0000000..f2c88d5 --- /dev/null +++ b/ext/threads/t/join.t @@ -0,0 +1,89 @@ + +BEGIN { + chdir 't' if -d 't'; + @INC = '../lib'; + require Config; import Config; + unless ($Config{'useithreads'}) { + print "1..0 # Skip: no useithreads\n"; + exit 0; + } +} + +use ExtUtils::testlib; +use strict; +BEGIN { print "1..10\n" }; +use threads; +use threads::shared; + +my $test_id = 1; +share($test_id); +use Devel::Peek qw(Dump); + +sub ok { + my ($ok, $name) = @_; + + # You have to do it this way or VMS will get confused. + print $ok ? "ok $test_id - $name\n" : "not ok $test_id - $name\n"; + + printf "# Failed test at line %d\n", (caller)[2] unless $ok; + $test_id++; + return $ok; +} + +ok(1,""); + + +{ + my $retval = threads->create(sub { return ("hi") })->join(); + ok($retval eq 'hi', "Check basic returnvalue"); +} +{ + my ($thread) = threads->create(sub { return (1,2,3) }); + my @retval = $thread->join(); + ok($retval[0] == 1 && $retval[1] == 2 && $retval[2] == 3); +} +{ + my $retval = threads->create(sub { return [1] })->join(); + ok($retval->[0] == 1,"Check that a array ref works"); +} +{ + my $retval = threads->create(sub { return { foo => "bar" }})->join(); + ok($retval->{foo} eq 'bar',"Check that hash refs work"); +} +{ + my $retval = threads->create( sub { + open(my $fh, "+>threadtest") || die $!; + print $fh "test\n"; + return $fh; + })->join(); + ok(ref($retval) eq 'GLOB', "Check that we can return FH $retval"); + print $retval "test2\n"; +# seek($retval,0,0); +# ok(<$retval> eq "test\n"); + close($retval); + unlink("threadtest"); +} +{ + my $test = "hi"; + my $retval = threads->create(sub { return $_[0]}, \$test)->join(); + ok($$retval eq 'hi'); +} +{ + my $test = "hi"; + share($test); + my $retval = threads->create(sub { return $_[0]}, \$test)->join(); + ok($$retval eq 'hi'); + $test = "foo"; + ok($$retval eq 'foo'); +} +{ + my %foo; + share(%foo); + threads->create(sub { + my $foo; + share($foo); + $foo = "thread1"; + return $foo{bar} = \$foo; + })->join(); + ok(1,""); +} diff --git a/ext/threads/threads.xs b/ext/threads/threads.xs index db4ce24..0ba81db 100755 --- a/ext/threads/threads.xs +++ b/ext/threads/threads.xs @@ -206,8 +206,8 @@ Perl_ithread_run(void * arg) { len = call_sv(thread->init_function, thread->gimme|G_EVAL); SPAGAIN; for (i=len-1; i >= 0; i--) { - SV *sv = POPs; - av_store(params, i, SvREFCNT_inc(sv)); + SV *sv = POPs; + av_store(params, i, SvREFCNT_inc(sv)); } PUTBACK; if (SvTRUE(ERRSV)) { @@ -376,7 +376,7 @@ Perl_ithread_self (pTHX_ SV *obj, char* Class) } /* - * joins the thread this code needs to take the returnvalue from the + * Joins the thread this code needs to take the returnvalue from the * call_sv and send it back */ @@ -393,7 +393,7 @@ Perl_ithread_CLONE(pTHX_ SV *obj) } } -void +AV* Perl_ithread_join(pTHX_ SV *obj) { ithread *thread = SV_to_ithread(aTHX_ obj); @@ -407,6 +407,7 @@ Perl_ithread_join(pTHX_ SV *obj) Perl_croak(aTHX_ "Thread already joined"); } else { + AV* retparam; #ifdef WIN32 DWORD waitcode; #else @@ -419,12 +420,26 @@ Perl_ithread_join(pTHX_ SV *obj) pthread_join(thread->thr,&retval); #endif MUTEX_LOCK(&thread->mutex); + + { + AV* params = (AV*) SvRV(thread->params); + CLONE_PARAMS clone_params; + PL_ptr_table = ptr_table_new(); + retparam = (AV*) sv_dup((SV*)params, &clone_params); + SvREFCNT_inc(retparam); + ptr_table_free(PL_ptr_table); + PL_ptr_table = NULL; + + } /* sv_dup over the args */ /* We have finished with it */ thread->detached |= 2; MUTEX_UNLOCK(&thread->mutex); sv_unmagic(SvRV(obj),PERL_MAGIC_shared_scalar); + Perl_ithread_destruct(aTHX_ thread); + return retparam; } + return (AV*)NULL; } void @@ -451,6 +466,8 @@ Perl_ithread_DESTROY(pTHX_ SV *sv) sv_unmagic(SvRV(sv),PERL_MAGIC_shared_scalar); } + + MODULE = threads PACKAGE = threads PREFIX = ithread_ PROTOTYPES: DISABLE @@ -484,6 +501,17 @@ ithread_tid(ithread *thread) void ithread_join(SV *obj) +PPCODE: +{ + AV* params = Perl_ithread_join(aTHX_ obj); + int i; + I32 len = AvFILL(params); + for (i = 0; i <= len; i++) { + XPUSHs(av_shift(params)); + } + SvREFCNT_dec(params); +} + void ithread_detach(ithread *thread) @@ -494,6 +522,7 @@ ithread_DESTROY(SV *thread) BOOT: { ithread* thread; + PL_perl_destruct_level = 2; PERL_THREAD_ALLOC_SPECIFIC(self_key); MUTEX_INIT(&create_mutex); MUTEX_LOCK(&create_mutex);