Skip to content
Snippets Groups Projects
Commit b5e3559a authored by pfdietz's avatar pfdietz
Browse files

More inheritance tests.

parent 60f62c5c
No related branches found
No related tags found
No related merge requests found
......@@ -101,5 +101,114 @@
(nil nil)
(nil nil nil nil))
\ No newline at end of file
;;;
(defclass class-0205a ()
((a :initform 'x)
(b :initform 'y)
c))
(defclass class-0205b (class-0205a)
((a :initform 'z)
b
(c :initform 'w)))
(deftest class-0205a.1
(let ((c (make-instance 'class-0205a)))
(values
(slot-value c 'a)
(slot-value c 'b)
(slot-boundp c 'c)))
x y nil)
(deftest class-0205b.1
(let ((c (make-instance 'class-0205b)))
(map-slot-value c '(a b c)))
(z y w))
;;;
(defclass class-0206a ()
((a :allocation :instance)
(b :allocation :class)))
(defclass class-0206b (class-0206a)
((a :allocation :class)
(b :allocation :instance)))
(deftest class-0206.1
(let ((c1 (make-instance 'class-0206a))
(c2 (make-instance 'class-0206b)))
(values
(map-slot-boundp* c1 '(a b))
(map-slot-boundp* c2 '(a b))
(setf (slot-value c1 'a) 'x)
(setf (slot-value c1 'b) 'y)
(map-slot-boundp* c1 '(a b))
(map-slot-boundp* c2 '(a b))
(map-slot-value c1 '(a b))
(progn (slot-makunbound c1 'a)
(slot-makunbound c1 'b)
(setf (slot-value c2 'a) 'x))
(setf (slot-value c2 'b) 'y)
(map-slot-boundp* c1 '(a b))
(map-slot-boundp* c2 '(a b))
(map-slot-value c2 '(a b))
(progn (slot-makunbound c2 'a)
(slot-makunbound c2 'b)
nil)))
(nil nil) (nil nil)
x y
(t t) (nil nil)
(x y)
x y
(nil nil) (t t)
(x y)
nil)
;;;
(defclass class-0207a ()
((a :allocation :class)))
(defclass class-0207b (class-0207a)
((a :allocation :instance)))
(defclass class-0207c (class-0207b)
((a :allocation :class)))
(deftest class-0207.1
(let ((c1 (make-instance 'class-0207a))
(c2 (make-instance 'class-0207b))
(c3 (make-instance 'class-0207c)))
(slot-makunbound c1 'a)
(slot-makunbound c2 'a)
(slot-makunbound c3 'a)
(values
(setf (slot-value c1 'a) 'x)
(slot-boundp* c1 'a)
(slot-boundp* c2 'a)
(slot-boundp* c3 'a)
(slot-value c1 'a)
(setf (slot-value c2 'a) 'y)
(slot-boundp* c1 'a)
(slot-boundp* c2 'a)
(slot-boundp* c3 'a)
(slot-value c1 'a)
(slot-value c2 'a)
(setf (slot-value c3 'a) 'z)
(slot-boundp* c1 'a)
(slot-boundp* c2 'a)
(slot-boundp* c3 'a)
(slot-value c1 'a)
(slot-value c2 'a)
(slot-value c3 'a)))
x
t nil nil
x
y
t t nil
x y
z
t t t
x y z)
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment