From 17ee7b8790aff3efe19551796efec889e9d0b51d Mon Sep 17 00:00:00 2001
From: Matthias Benkard <code@mail.matthias.benkard.de>
Date: Fri, 21 Sep 2007 16:17:40 +0200
Subject: Add condition classes NO-SUCH-SELECTOR and MESSAGE-NOT-UNDERSTOOD.
darcs-hash:e86722d8de9c97edf6ee9665423d57b0239fe910
---
Lisp/conditions.lisp | 25 +++++++++++++++++++++++++
Lisp/defpackage.lisp | 4 ++++
Lisp/libobjcl.lisp | 3 +--
Lisp/method-invocation.lisp | 21 ++++++++++++---------
Lisp/tests.lisp | 8 ++++++--
5 files changed, 48 insertions(+), 13 deletions(-)
create mode 100644 Lisp/conditions.lisp
(limited to 'Lisp')
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)
--
cgit v1.2.3