582 |
(slot-value obj 'b))) |
(slot-value obj 'b))) |
583 |
(nil nil) t (t t) foo y) |
(nil nil) t (t t) foo y) |
584 |
|
|
585 |
|
;;; :around method tests |
586 |
|
|
587 |
|
(defclass shared-init-class-08 () |
588 |
|
((a :initform 'x) |
589 |
|
(b :initform 'y))) |
590 |
|
|
591 |
|
(defmethod shared-initialize :around ((obj shared-init-class-08) slot-names |
592 |
|
&rest args &key only &allow-other-keys) |
593 |
|
(declare (ignore slot-names args)) |
594 |
|
(setf (slot-value obj 'a) 'foo) |
595 |
|
(if only obj (call-next-method))) |
596 |
|
|
597 |
|
(deftest shared-initialize.8.1 |
598 |
|
(let* ((class (find-class 'shared-init-class-08)) |
599 |
|
(obj (allocate-instance class))) |
600 |
|
(values |
601 |
|
(map-slot-boundp* obj '(a b)) |
602 |
|
(eqt obj (shared-initialize obj nil)) |
603 |
|
(map-slot-boundp* obj '(a b)) |
604 |
|
(slot-value obj 'a))) |
605 |
|
(nil nil) |
606 |
|
t |
607 |
|
(t nil) |
608 |
|
foo) |
609 |
|
|
610 |
|
(deftest shared-initialize.8.2 |
611 |
|
(let* ((class (find-class 'shared-init-class-08)) |
612 |
|
(obj (allocate-instance class))) |
613 |
|
(values |
614 |
|
(map-slot-boundp* obj '(a b)) |
615 |
|
(eqt obj (shared-initialize obj t)) |
616 |
|
(map-slot-boundp* obj '(a b)) |
617 |
|
(slot-value obj 'a) |
618 |
|
(slot-value obj 'b))) |
619 |
|
(nil nil) |
620 |
|
t |
621 |
|
(t t) |
622 |
|
foo y) |
623 |
|
|
624 |
|
(deftest shared-initialize.8.3 |
625 |
|
(let* ((class (find-class 'shared-init-class-08)) |
626 |
|
(obj (allocate-instance class))) |
627 |
|
(values |
628 |
|
(map-slot-boundp* obj '(a b)) |
629 |
|
(eqt obj (shared-initialize obj t :only t)) |
630 |
|
(map-slot-boundp* obj '(a b)) |
631 |
|
(slot-value obj 'a))) |
632 |
|
(nil nil) |
633 |
|
t |
634 |
|
(t nil) |
635 |
|
foo) |
636 |
|
|
637 |
|
|
638 |
;;; Error tests |
;;; Error tests |
639 |
|
|
640 |
(deftest shared-initialize.error.1 |
(deftest shared-initialize.error.1 |