darcs - qt.tests

1 (in-package :qt.tests)

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

5 (defclass my-object (qt:object)

6 ((counter :accessor counter :initform 0))

7 (:metaclass cxx:class))

9 (defmethod cxx:timer-event ((object my-object) event)

10 (incf (counter object))

11 (cxx:quit (qt:app)))

13 (5am:test timer

14 (let ((object (make-instance 'my-object)))

15 (qt:with-core-app ()

16 (5am:is (= 0 (counter object)))

17 (cxx:start-timer object 0)

18 (with-timeout (5)

19 (qt:exec))

20 (5am:is (= 1 (counter object))))))

22 (defclass my-list-model (qt:abstract-list-model)

23 ((counter :accessor counter :initform 0))

24 (:metaclass cxx:class))

26 (defmethod cxx:data ((list my-list-model) index role)

27 (incf (counter list))

28 (if (< (cxx:row index) 2)

29 (cxx:row index) ;; cl-smoke converts to the required qt:variant

30 (qt:make-variant)))

32 (defmethod cxx:row-count ((list my-list-model) parent)

33 2)

35 (5am:test return-on-stack

36 "Test virtual method return value on stack."

37 (let ((list (make-instance 'my-list-model))

38 (proxy (make-instance 'qt:sort-filter-proxy-model)))

39 (5am:is (= 0 (counter list)))

40 (setf (cxx:source-model proxy) list)

41 (dotimes (i 10) ;; test for faulty ownership transfer

42 (cxx:sort proxy 0)

43 (gc :full t))

44 (5am:is (< 0 (counter list)))))

46 (5am:test return-on-stack-c++

47 (let ((list (make-instance

48 'qt:string-list-model :args (list #("foo" "bar"))))

49 (proxy (make-instance 'qt:sort-filter-proxy-model)))

50 (setf (cxx:source-model proxy) list)

51 (dotimes (i 10) ;; test for faulty ownership transfer

52 (cxx:sort proxy 0)

53 (gc :full t))

54 (5am:is (= 2 (cxx:row-count list)))))