chiark / gitweb /
Fixed some macros doing unintended variable capture
authorespen <espen>
Sun, 1 Oct 2000 17:19:11 +0000 (17:19 +0000)
committerespen <espen>
Sun, 1 Oct 2000 17:19:11 +0000 (17:19 +0000)
glib/gforeign.lisp

index da38df6ff2c96b57777cfaa31c9a5a86d2759617..001911cff2b127ec76660a7eab56ba7246f53983 100644 (file)
@@ -15,7 +15,7 @@
 ;; License along with this library; if not, write to the Free Software
 ;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 
-;; $Id: gforeign.lisp,v 1.4 2000-09-04 22:07:32 espen Exp $
+;; $Id: gforeign.lisp,v 1.5 2000-10-01 17:19:11 espen Exp $
 
 (in-package "GLIB")
 
@@ -579,7 +579,8 @@ (deftype-method translate-from-alien string
      (unless (null-pointer-p sap)
        (prog1
           (c-call::%naturalize-c-string sap)
-        ,(when (eq alloc :copy) `(deallocate-memory ,sap))))))
+        ;,(when (eq alloc :copy) `(deallocate-memory ,sap))
+        ))))
 
 (deftype-method cleanup-alien string (type-spec sap &optional copied)
   (declare (ignore type-spec))
@@ -625,9 +626,9 @@ (deftype-method translate-to-alien or (union-type-spec expr &optional copy)
        (etypecase value
         ,@(map
            'list
-           #'(lambda (type-spec)
-               (list type-spec (translate-to-alien type-spec 'value copy)))
-           type-specs)))))
+             #'(lambda (type-spec)
+                 (list type-spec (translate-to-alien type-spec 'value copy)))
+             type-specs)))))
 
 
 (deftype-method translate-type-spec system-area-pointer (type-spec)
@@ -722,11 +723,8 @@ (deftype-method size-of enum (type-spec)
 (deftype-method translate-to-alien enum (type-spec expr &optional copy)
   (declare (ignore copy))
   (let ((args (cdr (type-expand-to 'enum type-spec))))
-    `(let ((expr ,expr))
-       (if (integerp expr)
-          expr
-        (ecase expr
-          ,@(map-mappings args :enum-int))))))
+    `(ecase ,expr
+       ,@(map-mappings args :enum-int))))
 
 (deftype-method translate-from-alien enum (type-spec expr &optional alloc)
   (declare (ignore alloc))
@@ -759,17 +757,19 @@ (deftype-method translate-to-alien flags (type-spec expr &optional copy)
   (declare (ignore copy))
   (destructuring-bind (name &rest args) (type-expand-to 'flags type-spec)
     (declare (ignore name))
-    (let ((mappings (map-mappings args :flags-int)))
-      `(let ((value 0))
-        (dolist (flag ,expr value)
-          (setq value (logior value (second (assoc flag ',mappings)))))))))
+    (let ((mappings (map-mappings args :flags-int))
+         (value (make-symbol "VALUE")))
+      `(let ((,value 0))
+        (dolist (flag ,expr ,value)
+          (setq ,value (logior ,value (second (assoc flag ',mappings)))))))))
 
 (deftype-method translate-from-alien flags (type-spec expr &optional alloc)
   (declare (ignore alloc))
   (destructuring-bind (name &rest args) (type-expand-to 'flags type-spec)
     (declare (ignore name))
-    (let ((mappings (map-mappings args :int-flags)))
-      `(let ((result nil))
-        (dolist (mapping ',mappings result)
+    (let ((mappings (map-mappings args :int-flags))
+         (result (make-symbol "RESULT")))
+      `(let ((,result nil))
+        (dolist (mapping ',mappings ,result)
           (unless (zerop (logand ,expr (first mapping)))
-            (push (second mapping) result)))))))
+            (push (second mapping) ,result)))))))