/[gcl]/gcl/ansi-tests/shared-initialize.lsp
ViewVC logotype

Diff of /gcl/ansi-tests/shared-initialize.lsp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.8 by pfdietz, Sat May 3 16:56:11 2003 UTC revision 1.9 by pfdietz, Sat May 3 19:13:13 2003 UTC
# Line 582  Line 582 
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

Legend:
Removed from v.1.8  
changed lines
  Added in v.1.9

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26