(defun %cstring-into-vector (ptr vector offset size-in-bytes)
(dotimes (i size-in-bytes)
(setf (schar vector offset)
- (ensure-char-character
- (deref-array ptr '(:array :unsigned-char) i)))
+ (ensure-char-character
+ ;; this is MUCH faster than (sb-alien:deref ptr i) even though
+ ;; sb-alien:deref makes more sense. I snagged this by looking at
+ ;; cffi which we had used previously without this bug
+ #+(and sbcl (not cffi))
+ (sb-sys:sap-ref-8 (sb-alien:alien-sap ptr) i)
+ #-(and sbcl (not cffi))
+ (deref-array ptr '(:array :unsigned-char) i)
+ ))
(incf offset))
offset)
(let ((*read-base* 10))
(read-from-string str))
str)))
- (otherwise
- (let ((str)
- (offset 0)
- (octets (make-array out-len :element-type '(unsigned-byte 8) :initial-element 0)))
- (loop
- do
- (loop for i from 0 to (1- (min out-len +max-precision+))
- do (setf (aref octets (+ offset i)) (deref-array data-ptr '(:array :unsigned-byte) i))
- finally (incf offset (1- i)))
- while
- (and (= res $SQL_SUCCESS_WITH_INFO)
- (> out-len +max-precision+))
- do
- (setf res (%sql-get-data hstmt column-nr c-type data-ptr +max-precision+ out-len-ptr)
- out-len (deref-pointer out-len-ptr #.$ODBC-LONG-TYPE)))
- (setf str (uffi:octets-to-string octets))
+ (otherwise
+ (let ((str (make-string out-len)))
+ (loop do (if (= c-type #.$SQL_CHAR)
+ (setf offset (%cstring-into-vector ;string
+ data-ptr str
+ offset
+ (min out-len (1- +max-precision+))))
+ (error 'clsql:sql-database-error :message "wrong type. preliminary."))
+ while
+ (and (= res $SQL_SUCCESS_WITH_INFO)
+ (>= out-len +max-precision+))
+ do (setf res (%sql-get-data hstmt column-nr c-type data-ptr
+ +max-precision+ out-len-ptr)
+ out-len (deref-pointer out-len-ptr #.$ODBC-LONG-TYPE)))
(if (= sql-type $SQL_DECIMAL)
(let ((*read-base* 10))
(read-from-string str))
str))))))
+
(setf (deref-pointer out-len-ptr #.$ODBC-LONG-TYPE) #.$SQL_NO_TOTAL) ;; reset the out length for the next row
result))