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))