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 (file)
--- 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 (file)
--- 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"