432 |
(s1 c)) |
(s1 c)) |
433 |
t) |
t) |
434 |
|
|
435 |
|
;;; Tests of :default-initargs |
436 |
|
|
437 |
|
(defclass class-16 () |
438 |
|
((s1 :initarg :s1)) |
439 |
|
(:default-initargs :s1 'x)) |
440 |
|
|
441 |
|
(deftest class-16.1 |
442 |
|
(let ((c (make-instance 'class-16))) |
443 |
|
(slot-value c 's1)) |
444 |
|
x) |
445 |
|
|
446 |
|
(deftest class-16.2 |
447 |
|
(let ((c (make-instance 'class-16 :s1 'y))) |
448 |
|
(slot-value c 's1)) |
449 |
|
y) |
450 |
|
|
451 |
|
(deftest class-16.3 |
452 |
|
(let ((c (make-instance 'class-16 :s1 nil))) |
453 |
|
(slot-value c 's1)) |
454 |
|
nil) |
455 |
|
|
456 |
|
;;; |
457 |
|
|
458 |
|
(defclass class-17 () |
459 |
|
((s1 :initarg :s1 :initform 'foo)) |
460 |
|
(:default-initargs :s1 'bar)) |
461 |
|
|
462 |
|
(deftest class-17.1 |
463 |
|
(let ((c (make-instance 'class-17))) |
464 |
|
(slot-value c 's1)) |
465 |
|
bar) |
466 |
|
|
467 |
|
(deftest class-17.2 |
468 |
|
(let ((c (make-instance 'class-17 :s1 'z))) |
469 |
|
(slot-value c 's1)) |
470 |
|
z) |
471 |
|
|
472 |
|
(deftest class-17.3 |
473 |
|
(let ((c (make-instance 'class-17 :s1 nil))) |
474 |
|
(slot-value c 's1)) |
475 |
|
nil) |
476 |
|
|
477 |
|
;;; |
478 |
|
|
479 |
|
(defclass class-18 () |
480 |
|
((s1 :initarg :s1 :initarg :s1b)) |
481 |
|
(:default-initargs :s1 'x :s1b 'y)) |
482 |
|
|
483 |
|
(deftest class-18.1 |
484 |
|
(let ((c (make-instance 'class-18))) |
485 |
|
(slot-value c 's1)) |
486 |
|
x) |
487 |
|
|
488 |
|
(deftest class-18.2 |
489 |
|
(let ((c (make-instance 'class-18 :s1 'z))) |
490 |
|
(slot-value c 's1)) |
491 |
|
z) |
492 |
|
|
493 |
|
(deftest class-18.3 |
494 |
|
(let ((c (make-instance 'class-18 :s1 nil))) |
495 |
|
(slot-value c 's1)) |
496 |
|
nil) |
497 |
|
|
498 |
|
(deftest class-18.4 |
499 |
|
(let ((c (make-instance 'class-18 :s1b 'z))) |
500 |
|
(slot-value c 's1)) |
501 |
|
z) |
502 |
|
|
503 |
|
(deftest class-18.5 |
504 |
|
(let ((c (make-instance 'class-18 :s1b nil))) |
505 |
|
(slot-value c 's1)) |
506 |
|
nil) |
507 |
|
|
508 |
|
;;; |
509 |
|
|
510 |
|
(declaim (special *class-19-s1-initvar*)) |
511 |
|
|
512 |
|
(defclass class-19 () |
513 |
|
((s1 :initarg :s1)) |
514 |
|
(:default-initargs :s1 (setf *class-19-s1-initvar* 'a))) |
515 |
|
|
516 |
|
(deftest class-19.1 |
517 |
|
(let* ((*class-19-s1-initvar* nil) |
518 |
|
(c (make-instance 'class-19))) |
519 |
|
(declare (special *class-19-s1-initvar*)) |
520 |
|
(values |
521 |
|
(slot-value c 's1) |
522 |
|
*class-19-s1-initvar*)) |
523 |
|
a a) |
524 |
|
|
525 |
|
(deftest class-19.2 |
526 |
|
(let* ((*class-19-s1-initvar* nil) |
527 |
|
(c (make-instance 'class-19 :s1 nil))) |
528 |
|
(declare (special *class-19-s1-initvar*)) |
529 |
|
(values |
530 |
|
(slot-value c 's1) |
531 |
|
*class-19-s1-initvar*)) |
532 |
|
nil nil) |
533 |
|
|
534 |
|
(deftest class-19.3 |
535 |
|
(let* ((*class-19-s1-initvar* nil) |
536 |
|
(c (make-instance 'class-19 :s1 'x))) |
537 |
|
(declare (special *class-19-s1-initvar*)) |
538 |
|
(values |
539 |
|
(slot-value c 's1) |
540 |
|
*class-19-s1-initvar*)) |
541 |
|
x nil) |
542 |
|
|
543 |
|
;;; |
544 |
|
|
545 |
|
(declaim (special *class-20-s1-initvar-1* *class-20-s1-initvar-2*)) |
546 |
|
|
547 |
|
(defclass class-20 () |
548 |
|
((s1 :initarg :s1 :initarg :s1b)) |
549 |
|
(:default-initargs :s1 (setf *class-20-s1-initvar-1* 'a) |
550 |
|
:s1b (setf *class-20-s1-initvar-2* 'b))) |
551 |
|
|
552 |
|
(deftest class-20.1 |
553 |
|
(let* (*class-20-s1-initvar-1* |
554 |
|
*class-20-s1-initvar-2* |
555 |
|
(c (make-instance 'class-20))) |
556 |
|
(declare (special *class-20-s1-initvar-1* |
557 |
|
*class-20-s1-initvar-2*)) |
558 |
|
(values |
559 |
|
(slot-value c 's1) |
560 |
|
*class-20-s1-initvar-1* |
561 |
|
*class-20-s1-initvar-2*)) |
562 |
|
a a b) |
563 |
|
|
564 |
|
(deftest class-20.2 |
565 |
|
(let* (*class-20-s1-initvar-1* |
566 |
|
*class-20-s1-initvar-2* |
567 |
|
(c (make-instance 'class-20 :s1 'x))) |
568 |
|
(declare (special *class-20-s1-initvar-1* |
569 |
|
*class-20-s1-initvar-2*)) |
570 |
|
(values |
571 |
|
(slot-value c 's1) |
572 |
|
*class-20-s1-initvar-1* |
573 |
|
*class-20-s1-initvar-2*)) |
574 |
|
x nil b) |
575 |
|
|
576 |
|
(deftest class-20.3 |
577 |
|
(let* (*class-20-s1-initvar-1* |
578 |
|
*class-20-s1-initvar-2* |
579 |
|
(c (make-instance 'class-20 :s1b 'y))) |
580 |
|
(declare (special *class-20-s1-initvar-1* |
581 |
|
*class-20-s1-initvar-2*)) |
582 |
|
(values |
583 |
|
(slot-value c 's1) |
584 |
|
*class-20-s1-initvar-1* |
585 |
|
*class-20-s1-initvar-2*)) |
586 |
|
y a nil) |
587 |
|
|
588 |
|
;;; |
589 |
|
|
590 |
|
(declaim (special *class-21-s1-initvar-1* *class-21-s1-initvar-2*)) |
591 |
|
|
592 |
|
(defclass class-21 () |
593 |
|
((s1 :initarg :s1 :initarg :s1b) |
594 |
|
(s2 :initarg :s1b :initarg :s2)) |
595 |
|
(:default-initargs :s1 (incf *class-21-s1-initvar-1*) |
596 |
|
:s1b (incf *class-21-s1-initvar-2*))) |
597 |
|
|
598 |
|
(deftest class-21.1 |
599 |
|
(let* ((*class-21-s1-initvar-1* 10) |
600 |
|
(*class-21-s1-initvar-2* 20) |
601 |
|
(c (make-instance 'class-21))) |
602 |
|
(declare (special *class-21-s1-initvar-1* |
603 |
|
*class-21-s1-initvar-2*)) |
604 |
|
(values |
605 |
|
(slot-value c 's1) |
606 |
|
(slot-value c 's2) |
607 |
|
*class-21-s1-initvar-1* |
608 |
|
*class-21-s1-initvar-2*)) |
609 |
|
11 21 11 21) |
610 |
|
|
611 |
|
|
612 |
|
|
613 |
|
|
614 |
|
|
615 |
|
|
616 |
|
|