From bb2442ccde47144bca8ddda6aaeff31a9fc9fcf2 Mon Sep 17 00:00:00 2001
From: Dmitry Kalyanov <Kalyanov.Dmitry@gmail.com>
Date: Sat, 1 Aug 2009 15:09:20 +0400
Subject: [PATCH] GBoxed: protect against NILs and null-pointers

---
 gboxed.test.lisp           |   29 +++++++++++++++++------------
 gboxed.variant-struct.lisp |    1 -
 gboxed.vs.lisp             |   24 ------------------------
 gboxed.vs.test.lisp        |   26 ++++++++++++++++++++++++++
 4 files changed, 43 insertions(+), 37 deletions(-)
 create mode 100644 gboxed.vs.test.lisp

diff --git a/gboxed.test.lisp b/gboxed.test.lisp
index afd8dc4..255b12a 100644
--- a/gboxed.test.lisp
+++ b/gboxed.test.lisp
@@ -148,24 +148,29 @@ This call is always paired by call to CREATE-REFERENCE-PROXY."))
                 (slot-value proxy slot)))))
 
 (defmethod translate-to-foreign (proxy (type g-boxed-foreign-type))
-  (let* ((info (g-boxed-foreign-info type)))
-    (values (create-temporary-native info proxy) proxy)))
+  (if proxy
+      (let* ((info (g-boxed-foreign-info type)))
+        (values (create-temporary-native info proxy) proxy))
+      (null-pointer)))
 
 (defmethod free-translated-object (native-structure (type g-boxed-foreign-type) proxy)
-  (free-temporary-native (g-boxed-foreign-info type) proxy native-structure))
+  (when proxy
+    (free-temporary-native (g-boxed-foreign-info type) proxy native-structure)))
 
 (defmethod translate-from-foreign (native-structure (type g-boxed-foreign-type))
-  (let* ((info (g-boxed-foreign-info type)))
-    (cond
-      ((g-boxed-foreign-for-callback type)
-       (create-reference-proxy info native-structure))
-      ((or (g-boxed-foreign-free-to-foreign type)
-           (g-boxed-foreign-free-from-foreign type))
-       (error "Feature not yet handled"))
-      (t (create-proxy-for-native info native-structure)))))
+  (unless (null-pointer-p native-structure)
+    (let* ((info (g-boxed-foreign-info type)))
+      (cond
+        ((g-boxed-foreign-for-callback type)
+         (create-reference-proxy info native-structure))
+        ((or (g-boxed-foreign-free-to-foreign type)
+             (g-boxed-foreign-free-from-foreign type))
+         (error "Feature not yet handled"))
+        (t (create-proxy-for-native info native-structure))))))
 
 (defmethod cleanup-translated-object-for-callback ((type g-boxed-foreign-type) proxy native-structure)
-  (free-reference-proxy (g-boxed-foreign-info type) proxy native-structure))
+  (unless (null-pointer-p native-structure)
+    (free-reference-proxy (g-boxed-foreign-info type) proxy native-structure)))
 
 (defmethod has-callback-cleanup ((type g-boxed-foreign-type))
   t)
diff --git a/gboxed.variant-struct.lisp b/gboxed.variant-struct.lisp
index 0462519..da25cf1 100644
--- a/gboxed.variant-struct.lisp
+++ b/gboxed.variant-struct.lisp
@@ -68,4 +68,3 @@
         (collect variant)))
 
 
-
diff --git a/gboxed.vs.lisp b/gboxed.vs.lisp
index 5025f7c..b670606 100644
--- a/gboxed.vs.lisp
+++ b/gboxed.vs.lisp
@@ -162,27 +162,3 @@
     (iter (for slot in slots)
           (setf (foreign-slot-value native-ptr actual-cstruct slot)
                 (slot-value proxy slot)))))
-
-(define-boxed-variant-cstruct evt "evt"
-  (type :int :initform 0)
-  (time :uint :initform 0)
-  (:variant type
-            (0 evt-zero
-               (x :double :initform 0.0d0)
-               (y :double :initform 0.0d0))
-            ((1 2 3) evt-multi
-             (t2 :int :initform 0)
-             (:variant t2
-                       (1 evt-single
-                          (item :uchar :initform 0))))))
-
-(defcallback test-evt (g-boxed-foreign evt)
-    ((time :int) (e1 (g-boxed-foreign evt)))
-  (print time)
-  (print e1)
-  (incf (evt-time e1) time)
-  (make-evt-multi :time time :t2 123))
-
-(defun do-test-evt (e1 time)
-  (let ((e2 (foreign-funcall-pointer (callback test-evt) () :int time (g-boxed-foreign evt) e1 (g-boxed-foreign evt))))
-    (values e1 e2)))
diff --git a/gboxed.vs.test.lisp b/gboxed.vs.test.lisp
new file mode 100644
index 0000000..7984183
--- /dev/null
+++ b/gboxed.vs.test.lisp
@@ -0,0 +1,26 @@
+(in-package :gobject)
+
+(define-boxed-variant-cstruct evt "evt"
+  (type :int :initform 0)
+  (time :uint :initform 0)
+  (:variant type
+            (0 evt-zero
+               (x :double :initform 0.0d0)
+               (y :double :initform 0.0d0))
+            ((1 2 3) evt-multi
+             (t2 :int :initform 0)
+             (:variant t2
+                       (1 evt-single
+                          (item :uchar :initform 0))))))
+
+(defcallback test-evt (g-boxed-foreign evt)
+    ((time :int) (e1 (g-boxed-foreign evt)))
+  (print time)
+  (print e1)
+  (when e1
+    (incf (evt-time e1) time))
+  (make-evt-multi :time time :t2 123))
+
+(defun do-test-evt (e1 time)
+  (let ((e2 (foreign-funcall-pointer (callback test-evt) () :int time (g-boxed-foreign evt) e1 (g-boxed-foreign evt))))
+    (values e1 e2)))
-- 
1.7.10.4