diff options
Diffstat (limited to 'Lisp')
| -rw-r--r-- | Lisp/conditions.lisp | 25 | ||||
| -rw-r--r-- | Lisp/defpackage.lisp | 4 | ||||
| -rw-r--r-- | Lisp/libobjcl.lisp | 3 | ||||
| -rw-r--r-- | Lisp/method-invocation.lisp | 21 | ||||
| -rw-r--r-- | Lisp/tests.lisp | 8 |
5 files changed, 48 insertions, 13 deletions
diff --git a/Lisp/conditions.lisp b/Lisp/conditions.lisp new file mode 100644 index 0000000..839838e --- /dev/null +++ b/Lisp/conditions.lisp @@ -0,0 +1,25 @@ +(in-package #:mulk.objective-cl) + + +(define-condition no-such-selector (error) + ((designator :initarg :designator + :reader rejected-selector-designator)) + (:report (lambda (condition stream) + (with-slots (designator) condition + (format stream + "~S does not designate a known selector." + designator))))) + + +(define-condition message-not-understood (error) + ((selector :initarg :selector + :reader rejected-selector) + (class :initarg :class + :reader rejecting-class)) + (:report (lambda (condition stream) + (with-slots (selector class) condition + (format stream + "The Objective-C class ~S does not understand the ~ + message ~S." + class + selector))))) diff --git a/Lisp/defpackage.lisp b/Lisp/defpackage.lisp index cb2599b..6c00bb7 100644 --- a/Lisp/defpackage.lisp +++ b/Lisp/defpackage.lisp @@ -32,6 +32,10 @@ #:selector #:exception + ;; Conditions + #:message-not-understood + #:no-such-selector + ;; Metaclasses #:objective-c-class)) diff --git a/Lisp/libobjcl.lisp b/Lisp/libobjcl.lisp index aa9c436..1d14e8b 100644 --- a/Lisp/libobjcl.lisp +++ b/Lisp/libobjcl.lisp @@ -370,8 +370,7 @@ If *selector-designator* is a __selector__, it is simply returned. (symbol (selector (list designator))) ((or string list) (or (find-selector designator) - (error "Could not find the selector designated by ~S." - designator))))) + (error (make-condition 'no-such-selector :designator designator)))))) (defun parse-typespec (typestring &optional (start 0)) diff --git a/Lisp/method-invocation.lisp b/Lisp/method-invocation.lisp index 6d0dc12..e09292b 100644 --- a/Lisp/method-invocation.lisp +++ b/Lisp/method-invocation.lisp @@ -246,15 +246,18 @@ Returns: *result* --- the return value of the method invocation. (cons (cffi:pointer-address (pointer-to class)) (cffi:pointer-address (pointer-to selector))) (let* ((signature - (if (eq instance-or-class :instance) - (primitive-invoke class - :instance-method-signature-for-selector - 'id - selector) - (primitive-invoke class - :method-signature-for-selector - 'id - selector))) + (or (if (eq instance-or-class :instance) + (primitive-invoke class + :instance-method-signature-for-selector + 'id + selector) + (primitive-invoke class + :method-signature-for-selector + 'id + selector)) + (error (make-condition 'message-not-understood + :class class + :selector selector)))) (argc (primitive-invoke signature 'number-of-arguments :unsigned-int)) (method-return-typestring (primitive-invoke signature 'method-return-type diff --git a/Lisp/tests.lisp b/Lisp/tests.lisp index 90e1fcf..f74059e 100644 --- a/Lisp/tests.lisp +++ b/Lisp/tests.lisp @@ -206,8 +206,12 @@ (:tests ((ensure (typep (handler-case [NSString selph] - (exception (e) e)) - 'exception))))) + (error (e) e)) + '(or no-such-selector message-not-understood)))) + ((ensure (typep (handler-case + [NSObject string] + (error (e) e)) + 'message-not-understood))))) (deftestsuite reader-syntax (objective-cl) |