Skip to content

Commit

Permalink
changing the error handling system
Browse files Browse the repository at this point in the history 
this can be considered a breaking change, per issue #108 as well as
discussions at orthecreedence/blackbird#8. the
idea being that cl-async no longer catches all errors and routes them to
the event-cb callbacks, but instead now looks for event-info conditions
(and all derivatives) and sends *only those* to the event-cb, leaving
all other errors to bubble to the top (debugger).

note that errors only bubble to the top if :catch-app-errors is nil! if
t, *all* errors are still caught, with one important change:

if :caught-errors is given (a function of one argument) when starting
the event loop, then all caught errors are sent to this function to do
what you will with them. in other words, event-cb is no longer the
dumping ground for all conditions when catching errors, now there is a
separate place. note that :caught-errors is only used when
:catch-app-errors is T.
  • Loading branch information
@orthecreedence
orthecreedence committed Dec 30, 2014
1 parent e0f738c commit 4754e2f
Show file tree
Hide file tree
Showing 4 changed files with 57 additions and 43 deletions.
20 changes: 11 additions & 9 deletions base.lisp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -18,6 +18,7 @@
#:event-base-dns-base
#:event-base-dns-ref-count
#:event-base-catch-app-errors
#:event-base-caught-errors
#:event-base-default-event-handler
#:event-base-lock
#:event-base-num-connections-in
Expand Down Expand Up @@ -72,18 +73,19 @@
;; error handling
(catch-app-errors :accessor event-base-catch-app-errors :initarg :catch-app-errors :initform nil
:documentation "If true, attemps to trap all errors produced in the event loop and process them internally")
(caught-errors :accessor event-base-caught-errors :initarg :caught-errors :initform nil
:documentation "If set to a function, will be called with top-level caught errors.")
(default-event-handler :accessor event-base-default-event-handler
:initarg :default-event-handler
:initform (lambda (err)
;; throw the error so we can wrap it in a handler-case
(handler-case (error err)
;; got a connection error, throw it (must
;; do this explicitely since event-error
;; extends event-info)
(event-error () (error err))

;; this is just info, let it slide
(event-info () nil)))
(block exit
(handler-bind
(((and event-info
(not event-error))
(lambda (e)
(declare (ignore e))
(return-from exit))))
(error err))))
:documentation "Used as the default event handler if one is not specified.")
(lock :accessor event-base-lock :initarg :lock :initform (bt:make-lock)
:documentation "Holds *the* lock for this event base.")
Expand Down
10 changes: 7 additions & 3 deletions event-loop.lisp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -71,7 +71,7 @@
(uv:uv-run evloop (cffi:foreign-enum-value 'uv:uv-run-mode :+uv-run-default+))
(do-close-loop evloop (1+ loops)))))

(defun start-event-loop (start-fn &key default-event-cb (catch-app-errors nil catch-app-errors-supplied-p))
(defun start-event-loop (start-fn &key default-event-cb (catch-app-errors nil catch-app-errors-supplied-p) caught-errors)
"Simple wrapper function that starts an event loop which runs the given
callback, most likely to init your server/client."
(when *event-base*
Expand All @@ -88,6 +88,8 @@
:id *event-base-next-id*)
(when catch-app-errors-supplied-p
(list :catch-app-errors catch-app-errors))
(when caught-errors
(list :caught-errors caught-errors))
(when (functionp default-event-cb)
(list :default-event-handler default-event-cb)))))
(*buffer-writes* *buffer-writes*)
Expand Down Expand Up @@ -118,7 +120,7 @@
(remhash (event-base-id *event-base*) *event-base-registry*))
(setf *event-base* nil)))))

(defmacro with-event-loop ((&key default-event-cb (catch-app-errors nil catch-app-errors-supplied-p))
(defmacro with-event-loop ((&key default-event-cb (catch-app-errors nil catch-app-errors-supplied-p) caught-errors)
&body body)
"Makes starting an event loop a tad less annoying. I really couldn't take
typing out `(start-event-loop (lambda () ...) ...) every time. Example:
Expand All @@ -131,7 +133,9 @@
`(as:start-event-loop (lambda () ,@body)
:default-event-cb ,default-event-cb)
(when catch-app-errors-supplied-p
`(:catch-app-errors ,catch-app-errors))))
`(:catch-app-errors ,catch-app-errors))
(when caught-errors
`(:caught-errors ,caught-errors))))

(defun exit-event-loop ()
"Exit the event loop if running."
Expand Down
22 changes: 11 additions & 11 deletions test/base.lisp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -19,17 +19,17 @@

(test catch-app-errors
"Test the global event handler works appropriately"
(is (subtypep
(let ((err nil))
(as:start-event-loop
(lambda ()
(error "Test"))
:catch-app-errors t
:default-event-cb
(lambda (ev)
(setf err ev)))
(type-of err))
'error)))
(let ((err nil))
(handler-case
(as:with-event-loop (:catch-app-errors nil)
(error "lool"))
(error (e) (setf err e)))
(is (subtypep (type-of err) 'error)))
(let ((err nil))
(as:with-event-loop (:catch-app-errors t
:caught-errors (lambda (e) (setf err e)))
(error "oh noo"))
(is (subtypep (type-of err) 'error))))

(test data-and-fn-pointers
"Test for the correct number of data/function pointers for a set of operations"
Expand Down
48 changes: 28 additions & 20 deletions util.lisp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -184,26 +184,34 @@
`(let ((*evcb-err* '()))
(flet ((,thunk-fn ()
(call-with-callback-restarts #'(lambda () ,@body))))
(if (event-base-catch-app-errors *event-base*)
(let ((,evcb (cond ((not (symbolp ,event-cb))
,event-cb)
((fboundp ,event-cb)
(symbol-function ,event-cb))
((null ,event-cb)
(event-base-default-event-handler *event-base*))
(t
(error "invalid event-cb: ~s" ,event-cb)))))
(block ,blk
(handler-bind
((error #'(lambda (,err)
;; check whether the error was already sent to eventcb
(unless (or (member ,err *evcb-err*)
(passthrough-error-p ,err))
;; if that's a new error, handle it by invoking event-cb
(funcall ,evcb ,err)
(return-from ,blk)))))
(,thunk-fn))))
(,thunk-fn)))))))
(let ((,evcb (cond ((not (symbolp ,event-cb))
,event-cb)
((fboundp ,event-cb)
(symbol-function ,event-cb))
((null ,event-cb)
(event-base-default-event-handler *event-base*))
(t
(error "invalid event-cb: ~s" ,event-cb)))))
(block ,blk
(handler-bind
((error #'(lambda (,err)
;; check whether the error was already sent to eventcb
(unless (or (member ,err *evcb-err*)
(passthrough-error-p ,err))
;; if that's a new error, handle it by invoking event-cb
(when (typep ,err 'event-info)
(funcall ,evcb ,err))
(when (event-base-catch-app-errors *event-base*)
(let* ((caught-errors (event-base-caught-errors *event-base*))
(caught-errors (cond ((and (symbolp caught-errors)
(fboundp caught-errors))
(symbol-function caught-errors))
((functionp caught-errors)
caught-errors))))
(when caught-errors
(funcall caught-errors ,err))
(return-from ,blk)))))))
(,thunk-fn)))))))))

(defun run-event-cb (event-cb &rest args)
"When used in the dynamic context of catch-app-errors, wraps the
Expand Down

0 comments on commit 4754e2f

Please sign in to comment.