Tue Feb 16 22:52:02 CET 2010 Tobias Rautenkranz <tobias@rautenkranz.ch>
* Fix derived-p for classes that are external in every module.
diff -rN -u old-smoke/src/objects/class.lisp new-smoke/src/objects/class.lisp
--- old-smoke/src/objects/class.lisp 2014-10-30 07:05:17.000000000 +0100
+++ new-smoke/src/objects/class.lisp 2014-10-30 07:05:18.000000000 +0100
@@ -107,8 +107,7 @@
(defun real-class (class)
"Returns the same class like CLASS, but such that EXTERNAL-P returns NIL."
(if (external-p class)
- (handler-case (make-smoke-class (name class))
- (undefined-class () class))
+ (make-smoke-class (name class))
class))
(defun class-id (module class)
@@ -117,12 +116,11 @@
(id class)
(smoke-class-id module (name class))))
-;(defun smoke-subclassp (class base-class) TODO
(defun derived-p (class base-class)
"Returns T when CLASS is derived from BASE-CLASS and NIL when not."
- (values
- (derived-real-p (real-class class) (real-class base-class))
- T))
+ (handler-case (derived-real-p (real-class class) (real-class base-class))
+ ;; The class is external in every module => no derived.
+ (undefined-class () nil)))
(defun derived-real-p (class base-class)
(smoke-is-derived-from (smoke-module-pointer (smoke class))