Changeset combined,2.1.6

Timestamp:

11/28/2007 03:53:07 AM (19 years ago)

Author:

David Owen <dsowen@…>

branch-nick:

64-bit

revision id:

dsowen@tux-20071128035307-g1o96vxy0t1sjzky

Message:

Full pass.

File:

• combined/src/odbc/column.lisp (modified) (16 diffs)

combined/src/odbc/column.lisp

@@ -112 +112 @@
           (cffi:foreign-alloc :char :count (slot-value column 'buffer-length))))
 
-;; dso+
 (defmethod get-column-value ((column string-column))
   (let ((len (cffi:mem-ref (slot-value column 'ind-ptr) 'sql-len)))
@@ -147 +146 @@
           (cffi:foreign-alloc :uchar :count (slot-value column 'buffer-length))))
 
-;; dso+
 (defmethod get-column-value ((column unicode-string-column))
   (let ((len (cffi:mem-ref (slot-value column 'ind-ptr) 'sql-len)))
@@ -174 +172 @@
 
 
-;; dso+
 (defmethod get-column-value ((column integer-column))
   (let ((len (cffi:mem-ref (slot-value column 'ind-ptr) 'sql-len)))
@@ -188 +185 @@
 (defclass double-column (column) ())
 
-;; dso+
 (defmethod initialize-column ((column double-column) args)
   (declare (ignore args))
@@ -196 +192 @@
   (setf (slot-value column 'value-ptr) (cffi:foreign-alloc :double)))
 
-;; dso+
 (defmethod get-column-value ((column double-column))
   ;; (%get-long (slot-value column 'ind-ptr))
@@ -211 +206 @@
 (defclass date-column (column) ())
 
-;; dso+
 (defmethod initialize-column ((column date-column) args)
   (declare (ignore args)) 
@@ -219 +213 @@
   (setf (slot-value column 'value-ptr) (cffi:foreign-alloc :uchar :count 32)))
 
-;; dso+
 (defmethod get-column-value ((column date-column))
   (let ((len (cffi:mem-ref (slot-value column 'ind-ptr) 'sql-len)))
@@ -248 +241 @@
 
 (defmethod get-column-value ((column binary-column))
-  (let ((len (cffi:mem-ref (slot-value column 'ind-ptr) :long)))
+  (let ((len (cffi:mem-ref (slot-value column 'ind-ptr) 'sql-len)))
     (if (= len $SQL_NULL_DATA) 
       nil
@@ -258 +251 @@
 (defclass bigint-column (column) ())
 
-;; dso+
 (defmethod initialize-column ((column bigint-column) args)
   (declare (ignore args))
@@ -267 +259 @@
   (setf (slot-value column 'value-ptr) (cffi:foreign-alloc :uchar :count 25)))
 
-;; dso+
 (defmethod get-column-value ((column bigint-column))
   (let ((len (cffi:mem-ref (slot-value column 'ind-ptr) 'sql-len)))
@@ -322 +313 @@
 
 (defmethod get-column-value ((column decimal-column))
-  (let ((len (cffi:mem-ref (slot-value column 'ind-ptr) :long)))
+  (let ((len (cffi:mem-ref (slot-value column 'ind-ptr) 'sql-len)))
     (if (= len $SQL_NULL_DATA) 
-      nil
-      (let ((bytes (get-byte-vector (slot-value column 'value-ptr) len))
-            (sum 0))
-        (dotimes (i 16)
-          (setf sum (+ (* 256 sum) (aref bytes (- (+ 3 16) 1 i)))))
-        (* 
-         sum
-         (if (zerop (aref bytes 2)) -1 1) ;sign
-         (expt 10 (- (aref bytes 1))))))))
+        nil
+        (let ((bytes (get-byte-vector (slot-value column 'value-ptr) len))
+              (sum 0))
+          (dotimes (i 16)
+            (setf sum (+ (* 256 sum) (aref bytes (- (+ 3 16) 1 i)))))
+          (* 
+           sum
+           (if (zerop (aref bytes 2)) -1 1) ;sign
+           (expt 10 (- (aref bytes 1))))))))
 
 
@@ -350 +341 @@
   (let* ((value-ptr (cffi:foreign-alloc :char 
                                         :count (slot-value column 'buffer-length)))
-         (ind-ptr (cffi:foreign-alloc :long)))
+         (ind-ptr (cffi:foreign-alloc 'sql-len)))
     (unwind-protect
       (get-character-data 
@@ -374 +365 @@
 (defmethod get-column-value ((column uclob-column))
   (let* ((value-ptr (cffi:foreign-alloc :char :count (slot-value column 'buffer-length)))
-         (ind-ptr (cffi:foreign-alloc :long)))
+         (ind-ptr (cffi:foreign-alloc 'sql-len)))
     (unwind-protect
       (get-unicode-character-data 
@@ -398 +389 @@
 (defmethod get-column-value ((column blob-column))
   (let* ((value-ptr (cffi:foreign-alloc  :uchar :count (slot-value column 'buffer-length)))
-         (ind-ptr (cffi:foreign-alloc :long)))
+         (ind-ptr (cffi:foreign-alloc 'sql-len)))
     (unwind-protect
       (get-binary-data 
@@ -412 +403 @@
 ;;  fetch data via SQlGetData
 ;; ------------------------------
-;; dso+
 (defun get-character-data (hstmt position value-ptr buffer-length ind-ptr)
   ;; local error handling, we can not use the general error handling
@@ -530 +520 @@
              (get-output-stream-string sos))))))))
     
-;; dso+
 (defun get-binary-data (hstmt position value-ptr buffer-length ind-ptr)
   ;; local error handling, we can not use the general error handling