/[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.7 by pfdietz, Sat May 3 16:20:43 2003 UTC revision 1.8 by pfdietz, Sat May 3 16:56:11 2003 UTC
# Line 550  Line 550 
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

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

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