SET-FUNCALLABLE-INSTANCE-FUNCTION is user interface

It should therefore not trigger AVER failures if the user gets the
order of arguments wrong, but report the problem sanely.  The fix
in this commit is only semi-sane; it would be nice to report an
expected-type of SB-MOP:FUNCALLABLE-STANDARD-OBJECT rather than
SB-KERNEL:FUNCALLABLE-INSTANCE, but there are slightly tricky
bootstrap issues to sort out to get that to work.

diff --git a/NEWS b/NEWS
index e2bbefa..382464a 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -33,6 +33,9 @@ changes relative to sbcl-1.1.11:
     standard.  (lp#1203585, thanks to Jan Moringen)
   * bug fix: silence a note from RESTART-CASE under high-SPEED optimization
     settings.  (lp#1023721)
+  * bug fix: getting the order of arguments to
+    SB-MOP:SET-FUNCALLABLE-INSTANCE-FUNCTION wrong produces a sensible error
+    rather than a failed AVER.  (reported by Paul Nathan)
   
 changes in sbcl-1.1.11 relative to sbcl-1.1.10:
   * enhancement: support building the manual under texinfo version 5.

diff --git a/src/pcl/low.lisp b/src/pcl/low.lisp
index 4fa6a09..a8e4122 100644 (file)
--- a/src/pcl/low.lisp
+++ b/src/pcl/low.lisp
@@ -117,8 +117,14 @@
 (import 'sb-kernel:funcallable-instance-p)
 
 (defun set-funcallable-instance-function (fin new-value)
-  (declare (type function new-value))
-  (aver (funcallable-instance-p fin))
+  (declare (type function new-value)
+           ;; KLUDGE: it might be nice to restrict
+           ;; SB-MOP:SET-FUNCALLABLE-INSTANCE-FUNCTION to operate only
+           ;; on generalized instances of
+           ;; SB-MOP:FUNCALLABLE-STANDARD-OBJECT; at present, even
+           ;; PCL's internal use of SET-FUNCALLABLE-INSTANCE-FUNCTION
+           ;; doesn't obey this restriction.
+           (type funcallable-instance fin))
   (setf (funcallable-instance-fun fin) new-value))
 
 ;;; FIXME: these macros should just go away.  It's not clear whether

diff --git a/tests/mop.impure.lisp b/tests/mop.impure.lisp
index 6015c66..215280a 100644 (file)
--- a/tests/mop.impure.lisp
+++ b/tests/mop.impure.lisp
@@ -677,5 +677,12 @@
                               ((instance :initform 2)
                                (class :allocation :class :initform :ok))))
                      (slot-value o 'instance))))))
+
+(defgeneric definitely-a-funcallable-instance (x))
+(with-test (:name (set-funcallable-instance-function :typechecking))
+  (assert (raises-error? (set-funcallable-instance-function
+                          (lambda (y) nil)
+                          #'definitely-a-funcallable-instance)
+                         type-error)))
 \f
 ;;;; success