darcs - qt.tests

1 (in-package :qt.tests)

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

5 (5am:test qvector-qpoint

6 "Tests to QVector<QPoint> translation."

7 (let* ((points

8 (map 'vector #'(lambda (coords)

9 (make-instance 'qt:point :arg0 (first coords)

10 :arg1 (rest coords)))

11 '((9 . 8) (7 . 6) (5 . 4))))

12 (polygon (make-instance 'qt:polygon :arg0 points)))

13 (dotimes (i (length points))

14 (5am:is (= (cxx:x (aref points i))

15 (cxx:x (cxx:point polygon i))))

16 (5am:is (= (cxx:y (aref points i))

17 (cxx:y (cxx:point polygon i))))))

18 ;; Free the allocated QVector<QPoint>

19 (tg:gc :full t))

21 (5am:test qvector-double

22 "Test QVector<double> <-> Lisp translation."

23 (5am:for-all ((pattern (5am:gen-one-element #()

24 #(1d0 2d0)

25 #(3.1415926d0 -10d0 1d10 0d0))))

26 (let ((pen (make-instance 'qt:pen))) ;; set-dash-pattern only works once!?

27 (cxx:set-dash-pattern pen pattern)

28 (5am:is (equalp pattern (cxx:dash-pattern pen))))))

30 (5am:test qvector-uint

31 "Test QVector<unsigned int> <-> Lisp translation."

32 (let ((image (make-instance 'qt:image

33 :args (list 10 10 qt:image.+format-indexed8+)))

34 (colors (map 'vector

35 #'qt:q-rgb

36 '(1 2 44 55 255)

37 '(4 6 23 43 12)

38 '(5 0 23 12 123))))

39 (5am:is (equalp #() (cxx:color-table image)))

40 (cxx:set-color-table image colors)

41 (5am:is (equalp colors (cxx:color-table image)))))