repos
/
qt.tests
/ annotate_shade
summary
|
shortlog
|
log
|
tree
|
commit
|
commitdiff
|
headdiff
|
annotate
|
headblob
|
headfilediff
|
filehistory
normal
|
plain
|
shade
|
zebra
Test undo stack
Annotate for file src/undo.lisp
2009-05-31 tobias
1
(in-package :qt.tests)
22:24:46 '
2
'
3
(5am:in-suite :qt.suite)
'
4
'
5
(defclass reversible-incf (qt:undo-command)
'
6
((place :accessor place
'
7
:initarg :place))
'
8
(:metaclass cxx:class))
'
9
'
10
'
11
(defmethod cxx:redo ((incf reversible-incf))
'
12
(incf (symbol-value (place incf))))
'
13
'
14
(defmethod cxx:undo ((incf reversible-incf))
'
15
(decf (symbol-value (place incf))))
'
16
'
17
(5am:test undo-stack
'
18
"Test ownership transfer of a undo-command to the undo-stack."
'
19
(let ((undo-stack (make-instance 'qt:undo-stack))
'
20
(iterations 10)
'
21
(counter 0))
'
22
(declare (special counter))
'
23
(dotimes (i iterations)
'
24
(cxx:push undo-stack
'
25
(make-instance 'reversible-incf :place 'counter))
'
26
(gc :full t)) ;; Test for faulty ownership transfer
'
27
(5am:is (eq t (cxx:can-undo undo-stack)))
'
28
(5am:is (= iterations counter))
'
29
'
30
(dotimes (i iterations)
'
31
(cxx:undo undo-stack))
'
32
(5am:is (eq nil (cxx:can-undo undo-stack)))
'
33
(5am:is (= 0 counter))))
'
34