Change 16236 by sky@sky-lab on 2002/04/28 00:15:45
Added test cases and fixed some obvious things.
Affected files ...
.... //depot/perl/MANIFEST#864 edit
.... //depot/perl/ext/threads/t/list.t#1 add
.... //depot/perl/ext/threads/threads.xs#41 edit
Differences ...
==== //depot/perl/MANIFEST#864 (text) ====
Index: perl/MANIFEST
--- perl/MANIFEST.~1~ Sat Apr 27 18:30:05 2002
+++ perl/MANIFEST Sat Apr 27 18:30:05 2002
@@ -675,6 +675,7 @@
ext/threads/t/end.t Test end functions
ext/threads/t/join.t Testing the join function
ext/threads/t/libc.t testing libc functions for threadsafetyness
+ext/threads/t/list.t Test threads->list()
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.
==== //depot/perl/ext/threads/threads.xs#41 (xtext) ====
Index: perl/ext/threads/threads.xs
--- perl/ext/threads/threads.xs.~1~ Sat Apr 27 18:30:05 2002
+++ perl/ext/threads/threads.xs Sat Apr 27 18:30:05 2002
@@ -558,11 +558,15 @@
ithread *curr_thread;
MUTEX_LOCK(&create_destruct_mutex);
curr_thread = threads;
+ PUSHs( sv_2mortal(ithread_to_SV(aTHX_ NULL, curr_thread, classname, TRUE)));
while(curr_thread) {
- PUSHs( ithread_to_SV(aTHX_ NULL, curr_thread, classname, TRUE));
curr_thread = curr_thread->next;
if(curr_thread == threads)
break;
+ if(curr_thread->state & PERL_ITHR_DETACHED ||
+ curr_thread->state & PERL_ITHR_JOINED)
+ continue;
+ PUSHs( sv_2mortal(ithread_to_SV(aTHX_ NULL, curr_thread, classname, TRUE)));
}
MUTEX_UNLOCK(&create_destruct_mutex);
}
==== //depot/perl/ext/threads/t/list.t#1 (text) ====
Index: perl/ext/threads/t/list.t
--- perl/ext/threads/t/list.t.~1~ Sat Apr 27 18:30:05 2002
+++ perl/ext/threads/t/list.t Sat Apr 27 18:30:05 2002
@@ -0,0 +1,53 @@
+
+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 { $| = 1; print "1..8\n" };
+use threads;
+
+
+
+print "ok 1\n";
+
+
+#########################
+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;
+}
+
+
+ok(2, threads->self == (threads->list)[0]);
+
+
+threads->create(sub {})->join();
+ok(3, scalar @{[threads->list]} == 1);
+
+my $thread = threads->create(sub {});
+ok(4, scalar @{[threads->list]} == 2);
+$thread->join();
+ok(5, scalar @{[threads->list]} == 1);
+
+$thread = threads->create(sub { ok(6, threads->self == (threads->list)[1])});
+sleep 1;
+ok(7, $thread == (threads->list)[1]);
+$thread->join();
+ok(8, scalar @{[threads->list]} == 1);
End of Patch.
