From 4754e2fd065a32df17dd4213710de3d4a01feca1 Mon Sep 17 00:00:00 2001 From: Andrew Danger Lyon Date: Tue, 30 Dec 2014 09:18:08 -0800 Subject: [PATCH] changing the error handling system this can be considered a breaking change, per issue #108 as well as discussions at https://github.com/orthecreedence/blackbird/issues/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. --- base.lisp | 20 +++++++++++--------- event-loop.lisp | 10 +++++++--- test/base.lisp | 22 +++++++++++----------- util.lisp | 48 ++++++++++++++++++++++++++++-------------------- 4 files changed, 57 insertions(+), 43 deletions(-) diff --git a/base.lisp b/base.lisp index 0fdd2ff..251443f 100644 --- a/base.lisp +++ b/base.lisp @@ -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 @@ -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.") diff --git a/event-loop.lisp b/event-loop.lisp index 0c4e73e..7f126e7 100644 --- a/event-loop.lisp +++ b/event-loop.lisp @@ -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* @@ -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*) @@ -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: @@ -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." diff --git a/test/base.lisp b/test/base.lisp index 701e0f4..f2cc515 100644 --- a/test/base.lisp +++ b/test/base.lisp @@ -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" diff --git a/util.lisp b/util.lisp index 5f3ad77..3cd2f8b 100644 --- a/util.lisp +++ b/util.lisp @@ -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