[armedbear-cvs] r13783 - trunk/abcl/src/org/armedbear/lisp

[rschlatte at common-lisp.net]

Author: rschlatte
Date: Mon Jan 16 04:36:33 2012
New Revision: 13783

Log:
Robustify funcallable-instances with respect to unspecified behavior.

Modified:
   trunk/abcl/src/org/armedbear/lisp/clos.lisp

Modified: trunk/abcl/src/org/armedbear/lisp/clos.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/clos.lisp	Sun Jan 15 13:55:45 2012	(r13782)
+++ trunk/abcl/src/org/armedbear/lisp/clos.lisp	Mon Jan 16 04:36:33 2012	(r13783)
@@ -696,7 +696,13 @@
 (defun allocate-funcallable-instance (class)
   (unless (class-finalized-p class)
     (std-finalize-inheritance class))
-  (sys::%allocate-funcallable-instance class))
+  (let ((instance (sys::%allocate-funcallable-instance class)))
+    (set-funcallable-instance-function
+     instance
+     #'(lambda (&rest args)
+         (declare (ignore args))
+         (error 'program-error "Called a funcallable-instance with unset function.")))
+    instance))
 
 (defun make-instance-standard-class (metaclass
 				     &rest initargs