Changeset 8855


Ignore:
Timestamp:
Mar 21, 2008, 6:35:01 PM (11 years ago)
Author:
gz
Message:

More detailed error messages for class forward references, make-condition

Location:
trunk/source/level-1
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/level-1/l1-clos.lisp

    r8534 r8855  
    556556             (unless (memq class seen)
    557557               (or (if (forward-referenced-class-p class) class)
    558                    (progn
    559                      (push class seen)
     558                   (let ((seen (cons class seen)))
     559                     (declare (dynamic-extent seen))
    560560                     (dolist (s (%class-direct-superclasses class))
    561561                       (when (eq s original)
     
    565565    (scan-forward-refs original ())))
    566566
     567(defun class-forward-referenced-superclasses (original)
     568  (labels ((scan-forward-refs (class seen fwdrefs)
     569             (unless (memq class seen)
     570               (if (forward-referenced-class-p class)
     571                 (push class fwdrefs)
     572                 (let ((seen (cons class seen)))
     573                   (declare (dynamic-extent seen))
     574                   (dolist (s (%class-direct-superclasses class))
     575                     (when (eq s original)
     576                       (error "circular class hierarchy: the class ~s is a superclass of at least one of its superclasses (~s)." original class))
     577                     (setq fwdrefs (scan-forward-refs s seen fwdrefs))))))
     578             fwdrefs))
     579    (scan-forward-refs original () ())))
     580 
     581
    567582
    568583(defmethod compute-class-precedence-list ((class class))
    569   (let* ((fwdref (class-has-a-forward-referenced-superclass-p class)))
    570     (when fwdref
    571       (error "~&Class ~s can't be finalized because at least one of its superclasses (~s) is a FORWARD-REFERENCED-CLASS." class fwdref)))
    572   (compute-cpl class))
     584  (let* ((fwdrefs (class-forward-referenced-superclasses class)))
     585    (if fwdrefs
     586      (if (cdr fwdrefs)
     587        (error "Class ~s can't be finalized because superclasses ~s are not defined yet"
     588               class (mapcar #'%class-name fwdrefs))
     589        (error "Class ~s can't be finalized because superclass ~s is not defined yet"
     590               class (%class-name (car fwdrefs))))
     591      (compute-cpl class))))
    573592
    574593;;; Classes that can't be instantiated via MAKE-INSTANCE have no
  • trunk/source/level-1/l1-error-system.lisp

    r8815 r8855  
    619619  (if (subtypep name 'condition)
    620620    (apply #'make-instance name init-list)
    621     (error "~S is not a defined condition type name" name)))
     621    (let ((class (if (classp name)
     622                   name
     623                   (find-class name)))) ;; elicit an error if no such class
     624      (unless (class-finalized-p class)
     625        (finalize-inheritance class)) ;; elicit an error if forward refs.
     626      (error "~S is not a condition class" class))))
    622627
    623628(defmethod print-object ((c condition) stream)
Note: See TracChangeset for help on using the changeset viewer.