From: Nikodemus Siivola <nikodemus@random-state.net>
Date: Wed, 28 May 2008 16:00:35 +0000 (+0000)
Subject: 1.0.17.2: better PRINT-OBJECT method for threads
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;ds=sidebyside;h=19bea9573cb7d5728fe91d6a949ca8303dc78100;p=sbcl.git

1.0.17.2: better PRINT-OBJECT method for threads

 * In addition to name, if any, print current state (RUNNING, ABORTED, or
   FINISHED), and any values returned by the thread if it has finished.
---

diff --git a/src/code/target-thread.lisp b/src/code/target-thread.lisp
index 1ddd0a1..547ee99 100644
--- a/src/code/target-thread.lisp
+++ b/src/code/target-thread.lisp
@@ -39,14 +39,22 @@ in future versions."
       "The name of the thread. Setfable.")
 
 (def!method print-object ((thread thread) stream)
-  (if (thread-name thread)
-      (print-unreadable-object (thread stream :type t :identity t)
-        (prin1 (thread-name thread) stream))
-      (print-unreadable-object (thread stream :type t :identity t)
-        ;; body is empty => there is only one space between type and
-        ;; identity
-        ))
-  thread)
+  (print-unreadable-object (thread stream :type t :identity t)
+    (let* ((cookie (list thread))
+           (info (if (thread-alive-p thread)
+                     :running
+                     (multiple-value-list (join-thread thread :default cookie))))
+           (state (if (eq :running info)
+                      info
+                      (if (eq cookie (car info))
+                          :aborted
+                          :finished)))
+           (values (when (eq :finished state) info)))
+      (format stream "~@[~S ~]~:[~A~;~A~:[ no values~; values: ~:*~{~S~^, ~}~]~]"
+              (thread-name thread)
+              (eq :finished state)
+              state
+              values))))
 
 (defun thread-alive-p (thread)
   #!+sb-doc
diff --git a/version.lisp-expr b/version.lisp-expr
index 7b6d9ef..f71279f 100644
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.17.1"
+"1.0.17.2"