Rewrote ODBC's read-data-in-chunks to handle multibyte characters.

This function is called on large (greater than +max-precision+) fields
and was previously converting to lisp characters one at time with no
regard for encoding.  The new method uses 2x more memory as it uses an
extra copy of the string (in pieces) but at least it returns correct
data.

Added a test case that shows the problem (now fixed).

diff --git a/db-odbc/odbc-api.lisp b/db-odbc/odbc-api.lisp
index b20a48aba469295b11880ca8326fec7c196d9d29..fe9d6f80a73ef13350f4e44bce9a0eda33c86a39 100644 (file)
--- a/db-odbc/odbc-api.lisp
+++ b/db-odbc/odbc-api.lisp
@@ -880,61 +880,47 @@ May be locally bound to something else if a certain type is necessary.")
 
 
 (defun read-data-in-chunks (hstmt column-nr data-ptr c-type sql-type
-                                      out-len-ptr result-type)
+                            out-len-ptr result-type)
   (declare (type long-ptr-type out-len-ptr)
            (ignore result-type))
+
   (let* ((res (%sql-get-data hstmt column-nr c-type data-ptr
                              +max-precision+ out-len-ptr))
          (out-len (get-cast-long out-len-ptr))
-         (offset 0)
-         (result (case out-len
-                   (#.$SQL_NULL_DATA
-                    (return-from read-data-in-chunks *null*))
-                   (#.$SQL_NO_TOTAL ;; don't know how long it is going to be
-                                    (let ((str (make-array 0 :element-type 'character :adjustable t)))
-                                      (loop do (if (= c-type #.$SQL_CHAR)
-                                                   (let ((data-length (foreign-string-length data-ptr)))
-                                                     (adjust-array str (+ offset data-length)
-                                                                   :initial-element #\?)
-                                                     (setf offset (%cstring-into-vector
-                                                                   data-ptr str
-                                                                   offset
-                                                                   data-length)))
-                                                 (error 'clsql:sql-database-error :message "wrong type. preliminary."))
-                                            while (and (= res $SQL_SUCCESS_WITH_INFO)
-                                                       (equal (sql-state +null-handle-ptr+ +null-handle-ptr+ hstmt)
-                                                              "01004"))
-                                            do (setf res (%sql-get-data hstmt column-nr c-type data-ptr
-                                                                        +max-precision+ out-len-ptr)))
-                                      (setf str (coerce str 'string))
-                                      (if (= sql-type $SQL_DECIMAL)
-                                          (let ((*read-base* 10))
-                                            (read-from-string str))
-                                        str)))
-                   (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 (get-cast-long out-len-ptr)))
-                      (if (= sql-type $SQL_DECIMAL)
-                          (let ((*read-base* 10)
-                                (*read-default-float-format* 'double-float))
-                            (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))
+         (result (if (equal out-len #.$SQL_NULL_DATA)
+                     (return-from read-data-in-chunks *null*)
+                     
+                     ;;this isn't the most efficient way of doing it:
+                     ;;the foreign string gets copied to lisp, then
+                     ;;that is copied into the final string. However,
+                     ;;the previous impl that tried to copy one
+                     ;;character over at a time failed miserably on
+                     ;;multibyte characters.
+                     ;;
+                     ;;In the face of multibyte characters, the out-len
+                     ;;tells us the length in bytes but that doesn't
+                     ;;particularly help us here in allocating a lisp
+                     ;;array. So our best strategy is to just let the
+                     ;;foreign library that's already dealing with
+                     ;;encodings do its thing.
+                   
+                     (with-output-to-string (str)
+                       (loop do (if (= c-type #.$SQL_CHAR)
+                                    (write-sequence (get-cast-foreign-string data-ptr) str)
+                                    (error 'clsql:sql-database-error
+                                           :message "wrong type. preliminary."))
+                             while (and (= res $SQL_SUCCESS_WITH_INFO)
+                                        (equal (sql-state +null-handle-ptr+ +null-handle-ptr+ hstmt)
+                                               "01004"))
+                             do (setf res (%sql-get-data hstmt column-nr c-type data-ptr
+                                                         +max-precision+ out-len-ptr)))))))
+
+    ;; reset the out length for the next row
+    (setf (deref-pointer out-len-ptr #.$ODBC-LONG-TYPE) #.$SQL_NO_TOTAL)
+    (if (= sql-type $SQL_DECIMAL)
+        (let ((*read-base* 10))
+          (read-from-string result))
+        result)))
 
 
 (def-type c-timestamp-ptr-type (* (:struct sql-c-timestamp)))

diff --git a/tests/test-i18n.lisp b/tests/test-i18n.lisp
index 92aa8d069e7cd1199da5df8c7880195527c47526..b00c6d5529b028763cf458c719be2a509ff17ec1 100644 (file)
--- a/tests/test-i18n.lisp
+++ b/tests/test-i18n.lisp
@@ -36,4 +36,17 @@
                  :flatp t :field-names nil)))
  "Iñtërnâtiônàližætiøn")
 
+(deftest :basic/i18n/big/1
+    (let ((test-string (with-output-to-string (str)
+                         (dotimes (n 250)
+                           (write-sequence "Iñtërnâtiônàližætiøn" str)))))
+      (with-dataset *ds-bigtext*
+        (clsql-sys:execute-command
+         (format nil
+                 "INSERT INTO testbigtext (a) VALUES ('~a')"
+                 test-string))
+        (let ((res (first (clsql:query "SELECT a from testbigtext" :flatp t :field-names nil))))
+          (assert (equal test-string res) (test-string res)
+                  "Returned internationalization string was incorrect. Test :basic/i18n/big/1")))))
+
 ))