Wed Jul 1 13:02:20 CEST 2009 Tobias Rautenkranz <tobias@rautenkranz.ch>
* Use new qt:with-app
hunk ./src/abort.lisp 8
- `(handler-bind ((,condition #'(lambda (,c)
- (declare (ignore ,c))
- (assert (find-restart ',restart))
- ,(when handler `(funcall ,handler))
- (invoke-restart ',restart))))
- ,@body)))
+ `(handler-bind ((,condition #'(lambda (,c)
+ (declare (ignore ,c))
+ (assert (find-restart ',restart))
+ ,(when handler `(funcall ,handler))
+ (invoke-restart ',restart))))
+ ,@body)))
hunk ./src/abort.lisp 26
- (with-invoke-restart (no-ticket qt::abort-app)
- (qt:with-app
- (let ((timer (make-instance 'qt:timer))
- (continued-p))
- (cxx:set-single-shot timer t)
- (qt:connect (qt:get-signal timer "timeout()")
- #'(lambda ()
- (cerror "ignore" (make-condition 'no-ticket))
- (setf continued-p t)))
- (cxx:start timer 0)
- (qt:exec)
- (5am:is (eq continued-p t))))))))
+ (with-invoke-restart (no-ticket qt::abort-app)
+ (qt:with-app ()
+ (let ((timer (make-instance 'qt:timer))
+ (continued-p))
+ (cxx:set-single-shot timer t)
+ (qt:connect (qt:get-signal timer "timeout()")
+ #'(lambda ()
+ (cerror "ignore" (make-condition 'no-ticket))
+ (setf continued-p t)))
+ (cxx:start timer 0)
+ (qt:exec)
+ (5am:is (eq continued-p t))))))))
hunk ./src/abort.lisp 48
- "Test retruning from a void method on error."
- (qt:with-core-app
- (let ((object (make-instance 'error-object))
- (restarted-p))
- (with-invoke-restart (no-ticket smoke::return [_$_]
- #'(lambda () (setf restarted-p t)))
- (cxx:start-timer object 0)
- (qt:core-application.process-events))
- (5am:is (eq t restarted-p)))))
+ "Test returning from a void method on error."
+ (qt:with-core-app ()
+ (let ((object (make-instance 'error-object))
+ (restarted-p))
+ (with-invoke-restart (no-ticket smoke::return [_$_]
+ #'(lambda () (setf restarted-p t)))
+ (cxx:start-timer object 0)
+ (qt:core-application.process-events))
+ (5am:is (eq t restarted-p)))))
hunk ./src/abort.lisp 60
- (qt:with-core-app
- (let ((object (make-instance 'error-object))
- (restarted-p))
- (with-invoke-restart (no-ticket smoke::call-default
- #'(lambda () (setf restarted-p t)))
- (cxx:start-timer object 0)
- (qt:core-application.process-events))
- (5am:is (eq t restarted-p)))))
+ (qt:with-core-app ()
+ (let ((object (make-instance 'error-object))
+ (restarted-p))
+ (with-invoke-restart (no-ticket smoke::call-default
+ #'(lambda () (setf restarted-p t)))
+ (cxx:start-timer object 0)
+ (qt:core-application.process-events))
+ (5am:is (eq t restarted-p)))))
hunk ./src/abort.lisp 71
- (qt:with-core-app
+ (qt:with-core-app ()
hunk ./src/application.lisp 8
- (5am:for-all ((core-p (5am:gen-one-element nil t)))
- (unless nested
- (5am:is (eql nil (qt:app-p))))
- (if core-p
- (qt:with-core-app
- (5am:is (eql t (qt:app-p)))
- (5am:is (typep (qt:app) (find-class 'qt:core-application)))
- (setf (cxx:object-name (qt:app)) "core-app")) ;; test for memfault
- (qt:with-app
- (5am:is (eql t (qt:app-p)))
- (5am:is (typep (qt:app) (find-class 'qt:application)))
- (setf (cxx:object-name (qt:app)) "app")))
- (unless nested
- (5am:is (eql nil (qt:app-p)))))))
+ (5am:for-all ((core-p (5am:gen-one-element nil t)))
+ (unless nested
+ (5am:is (eql nil (qt:app-p))))
+ (if core-p
+ (qt:with-core-app ()
+ (5am:is (eql t (qt:app-p)))
+ (5am:is (typep (qt:app) (find-class 'qt:core-application)))
+ (setf (cxx:object-name (qt:app)) "core-app")) ;; test for memfault
+ (qt:with-app ()
+ (5am:is (eql t (qt:app-p)))
+ (5am:is (typep (qt:app) (find-class 'qt:application)))
+ (setf (cxx:object-name (qt:app)) "app")))
+ (unless nested
+ (5am:is (eql nil (qt:app-p)))))))
hunk ./src/application.lisp 25
- (qt:with-core-app
+ (qt:with-core-app ()
hunk ./src/application.lisp 27
- (qt:with-core-app
+ (qt:with-core-app ()
hunk ./src/application.lisp 33
- (qt:with-app
- (5am:is (= 0 (length (cxx:all-widgets (qt:app)))))
- (let ((w (make-instance 'qt:widget)))
- (5am:is (find w (cxx:all-widgets (qt:app)))))))
+ (qt:with-app ()
+ (5am:is (= 0 (length (cxx:all-widgets (qt:app)))))
+ (let ((w (make-instance 'qt:widget)))
+ (5am:is (find w (cxx:all-widgets (qt:app)))))))
hunk ./src/click.lisp 11
- (qt:with-app
+ (qt:with-app ()
hunk ./src/click.lisp 18
- [_$_]
+ [_$_]
hunk ./src/click.lisp 30
- (qt:with-app
+ (qt:with-app ()
hunk ./src/click.lisp 45
- (qt:with-app
+ (qt:with-app ()
hunk ./src/gc.lisp 11
-It is not required that every instance is gc'ed, since this rarly happens
+It is not required that every instance is gc'ed, since this rarely happens
hunk ./src/gc.lisp 27
- (:documentation "For the object to be (hopefully) garbage colleted
+ (:documentation "For the object to be (hopefully) garbage collected
hunk ./src/gc.lisp 53
- ;(cxx:set-parent (make-instance 'qt:object) object)
+ ;;(cxx:set-parent (make-instance 'qt:object) object)
hunk ./src/gc.lisp 70
- (qt:with-core-app
+ (qt:with-core-app ()
hunk ./src/gc.lisp 83
- (qt:with-core-app
+ (qt:with-core-app ()
hunk ./src/gc.lisp 110
- "Test GC a unreacable cycle."
+ "Test GC a unreachable cycle."
hunk ./src/gc.lisp 113
- (qt:with-core-app
- (let ((objects (hash-table-count smoke::*object-map*)))
- (eval '(test-gc-cycle))
- (eval '(gc :full t))
- (qt:core-application.send-posted-events)
- (eval '(gc :full t))
- (qt:core-application.send-posted-events)
- (gc :full t)
- (qt:core-application.send-posted-events)
- (gc :full t)
- (5am:is (>= (+ 2 objects) (hash-table-count smoke::*object-map*))))))
+ (qt:with-core-app ()
+ (let ((objects (hash-table-count smoke::*object-map*)))
+ (eval '(test-gc-cycle))
+ (eval '(gc :full t))
+ (qt:core-application.send-posted-events)
+ (eval '(gc :full t))
+ (qt:core-application.send-posted-events)
+ (gc :full t)
+ (qt:core-application.send-posted-events)
+ (gc :full t)
+ (5am:is (>= (+ 2 objects) (hash-table-count smoke::*object-map*))))))
hunk ./src/gc.lisp 126
- "Test ownership tranasfer of a QObject without a wrapper."
+ "Test ownership transfer of a QObject without a wrapper."
hunk ./src/gc.lisp 142
- "Test adding a child to a non smoke object."
- (qt:with-app
- (let ((model (make-instance 'qt:string-list-model
- :args (list #("a" "b" "c"))))
- (view (make-instance 'qt:list-view))
- (counter 0))
- (setf (cxx:model view) model)
- (qt:connect (qt:get-signal (cxx:selection-model view)
- "selectionChanged(QItemSelection, QItemSelection)")
- #'(lambda (selected deselected)
- (declare (ignore selected deselected))
- (incf counter)))
- (gc :full t)
- (qt:core-application.send-posted-events)
- (gc :full t)
- (qt:core-application.send-posted-events)
- (5am:is (= 0 counter))
- (cxx:select (cxx:selection-model view)
- (cxx:index model 0)
- qt:item-selection-model.+toggle+)
- (5am:is (= 1 counter))
- (cxx:select (cxx:selection-model view)
- (cxx:index model 1)
- qt:item-selection-model.+toggle+)
- (5am:is (= 2 counter)))))
+ "Test adding a child to a non smoke object."
+ (qt:with-app ()
+ (let ((model (make-instance 'qt:string-list-model
+ :args (list #("a" "b" "c"))))
+ (view (make-instance 'qt:list-view))
+ (counter 0))
+ (setf (cxx:model view) model)
+ (qt:connect (qt:get-signal (cxx:selection-model view)
+ "selectionChanged(QItemSelection, QItemSelection)")
+ #'(lambda (selected deselected)
+ (declare (ignore selected deselected))
+ (incf counter)))
+ (gc :full t)
+ (qt:core-application.send-posted-events)
+ (gc :full t)
+ (qt:core-application.send-posted-events)
+ (5am:is (= 0 counter))
+ (cxx:select (cxx:selection-model view)
+ (cxx:index model 0)
+ qt:item-selection-model.+toggle+)
+ (5am:is (= 1 counter))
+ (cxx:select (cxx:selection-model view)
+ (cxx:index model 1)
+ qt:item-selection-model.+toggle+)
+ (5am:is (= 2 counter)))))
hunk ./src/object.lisp 6
- "Test QList<Object*> to sequence conversion."
- (let ((object (make-instance 'qt:object)))
- (5am:is (= 0 (length (cxx:children object))))
- (let ((children (mapcar #'(lambda (parent)
- (make-instance 'qt:object :args (list parent)))
- (list object object object))))
- (5am:is (= (length children)
- (length (cxx:children object))))
- (dolist (c children)
- (5am:is (find c (cxx:children object)))))))
+ "Test QList<Object*> to sequence conversion."
+ (let ((object (make-instance 'qt:object)))
+ (5am:is (= 0 (length (cxx:children object))))
+ (let ((children (mapcar #'(lambda (parent)
+ (make-instance 'qt:object :args (list parent)))
+ (list object object object))))
+ (5am:is (= (length children)
+ (length (cxx:children object))))
+ (dolist (c children)
+ (5am:is (find c (cxx:children object)))))))
hunk ./src/overload.lisp 15
- (qt:with-core-app
+ (qt:with-core-app ()
hunk ./src/qbytearray.lisp 5
-
hunk ./src/qbytearray.lisp 7
- (5am:is (string= ""
- (cxx:data (make-instance 'qt:byte-array)))))
-
+ (5am:is (string= "" (cxx:data (make-instance 'qt:byte-array)))))
hunk ./src/qbytearray.lisp 10
- "Tests string <-> QByteArray."
+ "Test string <-> QByteArray."
hunk ./src/qstring.lisp 8
-; (5am:for-all ((string (5am:gen-string))) ;; FIXME (Qt bug?)
+ ;; (5am:for-all ((string (5am:gen-string))) ;; FIXME (Qt bug?)
hunk ./src/qstring.lisp 10
- "FOO bar"
- ""
- (format nil "A~AB" #\Null)
- "öäüƧЪ")))
+ "FOO bar"
+ ""
+ (format nil "A~AB" #\Null)
+ "öäüƧЪ")))
hunk ./src/signal-slot.lisp 11
- [_$_]
+ [_$_]
hunk ./src/signal-slot.lisp 18
- (qt:with-core-app
+ (qt:with-core-app ()
hunk ./src/signal-slot.lisp 28
- (qt:with-core-app
+ (qt:with-core-app ()
hunk ./src/signal-slot.lisp 40
- (qt:with-app
+ (qt:with-app ()
hunk ./src/signal-slot.lisp 51
- (qt:with-app
+ (qt:with-app ()
hunk ./src/signal-slot.lisp 129
- (qt:with-app
- (let ((spin-box (make-instance 'qt:spin-box))
- (current-value)
- (current-string-value))
- (qt:connect (qt:get-signal spin-box "valueChanged(int)")
- #'(lambda (value)
- (setf current-value value)))
- (qt:connect (qt:get-signal spin-box "valueChanged(const QString&)")
- #'(lambda (value)
- (setf current-string-value value)))
- (5am:for-all ((value (5am:gen-integer
- :min (cxx:minimum spin-box)
- :max (cxx:maximum spin-box))))
- (cxx:set-value spin-box value)
- (5am:is (= value current-value))
- (5am:is (= value (read-from-string current-string-value)))))))
+ (qt:with-app ()
+ (let ((spin-box (make-instance 'qt:spin-box))
+ (current-value)
+ (current-string-value))
+ (qt:connect (qt:get-signal spin-box "valueChanged(int)")
+ #'(lambda (value)
+ (setf current-value value)))
+ (qt:connect (qt:get-signal spin-box "valueChanged(const QString&)")
+ #'(lambda (value)
+ (setf current-string-value value)))
+ (5am:for-all ((value (5am:gen-integer
+ :min (cxx:minimum spin-box)
+ :max (cxx:maximum spin-box))))
+ (cxx:set-value spin-box value)
+ (5am:is (= value current-value))
+ (5am:is (= value (read-from-string current-string-value)))))))
hunk ./src/signal-slot.lisp 148
- (qt:with-app
- (let ((button (make-instance 'qt:push-button))
- (click-count 0)
- (signal-mapper (make-instance 'qt:signal-mapper)))
- (qt:connect (qt:get-signal button "clicked()")
- (qt:get-slot signal-mapper "map()"))
- (cxx:set-mapping signal-mapper button button)
- [_$_]
- (qt:connect (qt:get-signal signal-mapper "mapped(QObject*)")
- #'(lambda (object)
- (5am:is (eq button object))
- (incf click-count)))
- (5am:is (= 0 click-count))
- (qt:test.mouse-click button qt:+left-button+)
- (5am:is (= 1 click-count)))))
+ (qt:with-app ()
+ (let ((button (make-instance 'qt:push-button))
+ (click-count 0)
+ (signal-mapper (make-instance 'qt:signal-mapper)))
+ (qt:connect (qt:get-signal button "clicked()")
+ (qt:get-slot signal-mapper "map()"))
+ (cxx:set-mapping signal-mapper button button)
+ [_$_]
+ (qt:connect (qt:get-signal signal-mapper "mapped(QObject*)")
+ #'(lambda (object)
+ (5am:is (eq button object))
+ (incf click-count)))
+ (5am:is (= 0 click-count))
+ (qt:test.mouse-click button qt:+left-button+)
+ (5am:is (= 1 click-count)))))
hunk ./src/signal-slot.lisp 166
- (qt:with-app
+ (qt:with-app ()
hunk ./src/signal-slot.lisp 172
- (declare (ignore end))
+ (declare (ignore end))
hunk ./src/signal-slot.lisp 174
- parent)
+ parent)
hunk ./src/signal-slot.lisp 184
- (qt:with-app
- (let ((combobox (make-instance 'qt:text-edit))
- (set-font (qt:make-signal)))
- (qt:connect set-font
- (qt:get-slot combobox "setCurrentFont(QFont)"))
- (5am:is (cxx:operator== (cxx:current-font combobox)
- (make-instance 'qt:font)))
- (funcall set-font "Times")
- (5am:is (cxx:operator== (cxx:current-font combobox)
- "Times")))))
+ (qt:with-app ()
+ (let ((combobox (make-instance 'qt:text-edit))
+ (set-font (qt:make-signal)))
+ (qt:connect set-font
+ (qt:get-slot combobox "setCurrentFont(QFont)"))
+ (5am:is (cxx:operator== (cxx:current-font combobox)
+ (make-instance 'qt:font)))
+ (funcall set-font "Times")
+ (5am:is (cxx:operator== (cxx:current-font combobox)
+ "Times")))))
hunk ./src/undo.lisp 7
- :initarg :place))
+ :initarg :place))
hunk ./src/undo.lisp 10
-
hunk ./src/undo.lisp 17
- "Test ownership transfer of a undo-command to the undo-stack."
- (let ((undo-stack (make-instance 'qt:undo-stack))
- (iterations 10)
- (counter 0))
- (declare (special counter))
- (dotimes (i iterations)
- (cxx:push undo-stack
- (make-instance 'reversible-incf :place 'counter))
- (gc :full t)) ;; Test for faulty ownership transfer
- (5am:is (eq t (cxx:can-undo undo-stack)))
- (5am:is (= iterations counter))
+ "Test ownership transfer of a undo-command to the undo-stack."
+ (let ((undo-stack (make-instance 'qt:undo-stack))
+ (iterations 10)
+ (counter 0))
+ (declare (special counter))
+ (dotimes (i iterations)
+ (cxx:push undo-stack
+ (make-instance 'reversible-incf :place 'counter))
+ (gc :full t)) ;; Test for faulty ownership transfer
+ (5am:is (eq t (cxx:can-undo undo-stack)))
+ (5am:is (= iterations counter))
hunk ./src/undo.lisp 29
- (dotimes (i iterations)
- (cxx:undo undo-stack))
- (5am:is (eq nil (cxx:can-undo undo-stack)))
- (5am:is (= 0 counter))))
+ (dotimes (i iterations)
+ (cxx:undo undo-stack))
+ (5am:is (eq nil (cxx:can-undo undo-stack)))
+ (5am:is (= 0 counter))))
hunk ./src/variant.lisp 7
-; (5am:for-all ((string (5am:gen-string)))
+ ;; (5am:for-all ((string (5am:gen-string)))
hunk ./src/variant.lisp 9
- "Foo Bar")))
+ "Foo Bar")))