Commit 4dc55a94 authored by Erick's avatar Erick

Permit to have error messages in threads even without joining them. Adding the...

Permit to have error messages in threads even without joining them. Adding the thread-handler-error-show parameter object
parent ca875a5d
......@@ -18,7 +18,7 @@
;; USA.
;; Author: Erick Gallesio []
;; Creation date: 26-Nov-2000 18:19 (eg)
;; Last file update: 18-Sep-2007 13:15 (eg)
;; Last file update: 28-Oct-2010 14:00 (eg)
;; ======================================================================
......@@ -27,10 +27,12 @@
,(ref :section "Parameter Objects" :text "parameters objects"). These
parmaters are listed below.])
(insertdoc 'real-precision)
(insertdoc 'read-case-sensitive)
(insertdoc 'write-pretty-quotes)
(insertdoc 'load-path)
(insertdoc 'load-suffixes)
(insertdoc 'load-verbose))
(insertdoc 'real-precision)
(insertdoc 'read-case-sensitive)
(insertdoc 'write-pretty-quotes)
(insertdoc 'load-path)
(insertdoc 'load-suffixes)
(insertdoc 'load-verbose)
(insertdoc 'thread-handler-error-show)
......@@ -21,7 +21,7 @@
;;;; Author: Erick Gallesio []
;;;; Creation date: 4-Jun-2000 15:07 (eg)
;;;; Last file update: 12-Aug-2010 22:37 (eg)
;;;; Last file update: 25-Oct-2010 20:39 (eg)
;; This file defines the REPL module. This module does not export anything
......@@ -94,6 +94,8 @@
(set! repl-backtrace bt)))
((condition-has-type? c &message) ;; &message (e.g. ^C)
(format port (condition-ref c 'message)))
((condition-has-type? c &uncaught-exception)
(repl-handler (uncaught-exception-reason c) port))
(else ;; Unknown
(format port "**** Unknown condition raised.\n")
(format port "Condition type: ~A\n" (struct-type-name (struct-type c)))
;;;; thread.stk -- Threads support
;;;; Copyright © 2006 Erick Gallesio - I3S-CNRS/ESSI <>
;;;; Copyright © 2006-2010 Erick Gallesio - I3S-CNRS/ESSI <>
;;;; This program is free software; you can redistribute it and/or modify
......@@ -21,7 +21,7 @@
;;;; Author: Erick Gallesio []
;;;; Creation date: 26-Jan-2006 22:56 (eg)
;;;; Last file update: 25-Oct-2006 17:06 (eg)
;;;; Last file update: 28-Oct-2010 14:03 (eg)
(define (%thread-timeout->seconds timeout)
......@@ -61,15 +61,55 @@ doc>
(define (make-thread thunk :optional (name (symbol->string (gensym "thread")))
(define (show-thread-error c)
(when (and (condition? c)
(condition-has-type? c &error-message))
(let* ((name (thread-name (current-thread)))
(who (condition-ref c 'location))
(msg (condition-ref c 'message))
(bt (condition-ref c 'backtrace))
(loc (%build-error-location who bt)))
(display (do-color 'bold 'red
"**** Error "
(format "(in thread ~S):\n" name)
'bold 'red
(format "~A: ~A\n" (car loc) msg)
" (this error may be signaled again later)\n")
(define (thread-handler c)
(%thread-end-exception-set! (current-thread) c)
(when (thread-handler-error-show)
;; show a message as soon as the error occurs instead of postponing
;; it until the thread is joined
(show-thread-error c))
(%make-thread (lambda ()
(with-handler thread-handler
<doc EXT thread-handler-error-show
* (thread-handler-error-show)
* (thread-handler-error-show value)
* When an untrapped error occurs in a thread, it produces an
* ,(ref :mark "make-thread" "uncaught exception") which can finally be
* trapped when the thread is ,(ref :mark "thread-join!" "joined").
* Setting the |thread-handler-error-show| parameter permits to see
* error message as soon as possible, even without joining the thread.
* This makes debugging easier. By default, this parameter is set to
* |¤t|.
(define thread-handler-error-show (make-parameter #t))
(define (thread-sleep! timeout)
(let ((n (%thread-timeout->seconds timeout)))
This diff is collapsed.
This diff is collapsed.
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment