From 26e7568488a46369198e336808b4aba57bbe7a63 Mon Sep 17 00:00:00 2001 From: Christophe Rhodes Date: Mon, 16 Sep 2013 12:34:49 +0100 Subject: [PATCH] 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. --- NEWS | 3 +++ src/pcl/low.lisp | 10 ++++++++-- tests/mop.impure.lisp | 7 +++++++ 3 files changed, 18 insertions(+), 2 deletions(-) diff --git a/NEWS b/NEWS index e2bbefa..382464a 100644 --- 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 --- 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 --- 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))) ;;;; success -- 1.7.10.4