Added test cases and fixed some obvious things.

p4raw-id: //depot/perl@16236

diff --git a/MANIFEST b/MANIFEST
index 3b8c010..5e53c16 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -675,6 +675,7 @@ ext/threads/t/basic.t               ithreads
 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.

diff --git a/ext/threads/t/list.t b/ext/threads/t/list.t
new file mode 100644 (file)
index 0000000..e5929ed
--- /dev/null
+++ b/ext/threads/t/list.t
@@ -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);

diff --git a/ext/threads/threads.xs b/ext/threads/threads.xs
index ff2df9d..2c1f2a5 100755 (executable)
--- a/ext/threads/threads.xs
+++ b/ext/threads/threads.xs
@@ -558,11 +558,15 @@ PPCODE:
   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);
 }