From b7928e6869af0f4ea66d8245bf37f1405e84c80c Mon Sep 17 00:00:00 2001 From: Dmitry Kalyanov Date: Wed, 25 Feb 2009 23:54:17 +0300 Subject: [PATCH] Correct bug with redundant g-value-unset. Some change to subtest. --- glib/gobject.foreign-gboxed.lisp | 12 +++++++++--- glib/gobject.gvalue-parser.lisp | 8 ++++---- glib/gobject.package.lisp | 3 ++- glib/gobject.signals.lisp | 21 ++++++++++----------- subtest.lisp | 10 ++++------ 5 files changed, 29 insertions(+), 25 deletions(-) diff --git a/glib/gobject.foreign-gboxed.lisp b/glib/gobject.foreign-gboxed.lisp index ff1753a..694ec96 100644 --- a/glib/gobject.foreign-gboxed.lisp +++ b/glib/gobject.foreign-gboxed.lisp @@ -206,6 +206,9 @@ (or (get name 'free-function) (error "g-boxed-ref class ~A has no free-function" name))) +(defun disown-boxed-ref (object) + (setf (gethash (pointer-address (pointer object)) *boxed-ref-owner*) :foreign)) + (defun dispose-boxed-ref (type pointer) (debugf "disposing g-boxed-ref ~A~%" pointer) (unless (gethash (pointer-address pointer) *boxed-ref-count*) @@ -252,7 +255,7 @@ (owner :reader g-boxed-ref-owner :initarg :owner :initform nil)) (:actual-type :pointer)) -(define-parse-method g-boxed-ref (class-name &key (owner :lisp)) +(define-parse-method g-boxed-ref (class-name &key (owner :foreign)) (unless (get class-name 'is-g-boxed-ref) (error "~A is not a subtype of G-BOXED-REF (~A: ~S)" class-name class-name (symbol-plist class-name))) (make-instance 'g-boxed-ref-type :class-name class-name :owner owner)) @@ -269,7 +272,10 @@ (setf (gethash (pointer-address pointer) *boxed-ref-owner*) (g-boxed-ref-owner type)))))) (defmethod translate-from-foreign (value (type g-boxed-ref-type)) - (convert-g-boxed-ref-from-pointer value (g-boxed-ref-class-name type) type)) + (let ((owner (or (gethash (pointer-address value) *boxed-ref-owner*) (g-boxed-ref-owner type)))) ;;This is needed to prevent changing ownership of already created + (prog1 + (convert-g-boxed-ref-from-pointer value (g-boxed-ref-class-name type) type) + (setf (gethash (pointer-address value) *boxed-ref-owner*) owner)))) (defun g-boxed-ref-slot->methods (class slot) (bind (((slot-name &key reader writer type) slot)) @@ -341,5 +347,5 @@ (return-from parse-gvalue-boxed nil)) (unless (null-pointer-p (g-value-get-boxed gvalue)) (cond - ((subtypep boxed-type 'g-boxed-ref) (convert-g-boxed-ref-from-pointer (g-value-get-boxed gvalue) boxed-type (make-instance 'g-boxed-ref-type :class-name boxed-type))) + ((subtypep boxed-type 'g-boxed-ref) (convert-g-boxed-ref-from-pointer (g-value-get-boxed gvalue) boxed-type (make-instance 'g-boxed-ref-type :class-name boxed-type :owner :foreign))) (t (parse-g-boxed (g-value-get-boxed gvalue) boxed-type)))))) \ No newline at end of file diff --git a/glib/gobject.gvalue-parser.lisp b/glib/gobject.gvalue-parser.lisp index 1443e34..f299f69 100644 --- a/glib/gobject.gvalue-parser.lisp +++ b/glib/gobject.gvalue-parser.lisp @@ -44,10 +44,10 @@ (+g-type-interface+ (parse-gvalue-object gvalue)) (t (error "Unknown type: ~A (~A)" type (g-type-name type)))))))) -(defun set-g-value (gvalue value type &key zero-g-value) - (if zero-g-value - (g-value-zero gvalue) - (g-value-unset gvalue)) +(defun set-g-value (gvalue value type &key zero-g-value unset-g-value) + (cond + (zero-g-value (g-value-zero gvalue)) + (unset-g-value (g-value-unset gvalue))) (g-value-init gvalue type) (let ((fundamental-type (g-type-fundamental type))) (cond diff --git a/glib/gobject.package.lisp b/glib/gobject.package.lisp index c5f4ea8..8727e7c 100644 --- a/glib/gobject.package.lisp +++ b/glib/gobject.package.lisp @@ -29,7 +29,8 @@ #:free-stable-pointer #:get-stable-pointer-value #:with-stable-pointer - #:release*)) + #:release* + #:disown-boxed-ref)) (in-package :gobject) diff --git a/glib/gobject.signals.lisp b/glib/gobject.signals.lisp index 8659cd1..83436fe 100644 --- a/glib/gobject.signals.lisp +++ b/glib/gobject.signals.lisp @@ -47,14 +47,13 @@ (for arg in args) (for type = (unmangle-type (mem-aref (foreign-slot-value q 'g-signal-query 'param-types) 'g-type i))) (set-g-value (mem-aref params 'g-value (1+ i)) arg type :zero-g-value t)) - (with-foreign-object (return-value 'g-value) - (g-value-zero return-value) - (g-value-init return-value (foreign-slot-value q 'g-signal-query 'return-type)) - (g-signal-emitv params signal-id signal-name return-value) - (prog1 (if (= (foreign-slot-value q 'g-signal-query 'return-type) - +g-type-void+) - (values) - (parse-gvalue return-value)) - (g-value-unset return-value) - (iter (for i from 0 below (foreign-slot-value q 'g-signal-query 'n-params)) - (g-value-unset (mem-aref params 'g-value (1+ i)))))))))) \ No newline at end of file + (prog1 + (if (= (foreign-slot-value q 'g-signal-query 'return-type) +g-type-void+) + (g-signal-emitv params signal-id signal-name (null-pointer)) + (with-foreign-object (return-value 'g-value) + (g-value-zero return-value) + (g-value-init return-value (foreign-slot-value q 'g-signal-query 'return-type)) + (prog1 (parse-gvalue return-value) + (g-value-unset return-value)))) + (iter (for i from 0 below (foreign-slot-value q 'g-signal-query 'n-params)) + (g-value-unset (mem-aref params 'g-value (1+ i))))))))) \ No newline at end of file diff --git a/subtest.lisp b/subtest.lisp index 8cc4828..10f8b51 100644 --- a/subtest.lisp +++ b/subtest.lisp @@ -21,6 +21,7 @@ (:alloc-function tree-iter-alloc) (:free-function tree-iter-free)) +(cffi:defctype tree-path :pointer) (cffi:defcfun (%gtk-tree-path-get-depth "gtk_tree_path_get_depth") :int (path tree-path)) @@ -65,8 +66,6 @@ (:free-function gtk-tree-path-free) (:slots (indices :reader tree-path-get-indices :writer tree-path-set-indices))) -(cffi:defctype tree-path :pointer) - (gobject::define-vtable ("GtkTreeModel" c-gtk-tree-model) (:skip parent-instance gobject::g-type-interface) ;;some signals @@ -79,7 +78,7 @@ (tree-model-get-flags tree-model-get-flags-cb tree-model-flags (tree-model gobject:g-object)) (tree-model-get-n-columns tree-model-get-n-columns-cb :int (tree-model gobject:g-object)) (tree-model-get-column-type tree-model-get-column-type-cb gobject::g-type (tree-model gobject:g-object) (index :int)) - (tree-model-get-iter tree-model-get-iter-cb :boolean (tree-model gobject:g-object) (iter (:pointer tree-iter)) (path tree-path)) + (tree-model-get-iter tree-model-get-iter-cb :boolean (tree-model gobject:g-object) (iter (gobject:g-boxed-ref tree-iter)) (path (gobject:g-boxed-ref tree-path))) (tree-model-get-path tree-model-get-path-cb tree-path (tree-model gobject:g-object) (iter (:pointer tree-iter))) (tree-model-get-value tree-model-get-value-cb :void (tree-model gobject:g-object) (iter (:pointer tree-iter)) (n :int) (value (:pointer gobject::g-value))) (tree-model-iter-next tree-model-iter-next-cb :boolean (tree-model gobject:g-object) (iter (:pointer tree-iter))) @@ -121,10 +120,9 @@ (aref (store-types tree-model) index)) (defmethod tree-model-get-iter ((model array-list-store) iter path) - (let ((indices (tree-path-indices path))) + (let ((indices (indices path))) (when (= 1 (length indices)) - (cffi:with-foreign-slots ((stamp user-data user-data-2 user-data-3) iter tree-iter) - (setf stamp 0 user-data (cffi:make-pointer (first indices)) user-data-2 (cffi:null-pointer) user-data-3 (cffi:null-pointer))) + (setf (stamp iter) 0 (user-data iter) (first indices)) t))) (defmethod tree-model-ref-node ((model array-list-store) iter)) -- 1.7.10.4