Sun Jan 10 18:31:42 CET 2010 Tobias Rautenkranz <tobias@rautenkranz.ch>

* Fix overload resolution when a lisp smoke module is not loaded.

--- old-smoke/src/objects/class.lisp 2014-10-30 08:08:53.000000000 +0100

+++ new-smoke/src/objects/class.lisp 2014-10-30 08:08:53.000000000 +0100

@@ -70,6 +70,12 @@

(slot-value condition 'smoke-name))))

(:documentation "A undefined Smoke class"))

+(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)))))

+

(defun make-smoke-class (smoke name)

"Returns the class named NAME of the smoke module SMOKE.

Signals an undefined-class condition when there is no class for NAME."

@@ -84,9 +90,16 @@

:report "Supply a new class name"

:interactive read-new-value

(setf name new-name))))

- (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)))

(defun real-class (class)

"Returns the same class like CLASS, but such that EXTERNAL-P returns NIL."