/[gcl]/gcl/ansi-tests/defclass-01.lsp
ViewVC logotype

Diff of /gcl/ansi-tests/defclass-01.lsp

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

revision 1.13 by pfdietz, Mon Apr 28 02:28:58 2003 UTC revision 1.14 by pfdietz, Wed Apr 30 11:16:01 2003 UTC
# Line 828  Line 828 
828       (slot-value c 'c)       (slot-value c 'c)
829       (slot-value c 'd)))       (slot-value c 'd)))
830    nil 10 26 43)    nil 10 26 43)
831    
832    ;;;
833    
834    (declaim (special *class-28-reset-fn*
835                      *class-28-query-fn*))
836    
837    (let ((x 0) (y 0))
838      (flet ((%reset (a b) (setf x a y b))
839             (%query () (list x y)))
840        (setf *class-28-reset-fn* #'%reset
841              *class-28-query-fn* #'%query)
842        (defclass class-28 ()
843          ((s1 :initform (incf x) :initarg :s1)
844           (s2 :initarg :s2))
845          (:default-initargs :s2 (incf y)))))
846    
847    (deftest class-28.1
848      (let ((class (find-class 'class-28)))
849        (funcall *class-28-reset-fn* 5 10)
850        (list
851         (funcall *class-28-query-fn*)
852         (let ((obj (make-instance 'class-28)))
853           (list
854            (typep* obj 'class-28)
855            (typep* obj class)
856            (eqt (class-of obj) class)
857            (map-slot-value obj '(s1 s2))
858            (funcall *class-28-query-fn*)))))
859      ((5 10)
860       (t t t (6 11) (6 11))))
861    
862    (deftest class-28.2
863      (let ((class (find-class 'class-28)))
864        (funcall *class-28-reset-fn* 5 10)
865        (list
866         (funcall *class-28-query-fn*)
867         (let ((obj (make-instance 'class-28 :s1 17)))
868           (list
869            (typep* obj 'class-28)
870            (typep* obj class)
871            (eqt (class-of obj) class)
872            (map-slot-value obj '(s1 s2))
873            (funcall *class-28-query-fn*)))))
874      ((5 10)
875       (t t t (17 11) (5 11))))
876    
877    
878    (deftest class-28.3
879      (let ((class (find-class 'class-28)))
880        (funcall *class-28-reset-fn* 5 10)
881        (list
882         (funcall *class-28-query-fn*)
883         (let ((obj (make-instance 'class-28 :s2 17)))
884           (list
885            (typep* obj 'class-28)
886            (typep* obj class)
887            (eqt (class-of obj) class)
888            (map-slot-value obj '(s1 s2))
889            (funcall *class-28-query-fn*)))))
890      ((5 10)
891       (t t t (6 17) (6 10))))
892    
893    
894          
895          

Legend:
Removed from v.1.13  
changed lines
  Added in v.1.14

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