Permalink
Browse files

Added more in depth tests for class inverters.

  • Loading branch information...
1 parent 9c009cd commit cdb3e0d2b7d199161511a30a5c8bccde9e729305 @smithzvk committed Aug 8, 2011
Showing with 30 additions and 5 deletions.
  1. +30 −5 modf-test.lisp
View
35 modf-test.lisp
@@ -13,6 +13,19 @@
(test-structs)
(test-classes) )
+#+closer-mop
+(defun class-equal (obj1 obj2)
+ (let* ((class (class-of obj1))
+ (slots (closer-mop:class-slots class)) )
+ (is (eql class (class-of obj2)))
+ (iter (for slot in slots)
+ (cond ((slot-boundp obj1 (closer-mop:slot-definition-name slot))
+ (is (equal
+ (slot-value obj1 (closer-mop:slot-definition-name slot))
+ (slot-value obj2 (closer-mop:slot-definition-name slot)) )))
+ (t (is (not (slot-boundp
+ obj2 (closer-mop:slot-definition-name slot) ))))))))
+
;; We need to test to make sure certain recursive definitions are possible.
;; Because we make certain assumptions about the arguments in the case of a
;; missing inversion method, we need to have a argument order like NTH or
@@ -49,15 +62,27 @@
(is (equal '((1 first-second 3) second third)
ima )) ))
-(defclass late-parent () ((parent-slot :accessor parent-slot-of)))
-(defclass late-child (late-parent) ((child-slot :accessor child-slot-of)))
+(defclass late-parent ()
+ ((parent-slot :accessor parent-slot-of
+ :initarg parent-slot )))
+(defclass late-child (late-parent)
+ ((child-slot :accessor child-slot-of
+ :initarg :child-slot )))
(deftest late-invert ()
(let ((obj (make-instance 'late-child)))
- (is (eql (child-slot-of (modf (child-slot-of obj) 'value)) 'value))
- (is (eql (parent-slot-of (modf (parent-slot-of obj) 'value)) 'value)) )
+ (class-equal (modf (child-slot-of obj) 'value)
+ (make-instance 'late-child
+ :parent-slot (parent-slot-of obj)
+ :child-slot 'value ))
+ (class-equal (modf (parent-slot-of obj) 'value)
+ (make-instance 'late-child
+ :parent-slot 'value
+ :child-slot (child-slot-of obj) )))
(let ((obj (make-instance 'late-parent)))
- (is (eql (parent-slot-of (modf (parent-slot-of obj) 'value)) 'value)) ))
+ (class-equal (modf (parent-slot-of obj) 'value)
+ (make-instance 'late-parent
+ :parent-slot 'value ))))
(defsuite* lisp-types)

0 comments on commit cdb3e0d

Please sign in to comment.