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-30 07:57:11.000000000 +0100
+++ new-qt.tests/qt.tests.mbd	2014-10-30 07:57:11.000000000 +0100
@@ -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-30 07:57:11.000000000 +0100
@@ -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-30 07:57:11.000000000 +0100
+++ new-qt.tests/src/signal-slot.lisp	2014-10-30 07:57:11.000000000 +0100
@@ -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)))