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