X-Git-Url: http://git.kpe.io/?p=clsql.git;a=blobdiff_plain;f=db-oracle%2Foracle-sql.lisp;h=03480682f823b91a691533ba217c9239eca6fb5c;hp=d59665de16c8815b5fc572004b4c6827ac62e75c;hb=f97c6c182c9746cd6adbdacf8cdfebbaadef3c37;hpb=65a91423955280d081858aadafab379e23b4304f

diff --git a/db-oracle/oracle-sql.lisp b/db-oracle/oracle-sql.lisp
index d59665d..0348068 100644
--- a/db-oracle/oracle-sql.lisp
+++ b/db-oracle/oracle-sql.lisp
@@ -126,36 +126,37 @@ the length of that format.")
 ;;; NULLS-OK are as in the OERR function.
 
 (defun handle-oci-error (&key database nulls-ok)
-  (cond (database
-         (with-slots (errhp) database
-           (uffi:with-foreign-objects ((errbuf '(:array :unsigned-char
-						 #.+errbuf-len+))
-				       (errcode :long))
-	     ;; ensure errbuf empty string
-             (setf (uffi:deref-array errbuf '(:array :unsigned-char) 0)
-	       (uffi:ensure-char-storable (code-char 0)))
-             (setf (uffi:deref-pointer errcode :long) 0)
-	     
-	     (uffi:with-cstring (sqlstate nil)
-	       (oci-error-get (deref-vp errhp) 1
-			      sqlstate
-			      errcode
-			      (uffi:char-array-to-pointer errbuf)
-			      +errbuf-len+ +oci-htype-error+))
-             (let ((subcode (uffi:deref-pointer errcode :long)))
-               (unless (and nulls-ok (= subcode +null-value-returned+))
-                 (error 'sql-database-error
-                        :database database
-                        :error-id subcode
-                        :message (uffi:convert-from-foreign-string errbuf)))))))
-	(nulls-ok
-	 (error 'sql-database-error
-                :database database
-                :message "can't handle NULLS-OK without ERRHP"))
-	(t 
-	 (error 'sql-database-error
-                :database database
-                :message "OCI Error (and no ERRHP available to find subcode)"))))
+  (cond
+    (database
+     (with-slots (errhp) database
+       (uffi:with-foreign-object (errcode :long)
+	 (let ((errbuf (uffi:allocate-foreign-string #.+errbuf-len+)))
+	   ;; ensure errbuf empty string
+	   (setf (uffi:deref-array errbuf '(:array :unsigned-char) 0)
+		 (uffi:ensure-char-storable (code-char 0)))
+	   (setf (uffi:deref-pointer errcode :long) 0)
+	   
+	   (uffi:with-cstring (sqlstate nil)
+	     (oci-error-get (deref-vp errhp) 1
+			    sqlstate
+			    errcode
+			    (uffi:char-array-to-pointer errbuf)
+			    +errbuf-len+ +oci-htype-error+))
+	   (let ((subcode (uffi:deref-pointer errcode :long)))
+	     (unless (and nulls-ok (= subcode +null-value-returned+))
+	       (error 'sql-database-error
+		      :database database
+		      :error-id subcode
+		      :message (uffi:convert-from-foreign-string errbuf))))
+	   (uffi:free-foreign-object errbuf)))))
+    (nulls-ok
+	  (error 'sql-database-error
+		 :database database
+		 :message "can't handle NULLS-OK without ERRHP"))
+	 (t 
+	  (error 'sql-database-error
+		 :database database
+		 :message "OCI Error (and no ERRHP available to find subcode)"))))
 
 ;;; Require an OCI success code.
 ;;;