darcs - qt.tests

1 (in-package :qt.tests)

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

5 (defclass click-test-widget (qt:push-button)

6 ()

7 (:metaclass cxx:class))

9 (5am:test (click-test :depends-on with-app)

10 "Test clicking a button."

11 (qt:with-app ()

12 (let ((widget (make-instance 'click-test-widget))

13 (click-count 0))

14 (qt:connect (qt:get-signal widget "clicked()")

15 #'(lambda ()

16 (5am:is (eq widget (qt:sender)))

17 (incf click-count)))

19 (cxx:set-text widget "Hello World")

20 (5am:is (string= "Hello World" (cxx:text widget)))

22 (5am:is (= 0 click-count))

23 (qt:test.mouse-click widget qt:+left-button+

24 0 (make-instance 'qt:point) -1)

25 (5am:is (= 1 click-count))

26 (qt:test.mouse-click widget qt:+right-button+

27 0 (make-instance 'qt:point) -1)

28 (5am:is (= 1 click-count)))))

30 (5am:test (click-test-bool :depends-on click-test)

31 "Test clicking a button (bool argument)."

32 (qt:with-app ()

33 (let ((widget (make-instance 'click-test-widget))

34 (click-count 0))

35 (qt:connect (qt:get-signal widget "clicked(bool)")

36 #'(lambda (checked)

37 (5am:is (eql nil checked))

38 (incf click-count)))

39 (5am:is (= 0 click-count))

40 (qt:test.mouse-click widget qt:+left-button+

41 0 (make-instance 'qt:point) -1)

42 (5am:is (= 1 click-count))

43 (qt:test.mouse-click widget qt:+left-button+

44 0 (make-instance 'qt:point) -1)

45 (5am:is (= 2 click-count)))))

47 (5am:test (click-test-bool-this :depends-on click-test)

48 "Test clicking a button (bool argument) for a function with this argument."

49 (qt:with-app ()

50 (let ((widget (make-instance 'click-test-widget))

51 (click-count 0))

52 (qt:connect (qt:get-signal widget "clicked(bool)")

53 (qt:get-slot widget

54 #'(lambda (object checked)

55 (5am:is (eq nil checked))

56 (5am:is (eq widget object))

57 (incf click-count))))

58 (5am:is (= 0 click-count))

59 (qt:test.mouse-click widget qt:+left-button+

60 0 (make-instance 'qt:point) -1)

61 (5am:is (= 1 click-count))

62 (qt:test.mouse-click widget qt:+left-button+

63 0 (make-instance 'qt:point) -1)

64 (5am:is (= 2 click-count)))))