Merge remote-tracking branch 'andy128k/master'
[cl-gtk2.git] / glib / gobject.type-tests.lisp
blob7f61d01327b14b293245f05aa1640810bf4aef06
1 (defpackage #:gtype-tests
2 (:use #:cl #:iter #:gobject #:gobject.ffi #:5am)
3 (:export #:run-all-tests)
4 (:import-from #:gobject.ffi #:%gtype #:gtype #:gtype-name #:gtype-%id #:gtype-id #:invalidate-gtypes))
6 (in-package #:gtype-tests)
8 (def-suite gtype)
10 (in-suite gtype)
12 (defun run-all-tests ()
13 (run! 'gtype))
15 ;; Normal things
17 (test normal.1
18 (finishes (%gtype "gint"))
19 (finishes (%gtype "glong"))
20 (finishes (%gtype +g-type-pointer+)))
22 (test normal.eq
23 (is (eq (%gtype "gint") (%gtype "gint")))
24 (is (eq (%gtype "GObject") (%gtype "GObject")))
25 (is (not (eq (%gtype "gint") (%gtype "GObject"))))
26 (is (eq (%gtype "gchararray") (%gtype +g-type-string+))))
28 (test normal.boundary
29 (is (null (%gtype 0)))
30 (is (null (%gtype nil)))
31 (signals warning (%gtype "foobarbaz"))
32 (signals error (%gtype 1)))
34 (test normal.trans
35 (is (string= (gtype-name (%gtype "gint")) "gint"))
36 (is (eql (gtype-id (%gtype "gint")) +g-type-int+)))
38 ;; Clear mappings
40 (test clear.simple
41 (let ((type (%gtype "gint")))
42 (is (eql (gtype-id type) +g-type-int+))
43 (invalidate-gtypes)
44 (is (null (gtype-%id type)))
45 (is (eql (gtype-id type) +g-type-int+))
46 (invalidate-gtypes)
47 (is (eq type (%gtype "gint")))
48 (invalidate-gtypes)
49 (is (eq type (%gtype +g-type-int+)))))
51 (test clear.1
52 (let ((type (%gtype "gint")))
53 (invalidate-gtypes)
54 (is (null (gtype-%id type)))
55 (%gtype +g-type-int+)
56 (is (not (null (gethash +g-type-int+ gobject.ffi::*id-to-gtype*))))
57 (is (not (null (gtype-%id type))))))
59 ;; Core saving
61 (defvar *gi* (%gtype +g-type-int+))
63 (test core.saving
64 (is (eq *gi* (%gtype +g-type-int+)))
65 (is (eq (gtype +g-type-int+) (%gtype +g-type-int+))))