Thu Jun 4 00:07:20 CEST 2009 Tobias Rautenkranz <tobias@rautenkranz.ch>
* Test restarts in callback and slot; and test abort-app
diff -rN -u old-qt.tests/qt.tests.mbd new-qt.tests/qt.tests.mbd
--- old-qt.tests/qt.tests.mbd 2014-10-22 10:14:04.000000000 +0200
+++ new-qt.tests/qt.tests.mbd 2014-10-22 10:14:04.000000000 +0200
@@ -22,6 +22,7 @@
("signal-slot" (:needs "tests"))
("operators" (:needs "tests"))
("undo" (:needs "tests"))
+ ("abort" (:needs "tests"))
("object" (:needs "tests"))
("thread" (:needs "tests"))
("properties" (:needs "tests"))
diff -rN -u old-qt.tests/src/abort.lisp new-qt.tests/src/abort.lisp
--- old-qt.tests/src/abort.lisp 1970-01-01 01:00:00.000000000 +0100
+++ new-qt.tests/src/abort.lisp 2014-10-22 10:14:04.000000000 +0200
@@ -0,0 +1,82 @@
+(in-package :qt.tests)
+
+(5am:in-suite :qt.suite)
+
+(defmacro with-invoke-restart ((condition restart &optional handler) &body body)
+ "Invokes RESTART when CONDITION is signaled in BODY."
+ (alexandria:with-gensyms (c)
+ `(handler-bind ((,condition #'(lambda (,c)
+ (declare (ignore ,c))
+ (assert (find-restart ',restart))
+ ,(when handler `(funcall ,handler))
+ (invoke-restart ',restart))))
+ ,@body)))
+
+(define-condition no-ticket (error) ())
+
+(defun call-slot (slot &rest arguments)
+ (let ((sig (qt:make-signal)))
+ (qt:connect sig slot qt:+queued-connection+)
+ (apply sig arguments)))
+
+(5am:test abort-with-app
+ "Test aborting the event loop."
+ (dotimes (i 3)
+ (bt:with-timeout (5)
+ (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))))))))
+
+(defclass error-object (qt:object)
+ ()
+ (:metaclass cxx:class))
+
+(defmethod cxx:timer-event ((object error-object) timer-event)
+ (cxx:kill-timer object (cxx:timer-id timer-event))
+ (error (make-condition 'no-ticket)))
+
+(5am:test error-in-callback-return
+ "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)))))
+
+(5am:test error-in-callback-default
+ "Test calling the default C++ method on error in the user defined method."
+ (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)))))
+
+ (5am:test error-in-slot
+ "Test skipping a slot function when it signals an error."
+ (qt:with-core-app
+ (let ((timer (make-instance 'qt:timer))
+ (continued-p))
+ (with-invoke-restart (no-ticket continue
+ #'(lambda () (setf continued-p t)))
+ (cxx:set-single-shot timer t)
+ (qt:connect (qt:get-signal timer "timeout()")
+ #'(lambda ()
+ (error (make-condition 'no-ticket))))
+ (cxx:start timer 0)
+ (qt:core-application.process-events))
+ (5am:is (eq t continued-p)))))
diff -rN -u old-qt.tests/src/signal-slot.lisp new-qt.tests/src/signal-slot.lisp
--- old-qt.tests/src/signal-slot.lisp 2014-10-22 10:14:04.000000000 +0200
+++ new-qt.tests/src/signal-slot.lisp 2014-10-22 10:14:04.000000000 +0200
@@ -166,6 +166,7 @@
(qt:connect (qt:get-signal model
"rowsInserted(QModelIndex, int, int)")
#'(lambda (parent start end)
+ (declare (ignore end))
(5am:is (cxx:= (cxx:parent (cxx:index model start)))
parent)
(incf count)))