1 (eval-when (:load-toplevel
:compile-toplevel
:execute
)
5 (:use
:cl
:gtk
:glib
:gobject
:iter
:tg
:5am
))
11 (gobject::activate-gc-hooks
)
12 (gethash 0 gobject
::*foreign-gobjects-strong
*)
13 (gobject::activate-gc-hooks
)
15 (gethash 0 gobject
::*foreign-gobjects-weak
*)
16 (gobject::activate-gc-hooks
)
19 (defun print-refs-table (table &optional
(stream *standard-output
*))
20 (iter (for (ptr object
) in-hashtable table
)
21 (format stream
"~A => ~A (~A refs)~%"
22 ptr object
(gobject::ref-count object
))))
24 (defun print-refs (&optional
(stream *standard-output
*))
25 (format stream
"Strong:~%")
26 (print-refs-table gobject
::*foreign-gobjects-strong
*)
27 (format stream
"Weak:~%")
28 (print-refs-table gobject
::*foreign-gobjects-weak
*))
31 (+ (hash-table-count gobject
::*foreign-gobjects-strong
*)
32 (hash-table-count gobject
::*foreign-gobjects-weak
*)))
34 (defun print-sps (&optional
(stream *standard-output
*))
35 (iter (initially (format stream
"Stable pointers:~%"))
36 (for v in-vector gobject
::*registered-stable-pointers
*)
39 (format stream
"~A => ~A~%" i v
))
40 (finally (format stream
"~%"))))
42 (defun print-hooks (&optional
(stream *standard-output
*))
43 (format stream
"~A~%" gobject
::*gobject-gc-hooks
*))
46 (maphash (lambda (key value
)
47 (declare (ignore value
))
48 (remhash key gobject
::*foreign-gobjects-strong
*))
49 gobject
::*foreign-gobjects-strong
*)
50 (maphash (lambda (key value
)
51 (declare (ignore value
))
52 (remhash key gobject
::*foreign-gobjects-weak
*))
53 gobject
::*foreign-gobjects-weak
*))
55 (when nil
(defvar *builder
* (make-instance 'builder
:from-string
58 <object class=\"GtkDialog\" id=\"dialog1\">
63 (setf gobject
::*debug-stream
* *standard-output
*
65 gobject
::*debug-subclass
* t
)
67 (defclass my-button
(gtk:button
) () (:metaclass gobject-class
))
71 (defun run-all-tests ()
76 (defmacro with-gc-same-counting
(&body body
)
77 (let ((count (gensym)))
78 (multiple-value-bind (body gc-count
)
79 (if (integerp (first body
))
80 (values (rest body
) (first body
))
84 (gobject::activate-gc-hooks
)
86 (let ((,count
(count-refs)))
87 (funcall (lambda () ,@body
))
88 (iter (repeat ,gc-count
)
91 (gobject::activate-gc-hooks
)
93 (is (= ,count
(count-refs))))))))
96 (with-gc-same-counting
98 (make-instance 'my-button
)))
100 (test test-with-signal
101 (with-gc-same-counting
103 (let ((b (make-instance 'my-button
)))
104 (connect-signal b
"clicked" (lambda (bb) (declare (ignore bb
)) (print b
)))
108 (with-gc-same-counting
110 (let ((b (make-instance 'my-button
)))
111 (cffi:convert-from-foreign
(pointer b
) 'g-object
)
115 (with-gc-same-counting
117 (let ((b (make-instance 'builder
:from-string
"<interface>
118 <object class=\"GtkButton\" id=\"button1\">
121 (builder-get-object b
"button1")
123 (gobject::activate-gc-hooks
))
126 (test test-builder-with-signals
127 (with-gc-same-counting
129 (let ((b (make-instance 'builder
:from-string
"<interface>
130 <object class=\"GtkButton\" id=\"button1\">
133 (let ((btn (builder-get-object b
"button1")))
134 (connect-signal btn
"clicked" (lambda (bb) (declare (ignore bb
)) (print btn
))))
136 (gobject::activate-gc-hooks
))