darcs - qt.tests

1 (in-package :qt.tests)

3 (5am:in-suite :qt.suite)

5 (defclass reversible-incf (qt:undo-command)

6 ((place :accessor place

7 :initarg :place))

8 (:metaclass cxx:class))

10 (defmethod cxx:redo ((incf reversible-incf))

11 (incf (symbol-value (place incf))))

13 (defmethod cxx:undo ((incf reversible-incf))

14 (decf (symbol-value (place incf))))

16 (5am:test undo-stack

17 "Test ownership transfer of a undo-command to the undo-stack."

18 (let ((undo-stack (make-instance 'qt:undo-stack))

19 (iterations 10)

20 (counter 0))

21 (declare (special counter))

22 (dotimes (i iterations)

23 (cxx:push undo-stack

24 (make-instance 'reversible-incf :place 'counter))

25 (gc :full t)) ;; Test for faulty ownership transfer

26 (5am:is (eq t (cxx:can-undo undo-stack)))

27 (5am:is (= iterations counter))

29 (dotimes (i iterations)

30 (cxx:undo undo-stack))

31 (5am:is (eq nil (cxx:can-undo undo-stack)))

32 (5am:is (= 0 counter))))