Sun Jan 10 18:31:42 CET 2010 Tobias Rautenkranz <tobias@rautenkranz.ch>
* Fix overload resolution when a lisp smoke module is not loaded.
hunk ./cl-smoke.smoke.asd 57
-(defmethod operation-done-p ((o test-op) (c (eql (find-system :cl-smoke.smoke))))
- nil)
-
hunk ./src/objects/class.lisp 73
+(define-condition lisp-module-not-loaded (error)
+ ((class-name :initarg :class-name))
+ (:report (lambda (condition stream)
+ (format stream "The Lisp smoke module of the class ~A is not loaded."
+ (slot-value condition 'class-name)))))
+
hunk ./src/objects/class.lisp 93
- (make-instance 'smoke-class
- :id (foreign-slot-value c 'smoke-module-index 'index)
- :smoke (gethash (pointer-address (foreign-slot-value c 'smoke-module-index 'smoke)) *smoke-modules*))))
+ (let ((class (make-instance
+ 'smoke-class
+ :id (foreign-slot-value c 'smoke-module-index 'index)
+ :smoke (gethash (pointer-address (foreign-slot-value
+ c 'smoke-module-index
+ 'smoke))
+ *smoke-modules*))))
+ (unless (smoke class)
+ (error (make-condition 'lisp-module-not-loaded :class-name name)))
+ class)))
hunk ./src/overload-resolution.lisp 466
- (let ((to-class (find-smoke-class (get-class type) nil)))
- (when (and to-class
- (call-using-types find-best-viable-function2
- (if (using-typep)
- #'standard-conversion-sequence-using-types
- #'standard-conversion-sequence)
- (constructor-name (get-class type))
- (list object) to-class))
- (make-match 'user-conversion
- 'coerce-to-class
- to-class)))))
+ (handler-case
+ (let ((to-class (find-smoke-class (get-class type) nil)))
+ (when (and to-class
+ (call-using-types find-best-viable-function2
+ (if (using-typep)
+ #'standard-conversion-sequence-using-types
+ #'standard-conversion-sequence)
+ (constructor-name (get-class type))
+ (list object) to-class))
+ (make-match 'user-conversion
+ 'coerce-to-class
+ to-class)))
+ ;; When the correspoinding Lisp module is not loaded, we ignore
+ ;; the overload.
+ (lisp-module-not-loaded ()))))