From 5b0be258009220af661ba877b17c3ebf33972409 Mon Sep 17 00:00:00 2001
From: Matthias Benkard <code@mail.matthias.benkard.de>
Date: Wed, 10 Oct 2007 14:02:36 +0200
Subject: FIND-SELECTOR: Make ERRORP default to T.

darcs-hash:629ac814cc7f7427b1b1cbe71448a670c37c0171
---
 Lisp/compiler-macros.lisp   | 6 +++---
 Lisp/conditions.lisp        | 9 ++-------
 Lisp/libobjcl.lisp          | 4 ++--
 Lisp/method-invocation.lisp | 8 ++++++--
 Lisp/tests.lisp             | 2 +-
 5 files changed, 14 insertions(+), 15 deletions(-)

(limited to 'Lisp')

diff --git a/Lisp/compiler-macros.lisp b/Lisp/compiler-macros.lisp
index 3ffba63..c68828c 100644
--- a/Lisp/compiler-macros.lisp
+++ b/Lisp/compiler-macros.lisp
@@ -28,7 +28,7 @@
                      (eq 'load-time-value (car method-name)))))
       `(primitive-invoke ,receiver
                          (load-time-value (handler-case
-                                              (find-selector ,method-name t)
+                                              (find-selector ,method-name)
                                             (serious-condition ()
                                               (warn
                                                (make-condition
@@ -52,7 +52,7 @@
       `(invoke-by-name
         ,receiver
         (load-time-value (handler-case
-                             (find-selector ,method-name t)
+                             (find-selector ,method-name)
                            (serious-condition ()
                              (warn
                               (make-condition 'simple-style-warning
@@ -78,7 +78,7 @@
     `(invoke-by-name
       ,receiver
       (load-time-value (handler-case
-                           (find-selector ',method-name t)
+                           (find-selector ',method-name)
                          (serious-condition ()
                            (warn
                             (make-condition 'simple-style-warning
diff --git a/Lisp/conditions.lisp b/Lisp/conditions.lisp
index de65b2b..5080ea3 100644
--- a/Lisp/conditions.lisp
+++ b/Lisp/conditions.lisp
@@ -45,11 +45,7 @@
 A **condition** of **type** __no-such-selector__ is **signal**led when
 an attempt is made to retrieve a method selector by name, and that
 selector cannot be found.  This is most often the case when a typo is
-made in the message name part of a method invocation.
-
-Note that this error will, at present, never be signalled on Mac OS X,
-because __find-selector__ automatically interns selectors on that
-system.  This behaviour is subject to change."))
+made in the message name part of a method invocation."))
 
 
 (define-condition message-not-understood (error)
@@ -74,5 +70,4 @@ method.  This is most often the case when an object is used at a place
 that expects an object of a different Objective-C type (that is, it can
 be regarded as a kind of type error), although it can also happen when a
 typo is made in the message name part of a method invocation and a
-__no-such-selector__ error is not **signal**led (on Mac OS X, for
-example)."))
+__no-such-selector__ error is not **signal**led."))
diff --git a/Lisp/libobjcl.lisp b/Lisp/libobjcl.lisp
index a18f373..1e6d3df 100644
--- a/Lisp/libobjcl.lisp
+++ b/Lisp/libobjcl.lisp
@@ -369,14 +369,14 @@ If *name* is the name of an existing selector:
 (declaim (ftype (function ((or selector symbol string list) &optional t)
                           (or null selector))
                 find-selector))
-(defun find-selector (selector-name &optional errorp)
+(defun find-selector (selector-name &optional (errorp t))
   "Retrieve a method selector by name.
 
 ## Arguments and Values:
 
 *selector-name* --- a **string**, a **symbol**, or a **list** of **symbol**s.
 
-*errorp* --- a **generalized boolean**.
+*errorp* --- a **generalized boolean**.  The default is **true**.
 
 Returns: *selector* --- a __selector__ object, or __nil__.
 
diff --git a/Lisp/method-invocation.lisp b/Lisp/method-invocation.lisp
index b260f2a..c95a43c 100644
--- a/Lisp/method-invocation.lisp
+++ b/Lisp/method-invocation.lisp
@@ -140,7 +140,9 @@ easier to use with __apply__.
   __invoke__"
 
   ;; TODO: Support varargs.
-  (let* ((selector (selector method-name))
+  (let* ((selector (if (typep method-name 'selector)
+                       method-name
+                       (find-selector method-name)))
          (class (object-get-class receiver)))
     (multiple-value-bind (argc
                           method-return-typestring
@@ -189,7 +191,9 @@ easier to use with __apply__.
            (return-c-type (case return-type
                             ((id objc-class exception selector) :pointer)
                             (otherwise return-type)))
-           (selector (selector method-name)))
+           (selector (if (typep method-name 'selector)
+                         method-name
+                         (find-selector method-name))))
       (labels ((alloc-string-and-register (string)
                  (register-temporary-string
                   (cffi:foreign-string-alloc string))))
diff --git a/Lisp/tests.lisp b/Lisp/tests.lisp
index 69bfe4d..beff6f9 100644
--- a/Lisp/tests.lisp
+++ b/Lisp/tests.lisp
@@ -55,7 +55,7 @@
    ((ensure-null (find-objc-class 'nsobject)))
    ((ensure-same (find-objc-class 'ns-method-invocation)
                  (find-objc-class "NSMethodInvocation")))
-   ((ensure (typep (find-selector "mulkyStuff:withMagic:")
+   ((ensure (typep (find-selector "mulkyStuff:withMagic:" nil)
                    '(or null selector))))
    ((ensure-same (find-selector "self")
                  (find-selector '(self))))
-- 
cgit v1.2.3