[ not sure if the c-l.net lists are back up yet, one way to find out ]
My jerk of a boss is making me write regression tests today; sometimes being self-employed sucks. So, I added to the basic suite of RTs I had for unbound cells, which are attached below. Rather than translate them from using RT (a super light-weight test harness, included with SBCL), I just wrote a po man's RT at the top of the file.
These also use md-slot-makunbound, which is new since my last patch:
(defun md-slot-makunbound (self slot-spec) (setf (md-slot-value self slot-spec) +unbound+) (slot-makunbound self slot-spec))
Now, back to those lovely database RTs, oh boy!
(in-package :cells)
(defvar *tests* ())
(defmacro deftest (name form &rest values) "Po man's RT." (let ((test-name (intern (format nil "TEST ~A" name)))) `(progn (defun ,test-name () (let ((name ',name) (form ',form) (expected-values ',values) (actual-values (multiple-value-list (handler-case ,form (error (val) val))))) (assert (equal actual-values ',values) (actual-values) "Test ~S failed~% ~ Form: ~A~% ~ Expected values: ~{~S~^; ~}~% ~ Actual values: ~{~S~^; ~}" name form expected-values actual-values) ',name)) (pushnew ',name *tests*) ',name)))
(defun do-test (name) (let ((test (intern (format nil "TEST ~A" name) (symbol-package name)))) (funcall test)))
(defun do-tests () (every #'do-test (reverse *tests*)))
(defmacro unbound-error-p (form) `(handler-case (progn ,form nil) (cell-unbound () t)))
(defun make-cell-valid (self slot) (setf (c-state (md-slot-cell self slot)) :valid))
(defmodel unbound-values () ((val1 :initform (cv) :initarg val1 :accessor test-val1) (val2 :initform (cv) :initarg val2 :accessor test-val2)))
(defmodel unbound-formulas (unbound-values) ((formula :initform (c? (^test-val1) (^test-val2)) :accessor test-formula) (lazy-formula :initform (c-formula (:lazy t) (^test-val1) (^test-val2)) :accessor test-lazy-formula)))
(deftest unbound-values (let ((self (make-instance 'unbound-values))) (values (unbound-error-p (test-val1 self)) (unbound-error-p (test-val2 self)))) t t)
(deftest md-slot-makunbound (let ((self (to-be (make-instance 'unbound-values 'val1 (cv nil) 'val2 (cv nil))))) (md-slot-makunbound self 'val1) (md-slot-makunbound self 'val2) (values (unbound-error-p (test-val1 self)) (unbound-error-p (test-val2 self)))) t t)
(deftest formula-depends-on-unbound (let ((obj1 (to-be (make-instance 'unbound-formulas))) (obj2 (to-be (make-instance 'unbound-formulas)))) (values (unbound-error-p (test-formula obj1)) (unbound-error-p (test-lazy-formula obj1))
(unbound-error-p (test-lazy-formula obj2)) (unbound-error-p (test-formula obj2)))) t t t t)
(deftest unbound-ok-for-unbound-formulas (unbound-error-p (progn (let ((self (to-be (make-instance 'unbound-formulas)))) (setf (test-val1 self) t (test-val2 self) t)) (let ((self (to-be (make-instance 'unbound-formulas)))) (setf (test-val2 self) t (test-val1 self) t)))) nil)
(deftest unbound-errs-for-eager (let ((self (to-be (make-instance 'unbound-formulas 'val1 (cv 1) 'val2 (cv 2))))) (values (test-formula self) (unbound-error-p (md-slot-makunbound self 'val1)) (unbound-error-p (md-slot-makunbound self 'val2)))) 2 t t)
(deftest unbound-ok-for-unchecked-lazy (let ((self (to-be (make-instance 'unbound-formulas 'val1 (cv 1) 'val2 (cv 2))))) (values (test-lazy-formula self) (unbound-error-p (md-slot-makunbound self 'val1)) (unbound-error-p (md-slot-makunbound self 'val2)))) 2 nil nil)
#+test (do-tests)