376 |
(defclass change-class-class-05 () |
(defclass change-class-class-05 () |
377 |
(a b c)) |
(a b c)) |
378 |
|
|
379 |
(ignore-errors |
(report-and-ignore-errors |
380 |
(defmethod change-class |
(defmethod change-class |
381 |
((obj change-class-class-05) |
((obj change-class-class-05) |
382 |
(new-class (eql (find-class 'change-class-class-05))) |
(new-class (eql (find-class 'change-class-class-05))) |
383 |
&rest initargs &key &allow-other-keys) |
&rest initargs &key &allow-other-keys) |
384 |
(declare (ignore initargs new-class)) |
(declare (ignore initargs new-class)) |
385 |
(setq *changed-class-on-class-05* t) |
(setq *changed-class-on-class-05* t) |
386 |
obj)) |
obj)) |
387 |
|
|
388 |
(deftest change-class.5 |
(deftest change-class.5 |
389 |
(let ((*changed-class-on-class-05* nil) |
(let ((*changed-class-on-class-05* nil) |
398 |
(defclass change-class-class-06 () |
(defclass change-class-class-06 () |
399 |
((a :initarg :a) (b :initarg :b) (c :initarg :c))) |
((a :initarg :a) (b :initarg :b) (c :initarg :c))) |
400 |
|
|
401 |
(ignore-errors |
(report-and-ignore-errors |
402 |
(defmethod change-class |
(defmethod change-class |
403 |
((obj change-class-class-06) |
((obj change-class-class-06) |
404 |
(new-class standard-class) |
(new-class standard-class) |
405 |
&rest initargs &key &allow-other-keys) |
&rest initargs &key &allow-other-keys) |
406 |
(declare (ignore initargs)) |
(declare (ignore initargs)) |
407 |
(setf (slot-value obj 'a) 123) |
(setf (slot-value obj 'a) 123) |
408 |
(call-next-method))) |
(call-next-method))) |
409 |
|
|
410 |
(deftest change-class.6.1 |
(deftest change-class.6.1 |
411 |
(let* ((class (find-class 'change-class-class-06)) |
(let* ((class (find-class 'change-class-class-06)) |
446 |
((a :initform 'aa :initarg :a) |
((a :initform 'aa :initarg :a) |
447 |
(d :initform 'dd :initarg :d))) |
(d :initform 'dd :initarg :d))) |
448 |
|
|
449 |
(ignore-errors |
(report-and-ignore-errors |
450 |
(defmethod change-class :before |
(defmethod change-class :before |
451 |
((obj change-class-class-07) |
((obj change-class-class-07) |
452 |
(new-class standard-class) |
(new-class standard-class) |
453 |
&rest initargs &key &allow-other-keys) |
&rest initargs &key &allow-other-keys) |
454 |
(declare (ignore initargs)) |
(declare (ignore initargs)) |
455 |
(setf (slot-value obj 'a) 'z) |
(setf (slot-value obj 'a) 'z) |
456 |
obj)) |
obj)) |
457 |
|
|
458 |
(deftest change-class.7.1 |
(deftest change-class.7.1 |
459 |
(let* ((class (find-class 'change-class-class-07)) |
(let* ((class (find-class 'change-class-class-07)) |
531 |
|
|
532 |
;;; After method |
;;; After method |
533 |
|
|
534 |
(ignore-errors |
(report-and-ignore-errors |
535 |
(defclass change-class-class-08 () ((a :initarg :a) (b :initarg :b)))) |
(defclass change-class-class-08 () |
536 |
|
((a :initarg :a) (b :initarg :b)))) |
537 |
(ignore-errors |
|
538 |
(defmethod change-class :after |
(report-and-ignore-errors |
539 |
((obj change-class-class-08) |
(defmethod change-class :after |
540 |
(class (eql (find-class 'change-class-class-08))) |
((obj change-class-class-08) |
541 |
&rest initargs &key &allow-other-keys) |
(class (eql (find-class 'change-class-class-08))) |
542 |
(declare (ignore initargs)) |
&rest initargs &key &allow-other-keys) |
543 |
(setf (slot-value obj 'a) 'z) |
(declare (ignore initargs)) |
544 |
obj)) |
(setf (slot-value obj 'a) 'z) |
545 |
|
obj)) |
546 |
|
|
547 |
(deftest change-class.8.1 |
(deftest change-class.8.1 |
548 |
(let* ((class (find-class 'change-class-class-08)) |
(let* ((class (find-class 'change-class-class-08)) |