Changeset 64-bit,13

Timestamp:

02/04/2008 12:59:54 AM (18 years ago)

Author:

David Owen <dsowen@…>

branch-nick:

test

parents:

Rev	Tree	Chgset
12	@64-bit,12	[64-bit,12]
2.1.1	@64-bit,2.1.1	[64-bit,2.1.1]

revision id:

dsowen@fugue88.ws-20080204005954-s1vx8hf9i7l2iqqe

Message:

Merged most of revision 3 from vendor. Vendor made some backtracks from sql-pointer to :long for unknown reason, and added MySQL stuff.

Location:

64-bit/src

Files:

• odbc/odbc-functions.lisp (modified) (5 diffs)
• odbc/odbc-utilities.lisp (modified) (2 diffs)
• odbc/parameter.lisp (modified) (4 diffs)
• test/test-mysql.lisp (modified) (2 diffs)
• test/test-oracle.lisp (modified) (1 diff)

64-bit/src/odbc/odbc-functions.lisp

@@ -261 +261 @@
 ; col-nr = :bookmark retrieves a bookmark.
 (defun %bind-column (hstmt column-nr c-type data-ptr precision out-len-ptr)
-  (declare ((integer 0) column-nr))
+  (declare (type (integer 0) column-nr))
   (with-error-handling
       (:hstmt hstmt)
@@ -272 +272 @@
                             sql-type precision scale data-ptr
                             max-value out-len-ptr)
-  (declare ((integer 0) parameter-nr))
+  (declare (type (integer 0) parameter-nr))
   (with-error-handling
       (:hstmt hstmt)
@@ -499 +499 @@
 ;; Column counting is 1-based
 (defun %describe-column (hstmt column-nr)
-  (declare ((integer 1) column-nr))
+  (declare (type (integer 1) column-nr))
   (with-temporary-allocations
       ((column-name-ptr (alloc-chars 256))
@@ -593 +593 @@
 ; column-nr is zero-based
 (defun %sql-get-data (hstmt column-nr c-type data-ptr precision out-len-ptr)
-  (declare ((integer 0) column-nr))
+  (declare (type (integer 0) column-nr))
   (with-error-handling
       (:hstmt hstmt :print-info nil)
@@ -600 +600 @@
 
 (defun %sql-get-data-raw (hstmt position c-type data-ptr buffer-length ind-ptr)
-  (declare ((integer 0) position))
+  (declare (type (integer 0) position))
   (SQLGetData hstmt (1+ position)
               c-type data-ptr buffer-length ind-ptr))

64-bit/src/odbc/odbc-utilities.lisp

@@ -12 +12 @@
 (defvar *default-oracle-dsn* "default-oracle-dsn")
 (defvar *default-sql-server-dsn* "default-sql-server-dsn")
+(defvar *default-mysql-dsn* "default-mysql-dsn")
+
 
 
@@ -42 +44 @@
                      )))
 
+(defun connect-mysql (server user password)
+  (connect-generic :dsn *default-mysql-dsn*
+                   :server server :uid user :pwd password))
+
+
 (defun with-prepared-statement-fun (con string params fun)
   (let ((stm (apply #'prepare-statement con string params)))

64-bit/src/odbc/parameter.lisp

@@ -293 +293 @@
             )
           (progn
-            ;; (break)
             (setf (cffi:mem-ref (slot-value param 'ind-ptr) 'sql-len)
                   (length value))
@@ -426 +425 @@
     ;; we store the position there
     (setf buffer-length (cffi:foreign-type-size 'sql-pointer))
-    (setf value-ptr (cffi:foreign-alloc 'sql-pointer))))
+    (setf value-ptr (cffi:foreign-alloc 'sql-pointer)))
+)
 
 (defmethod set-parameter-value ((param blob-parameter) value)
@@ -437 +437 @@
               (slot-value param 'position))
       (setf (cffi:mem-ref (slot-value param 'ind-ptr) 'sql-len)
-              (%sql-len-data-at-exec (length value))))))
+              (%sql-len-data-at-exec (length value)))
+      )))
 
 (defmethod send-parameter-data ((param blob-parameter) hstmt)
@@ -443 +444 @@
          (len (length temp-val))
          (buffer (cffi:foreign-alloc :uchar
-                                               :count (if (zerop len) 1 len))))
+                                     :count (if (zerop len) 1 len))))
     (put-byte-vector buffer
                  temp-val)

64-bit/src/test/test-mysql.lisp

@@ -12 +12 @@
   (mysql-test4 con)
   (mysql-test5 con)
+  (mysql-test6 con)
   )
 
@@ -186 +187 @@
     (commit con)
     )
+
+
+(defun mysql-drop-test-proc (con proc)
+  (unless (zerop (caar (exec-query con (format nil 
+                                               "
+    select count(*) 
+    from information_schema.routines 
+    where routine_name ='~A'
+    and routine_schema='test'" proc))))
+    (exec-command con (format nil "drop procedure ~A" proc))))
+
+
+(defun mysql-test6 (con)
+  (mysql-drop-test-proc con "test99")
+  (exec-command con "
+CREATE PROCEDURE test99 (in p1 int, out p2 INT)
+     BEGIN
+       set p2=p1+5;
+     END;")
+  (commit con)
+  (pprint
+  (let ((stm (prepare-statement con "{call test.test99(?,?)}" 
+                                '(:integer :in) 
+                                '(:integer :out))))
+    (assert (= 6 (first (exec-prepared-command stm 1))))
+    (free-statement stm)))

64-bit/src/test/test-oracle.lisp

@@ -64 +64 @@
               con "update type_test set t_blob=?,t_clob=? where id =1" 
               '(:blob :in) '(:clob :in))))
-  (exec-prepared-update stm 
-                         (make-array 10000 :element-type '(unsigned-byte 8) :initial-element 33)
-                         (make-string 100001 :initial-element #\o)))
+  (exec-prepared-update 
+   stm ;; sizes were 100000 and 100001
+   (make-array 100000 :element-type '(unsigned-byte 8) :initial-element 33)
+   (make-string 1000001 :initial-element #\o)))
   (commit con))