Changeset vendor,8 for vendor


Ignore:
Timestamp:
08/23/2008 11:23:53 AM (18 years ago)
Author:
raverkamp
revision id:
svn-v3-trunk1:1c22b0a8-4d0b-0410-a296-af6a2e6f35e3:plain-odbc%2Ftrunk:14
Message:

support for CFFI-0.10 and 0.9.2
dummy test for postgresql integrated
moved string handling to ffi-support
sql-server tests work, nothing else (driver<->clisp interaction problems?)

Location:
vendor/src
Files:
1 added
5 edited

Legend:

Unmodified
Added
Removed

  • vendor/src/odbc/ffi-support.lisp

    r5 r8  
    44
    55
    6 (defun get-string (ptr length)
    7   (cffi:foreign-string-to-lisp ptr length nil)
    8   )
     6(defmacro cffi-0.10-or-0.9 (form-0.10 form-0.9)
     7  (if (BOUNDP 'cffi::*foreign-string-mappings*)
     8      form-0.10
     9    form-0.9))
    910
    10 (defun get-string-nts (ptr)
    11   (cffi:foreign-string-to-lisp ptr MOST-POSITIVE-FIXNUM t))
     11(cffi-0.10-or-0.9
     12 (defun get-string (ptr length)
     13   (cffi:foreign-string-to-lisp ptr :count length :encoding :iso-8859-1)
     14   )
     15 (defun get-string (ptr length)
     16   (cffi:foreign-string-to-lisp ptr length nil)
     17   )
     18 )
     19 
     20(cffi-0.10-or-0.9
     21 (defun get-string-nts (ptr)
     22   (cffi:foreign-string-to-lisp ptr :max-chars MOST-POSITIVE-FIXNUM :encoding :iso-8859-1))
     23 (defun get-string-nts (ptr)
     24   (cffi:foreign-string-to-lisp ptr MOST-POSITIVE-FIXNUM t)))
    1225
    13 (defun put-string (ptr vector)
    14   (cffi:lisp-string-to-foreign vector ptr (1+ (length vector))))
     26(cffi-0.10-or-0.9
     27 (defun put-string (ptr vector)
     28   (cffi:lisp-string-to-foreign vector ptr (1+ (length vector)) :encoding :iso-8859-1))
     29 (defun put-string (ptr vector)
     30   (cffi:lisp-string-to-foreign vector ptr (1+ (length vector)))))
    1531
    1632(defun %null-ptr ()
    1733  (cffi:null-pointer))
     34
     35
     36(cffi-0.10-or-0.9
     37 (defmacro with-foreign-string-alloc ((ptr text) &body body)
     38   `(cffi:with-foreign-string (,ptr ,text :encoding :iso-8859-1)
     39                              ,@body))
     40 
     41 (defmacro with-foreign-string-alloc ((ptr text) &body body)
     42   `(cffi:with-foreign-string (,ptr ,text)
     43                              ,@body)))
     44                           
    1845
    1946(defun get-byte-vector (ptr length)

  • vendor/src/odbc/odbc-functions.lisp

    r5 r8  
    9797    (#.$SQL_INVALID_HANDLE
    9898      (values result-code
    99               (make-condition 'sql-error :error-message "[ODBC error] Invalid handle")))
     99              (make-condition 'sql-error :error-message "[ODBC error] Invalid handle"
     100                              :sql-state nil
     101                              :error-code nil
     102                              )))
    100103    ;; maybe this should raise an error immediately
    101104    (#.$SQL_STILL_EXECUTING
    102105      (values result-code
    103               (make-condition 'sql-error :error-message"[ODBC error] Still executing")))
     106              (make-condition 'sql-error :error-message"[ODBC error] Still executing"
     107                              :sql-state nil
     108                              :error-code nil)))
    104109    (#.$SQL_NEED_DATA
    105110     (values result-code nil))
    … …  
    167172           (:prompt $SQL_DRIVER_PROMPT)
    168173           (:noprompt $SQL_DRIVER_NOPROMPT))))
    169     (cffi:with-foreign-string (connection-str-ptr connection-string)
     174    (with-foreign-string-alloc (connection-str-ptr connection-string)
    170175      (with-temporary-allocations
    171176          ((complete-connection-str-ptr (alloc-chars 1024))
    … …  
    414419(defun %sql-exec-direct (sql hstmt henv hdbc)
    415420  (declare (string sql))
    416   (cffi:with-foreign-string (sql-ptr sql)
     421  (with-foreign-string-alloc (sql-ptr sql)
    417422    (with-error-handling
    418423        (:hstmt hstmt :henv henv :hdbc hdbc)
    … …  
    498503(defun %sql-prepare (hstmt sql)
    499504  (declare (string sql))
    500   (cffi:with-foreign-string (sql-ptr sql)
     505  (with-foreign-string-alloc (sql-ptr sql)
    501506    (with-error-handling (:hstmt hstmt)
    502507        (SQLPrepare hstmt sql-ptr $SQL_NTS))))
    … …  
    523528(defun set-connection-attr-string (hdbc option val)
    524529  (with-error-handling  (:hdbc hdbc)
    525       (cffi:with-foreign-string (ptr val)
     530      (with-foreign-string-alloc (ptr val)
    526531        ;; TODO: Null-terminator with length?
    527532        (SQLSetConnectAttr_string hdbc option ptr (length val)))))

  • vendor/src/odbc/odbc-main.lisp

    r6 r8  
    204204    (nreverse res)))
    205205
    206 (defun bind-columns (query)
     206(defun bind-columns (query columncount)
    207207  (with-slots (hstmt
    208208               columns
    209209               column-count)
    210210              query
    211     (let ((cc (result-columns-count hstmt)))
    212       (when (zerop cc)
     211      (when (zerop columncount)
    213212        (error "can not bind columns, there is no result set"))
    214       (setf column-count cc)
     213      (setf column-count columncount)
    215214      (setf columns (make-array column-count))
    216215      (dotimes (pos column-count)
    217216        ;; the columns are 0 based, at least here
    218217        (let ((col (create-column hstmt pos)))
    219           (setf (aref columns pos) col))))))
     218          (setf (aref columns pos) col)))))
    220219
    221220(defun unbind-columns (query)
    … …  
    344343              (row-count (result-rows-count (hstmt query))))
    345344          (loop
    346             (when (zerop (result-columns-count (hstmt query))) (return))
    347             (bind-columns query)
     345            (let ((column-count (result-columns-count (hstmt query))))
     346            (when (zerop column-count) (return))
     347            (bind-columns query column-count)
    348348            (let ((res (fetch-query-results query ))
    349349                  (names (coerce (column-names query) 'list)))
    … …  
    351351              (unbind-columns query)
    352352              (unless (%sql-more-results (hstmt query))
    353                 (return))))
     353                (return)))))
    354354          (let ((return-parameters (get-parameters query)))
    355355            (values row-count (nreverse res-list) return-parameters))))
    … …  
    493493            (unless (= (column-count query) no-of-columns)
    494494              (error "the number of columns has changed"))
    495             (bind-columns query)))
     495            (bind-columns query no-of-columns)))
    496496        (values (fetch-query-results query)
    497497                (coerce (column-names query) 'list)))

  • vendor/src/odbc/parameter.lisp

    r6 r8  
    114114     (put-string (slot-value param 'value-ptr) ""))
    115115    (t
    116      (cffi:lisp-string-to-foreign value
    117                                   (slot-value param 'value-ptr)
    118                                   (1+ (length value)))
     116     (put-string (slot-value param 'value-ptr) value)
    119117     (setf (cffi:mem-ref (slot-value param 'ind-ptr) 'sql-len)
    120118           (length value)))))

  • vendor/src/test/test-sql-server.lisp

    r6 r8  
    3030                 ss-test20
    3131                 ss-test21
    32                  ss-test22))
     32                 ss-test22
     33                 ss-test23
     34                 ss-test24
     35                 ss-test25
     36                 ss-test26))
    3337    (pprint sym)
    3438    (funcall sym con)))
    … …  
    502506
    503507
    504 
     508(defun ss-test24 (con)
     509  (dolist (x '(234 123 237))
     510  (let ((res (exec-query con (format nil "select char(~A)as a" x))))
     511    (assert (= x (char-code (char (first (first res)) 0)))))))
     512
     513(defun ss-test25 (con)
     514  (dolist (x '(234 123 237))
     515  (let ((res (exec-query con (format nil "select ascii('~A') as a" (code-char x)))))
     516    (assert (= x (first (first res)))))))
     517
     518(defun ss-test26 (con)
     519  (dolist (x '(234 123 237))
     520    (let ((res (exec-query con "select ? as a" (string (code-char x)))))
     521      (assert (= x (char-code (char (first (first res)) 0)))))))
     522     
     523 
     524
     525
     526
     527
     528
Note: See TracChangeset for help on using the changeset viewer.