Correct bug with redundant g-value-unset. Some change to subtest.

diff --git a/glib/gobject.foreign-gboxed.lisp b/glib/gobject.foreign-gboxed.lisp
index ff1753a..694ec96 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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))