550 |
(t t) |
(t t) |
551 |
z z) |
z z) |
552 |
|
|
553 |
|
;;; Before methods fill in slots before the default system method |
554 |
|
|
555 |
|
(defclass shared-init-class-07 () |
556 |
|
((a :initform 'x) |
557 |
|
(b :initform 'y))) |
558 |
|
|
559 |
|
(defmethod shared-initialize :before ((obj shared-init-class-07) slot-names &rest args) |
560 |
|
(declare (ignore args slot-names)) |
561 |
|
(setf (slot-value obj 'a) 'foo) |
562 |
|
obj) |
563 |
|
|
564 |
|
(deftest shared-initialize.7.1 |
565 |
|
(let* ((class (find-class 'shared-init-class-07)) |
566 |
|
(obj (allocate-instance class))) |
567 |
|
(values |
568 |
|
(map-slot-boundp* obj '(a b)) |
569 |
|
(eqt obj (shared-initialize obj nil)) |
570 |
|
(map-slot-boundp* obj '(a b)) |
571 |
|
(slot-value obj 'a))) |
572 |
|
(nil nil) t (t nil) foo) |
573 |
|
|
574 |
|
(deftest shared-initialize.7.2 |
575 |
|
(let* ((class (find-class 'shared-init-class-07)) |
576 |
|
(obj (allocate-instance class))) |
577 |
|
(values |
578 |
|
(map-slot-boundp* obj '(a b)) |
579 |
|
(eqt obj (shared-initialize obj t)) |
580 |
|
(map-slot-boundp* obj '(a b)) |
581 |
|
(slot-value obj 'a) |
582 |
|
(slot-value obj 'b))) |
583 |
|
(nil nil) t (t t) foo y) |
584 |
|
|
585 |
;;; Error tests |
;;; Error tests |
586 |
|
|
587 |
(deftest shared-initialize.error.1 |
(deftest shared-initialize.error.1 |