Add macros for auto-dereferencing buffers on unwind.

angavrilov · Feb 23, 2010 · 52520e1 · 52520e1
1 parent d5122e8
commit 52520e1
Show file tree

Hide file tree

Showing 2 changed files with 25 additions and 10 deletions.
diff --git a/core/buffers.lisp b/core/buffers.lisp
@@ -35,6 +35,7 @@
 (def (generic e) deref-buffer (buffer)
   (:documentation "Decrease the reference count on the buffer. Returns post-value of buffer-refcnt.")
   (:method ((buffer t)) t)
+  (:method :around ((buffer null)) nil)
   (:method :around ((buffer t))
     (let ((cnt (buffer-refcnt buffer)))
       (if (and (numberp cnt) (> cnt 0))
@@ -43,6 +44,21 @@
             (if (> cnt 1) (1- cnt) nil))
           cnt))))
 
+(def (macro e) with-deref-buffer ((var buffer-expr) &body code)
+  (with-unique-names (tmp)
+    `(let (,tmp)
+       (unwind-protect
+            (let ((,var (setf ,tmp ,buffer-expr)))
+              ,@code)
+         (deref-buffer ,tmp)))))
+
+(def (macro e) with-deref-buffers (bindings &body code)
+  (if (null (cdr bindings))
+      `(with-deref-buffer ,(car bindings) ,@code)
+      `(with-deref-buffer ,(car bindings)
+         (with-deref-buffers ,(cdr bindings)
+           ,@code))))
+
 (def (generic e) buffer-displace (buffer &key
                                          offset byte-offset ; Offset in elements of the original
                                          element-type foreign-type ; May not always be supported

diff --git a/test/buffers.lisp b/test/buffers.lisp
@@ -128,16 +128,15 @@
 (defvar *foreign-arr4*)
 
 (def fixture foreign-arrs
-  (setf *foreign-arr1* (make-foreign-array '(5 5) :element-type 'single-float :initial-element 0.0))
-  (setf *foreign-arr2* (make-foreign-array '(5 5) :element-type 'single-float :initial-element 0.0))
-  (setf *foreign-arr3* (make-foreign-array 25 :element-type 'single-float :initial-element 0.0))
-  (setf *foreign-arr4* (make-foreign-array 25 :element-type 'single-float :initial-element 0.0))
-  (unwind-protect
-       (-body-)
-    (deref-buffer *foreign-arr1*)
-    (deref-buffer *foreign-arr2*)
-    (deref-buffer *foreign-arr3*)
-    (deref-buffer *foreign-arr4*)))
+  (with-deref-buffers ((*foreign-arr1*
+                        (make-foreign-array '(5 5) :element-type 'single-float :initial-element 0.0))
+                       (*foreign-arr2*
+                        (make-foreign-array '(5 5) :element-type 'single-float :initial-element 0.0))
+                       (*foreign-arr3*
+                        (make-foreign-array 25 :element-type 'single-float :initial-element 0.0))
+                       (*foreign-arr4*
+                        (make-foreign-array 25 :element-type 'single-float :initial-element 0.0)))
+    (-body-)))
 
 (def test test/buffers/foreign ()
   (with-fixture foreign-arrs