r10094: removed obsolete clisp work-around

diff --git a/ChangeLog b/ChangeLog
index 56b1a4772e263f65ac9e6e6f48735ec352e9d870..c81d61c3789f866e16c17f254f878f658682a20f 100644 (file)
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,6 @@
+07 Oct 2004 Kevin Rosenberg <kevin@rosenberg.net>
+       * db-mysql/mysql.c: Fix parameters in bind_param call
+
 07 Oct 2004 Kevin Rosenberg <kevin@rosenberg.net>
        * uffi/clsql-uffi.lisp: Add support for :blob result-type
        * db-mysql/mysql-sql.lisp: Add support for :blob

diff --git a/db-mysql/mysql-sql.lisp b/db-mysql/mysql-sql.lisp
index c202a5e29d80aa929c3cafcbfae4fec113655a40..39bee7ef0c5ed25a97c44a213bef67d625086eb1 100644 (file)
--- a/db-mysql/mysql-sql.lisp
+++ b/db-mysql/mysql-sql.lisp
@@ -460,6 +460,7 @@
     ((in type :bigint) mysql-field-types#longlong)
     ((in type :float :double :number) mysql-field-types#double)
     ((and (consp type) (in (car type) :char :string :varchar)) mysql-field-types#var-string)
+    ((or (eq type :blob) (and (consp type) (in (car type) :blob))) mysql-field-types#var-string)
     (t
        (error 'sql-user-error 
              :message 
@@ -476,11 +477,13 @@
 
     (uffi:with-cstring (native-query sql-stmt)
       (unless (zerop (mysql-stmt-prepare stmt native-query (length sql-stmt)))
+       (mysql-stmt-close stmt)
        (error 'sql-database-error
               :error-id (mysql-errno mysql-ptr)
               :message (mysql-error-string mysql-ptr))))
     
     (unless (= (mysql-stmt-param-count stmt) (length types))
+      (mysql-stmt-close stmt)
       (error 'sql-database-error
             :message 
             (format nil "Mysql param count (~D) does not match number of types (~D)"
@@ -488,87 +491,96 @@
 
     (let ((rs (mysql-stmt-result-metadata stmt)))
       (when (uffi:null-pointer-p rs)
+       (warn "mysql_stmt_result_metadata returned NULL")
+       #+nil
+       (mysql-stmt-close stmt)
+       #+nil
        (error 'sql-database-error
-              :message "NULL result metadata"))
+              :message "mysql_stmt_result_metadata returned NULL"))
       
-      (let* ((field-vec (mysql-fetch-fields rs))
-            (num-fields (mysql-num-fields rs))
-            (input-bind (uffi:allocate-foreign-object 'mysql-bind (length types)))
-            (output-bind (uffi:allocate-foreign-object 'mysql-bind num-fields))
-            (length-ptr (uffi:allocate-foreign-object :unsigned-long num-fields))
-            (is-null-ptr (uffi:allocate-foreign-object :byte num-fields))
-            (mysql-types (mapcar 'clsql-type->mysql-type types)))
+      (let ((input-bind (uffi:allocate-foreign-object 'mysql-bind (length types)))
+           (mysql-types (mapcar 'clsql-type->mysql-type types))
+           field-vec num-fields is-null-ptr output-bind length-ptr)
        
+       (print 'a)
        (dotimes (i (length types))
          (let* ((binding (uffi:deref-array input-bind '(:array mysql-bind) i)))
            (setf (uffi:get-slot-value binding 'mysql-bind 'buffer-type) 
-                 (nth i mysql-types))
+             (nth i mysql-types))
            (setf (uffi:get-slot-value binding 'mysql-bind 'buffer-length) 0)))     
-
-       (dotimes (i num-fields)
-         (declare (fixnum i))
-         (let* ((field (uffi:deref-array field-vec '(:array mysql-field) i))
-                (type (uffi:get-slot-value field 'mysql-field 'type))
-                (binding (uffi:deref-array output-bind '(:array mysql-bind) i)))
-           (setf (uffi:get-slot-value binding 'mysql-bind 'buffer-type) type)
-           
-           (setf (uffi:get-slot-value binding 'mysql-bind 'buffer-length) 0)
-           (setf (uffi:get-slot-value binding 'mysql-bind 'is-null) 
-                 (+ i (uffi:pointer-address is-null-ptr)))
-           (setf (uffi:get-slot-value binding 'mysql-bind 'length) 
-                 (+ (* i 8) (uffi:pointer-address length-ptr)))
-           
-           (case type
-             ((#.mysql-field-types#var-string #.mysql-field-types#string
-                                              #.mysql-field-types#tiny-blob #.mysql-field-types#blob
-                                              #.mysql-field-types#medium-blob #.mysql-field-types#long-blob)
-              (setf (uffi:get-slot-value binding 'mysql-bind 'buffer-length) 1024)
-              (setf (uffi:get-slot-value binding 'mysql-bind 'buffer)
-                    (uffi:allocate-foreign-object :unsigned-char 1024)))
-             (#.mysql-field-types#tiny
-              (setf (uffi:get-slot-value binding 'mysql-bind 'buffer)
-                    (uffi:allocate-foreign-object :byte)))
-             (#.mysql-field-types#short
-              (setf (uffi:get-slot-value binding 'mysql-bind 'buffer)
-                    (uffi:allocate-foreign-object :short)))
-             (#.mysql-field-types#long
-              (setf (uffi:get-slot-value binding 'mysql-bind 'buffer)
-                    ;; segfaults if supply :int on amd64
-                    (uffi:allocate-foreign-object :long)))
-             #+64bit
-             (#.mysql-field-types#longlong
-              (setf (uffi:get-slot-value binding 'mysql-bind 'buffer)
-                    (uffi:allocate-foreign-object :long)))
-             (#.mysql-field-types#float
-              (setf (uffi:get-slot-value binding 'mysql-bind 'buffer)
-                    (uffi:allocate-foreign-object :float)))
-             (#.mysql-field-types#double
-              (setf (uffi:get-slot-value binding 'mysql-bind 'buffer)
-                    (uffi:allocate-foreign-object :double)))
-             ((#.mysql-field-types#time #.mysql-field-types#date
-                                        #.mysql-field-types#datetime #.mysql-field-types#timestamp)
-              (uffi:allocate-foreign-object 'mysql-time))
-             (t
-              (error "mysql type ~D not supported." type)))))
        
-       (unless (zerop (mysql-stmt-bind-result stmt output-bind))
-         (error 'sql-database-error
-                :error-id (mysql-stmt-errno stmt)
-                :message  (uffi:convert-from-cstring
-                           (mysql-stmt-error stmt))))
+       (print 'b)
+       (unless (uffi:null-pointer-p rs)
+         (setq field-vec (mysql-fetch-fields rs)
+               num-fields (mysql-num-fields rs)
+               is-null-ptr (uffi:allocate-foreign-object :byte num-fields)
+               output-bind (uffi:allocate-foreign-object 'mysql-bind num-fields)
+               length-ptr (uffi:allocate-foreign-object :unsigned-long num-fields))
+         (dotimes (i num-fields)
+           (declare (fixnum i))
+           (let* ((field (uffi:deref-array field-vec '(:array mysql-field) i))
+                  (type (uffi:get-slot-value field 'mysql-field 'type))
+                  (binding (uffi:deref-array output-bind '(:array mysql-bind) i)))
+             (setf (uffi:get-slot-value binding 'mysql-bind 'buffer-type) type)
+             
+             (setf (uffi:get-slot-value binding 'mysql-bind 'buffer-length) 0)
+             (setf (uffi:get-slot-value binding 'mysql-bind 'is-null) 
+               (+ i (uffi:pointer-address is-null-ptr)))
+             (setf (uffi:get-slot-value binding 'mysql-bind 'length) 
+               (+ (* i 8) (uffi:pointer-address length-ptr)))
+             
+             (case type
+               ((#.mysql-field-types#var-string #.mysql-field-types#string
+                 #.mysql-field-types#tiny-blob #.mysql-field-types#blob
+                 #.mysql-field-types#medium-blob #.mysql-field-types#long-blob)
+                (setf (uffi:get-slot-value binding 'mysql-bind 'buffer-length) 1024)
+                (setf (uffi:get-slot-value binding 'mysql-bind 'buffer)
+                  (uffi:allocate-foreign-object :unsigned-char 1024)))
+               (#.mysql-field-types#tiny
+                (setf (uffi:get-slot-value binding 'mysql-bind 'buffer)
+                  (uffi:allocate-foreign-object :byte)))
+               (#.mysql-field-types#short
+                (setf (uffi:get-slot-value binding 'mysql-bind 'buffer)
+                  (uffi:allocate-foreign-object :short)))
+               (#.mysql-field-types#long
+                (setf (uffi:get-slot-value binding 'mysql-bind 'buffer)
+                  ;; segfaults if supply :int on amd64
+                  (uffi:allocate-foreign-object :long)))
+               #+64bit
+               (#.mysql-field-types#longlong
+                (setf (uffi:get-slot-value binding 'mysql-bind 'buffer)
+                  (uffi:allocate-foreign-object :long)))
+               (#.mysql-field-types#float
+                (setf (uffi:get-slot-value binding 'mysql-bind 'buffer)
+                  (uffi:allocate-foreign-object :float)))
+               (#.mysql-field-types#double
+                (setf (uffi:get-slot-value binding 'mysql-bind 'buffer)
+                  (uffi:allocate-foreign-object :double)))
+               ((#.mysql-field-types#time #.mysql-field-types#date
+                 #.mysql-field-types#datetime #.mysql-field-types#timestamp)
+                (uffi:allocate-foreign-object 'mysql-time))
+               (t
+                (error "mysql type ~D not supported." type)))))
+       
+         (unless (zerop (mysql-stmt-bind-result stmt output-bind))
+           (mysql-stmt-close stmt)
+           (error 'sql-database-error
+                  :error-id (mysql-stmt-errno stmt)
+                  :message  (uffi:convert-from-cstring
+                             (mysql-stmt-error stmt)))))
        
        (make-instance 'mysql-stmt
-                      :database database
-                      :stmt stmt
-                      :num-fields num-fields
-                      :input-bind input-bind
-                      :output-bind output-bind
-                      :result-set rs
-                      :result-types result-types
-                      :length-ptr length-ptr
-                      :is-null-ptr is-null-ptr
-                      :types mysql-types
-                      :field-names field-names)))))
+         :database database
+         :stmt stmt
+         :num-fields num-fields
+         :input-bind input-bind
+         :output-bind output-bind
+         :result-set rs
+         :result-types result-types
+         :length-ptr length-ptr
+         :is-null-ptr is-null-ptr
+         :types mysql-types
+         :field-names field-names)))))
 
 #+mysql-client-v4.1
 (defmethod database-bind-parameter ((stmt mysql-stmt) position value)
@@ -579,9 +591,11 @@
     (setf (uffi:get-slot-value binding 'mysql-bind 'length) 0)
     (cond
      ((null value)
-      (setf (uffi:deref-array (is-null-ptr stmt) '(:array :byte) (1- position)) 1))
+      (when (is-null-ptr stmt)
+       (setf (uffi:deref-array (is-null-ptr stmt) '(:array :byte) (1- position)) 1)))
      (t
-      (setf (uffi:deref-array (is-null-ptr stmt) '(:array :byte) (1- position)) 0)
+      (when (is-null-ptr stmt)
+       (setf (uffi:deref-array (is-null-ptr stmt) '(:array :byte) (1- position)) 0))
       (case type
        (#.mysql-field-types#long
         (setf (uffi:get-slot-value binding 'mysql-bind 'buffer) value))
@@ -592,11 +606,12 @@
 #+mysql-client-v4.1
 (defmethod database-run-prepared ((stmt mysql-stmt))
   (print 'a1)
-  (unless (zerop (mysql-stmt-bind-param (stmt stmt) (input-bind stmt)))
-    (error 'sql-database-error
-          :error-id (mysql-stmt-errno (stmt stmt))
-          :message  (uffi:convert-from-cstring
-                     (mysql-stmt-error (stmt stmt)))))
+  (when (input-bind stmt)
+    (unless (zerop (mysql-stmt-bind-param (stmt stmt) (input-bind stmt)))
+      (error 'sql-database-error
+            :error-id (mysql-stmt-errno (stmt stmt))
+            :message  (uffi:convert-from-cstring
+                       (mysql-stmt-error (stmt stmt))))))
   (print 'a2)
   (unless (zerop (mysql-stmt-execute (stmt stmt)))
     (error 'sql-database-error
@@ -653,7 +668,7 @@
                          (day (uffi:get-slot-value buffer 'mysql-time 'mysql::day))
                          (hour (uffi:get-slot-value buffer 'mysql-time 'mysql::hour))
                          (minute (uffi:get-slot-value buffer 'mysql-time 'mysql::minute))
-                         (second (uffi:get-slot-value buffer 'mysql-time 'mysql::second)))
+                 (second (uffi:get-slot-value buffer 'mysql-time 'mysql::second)))
                      (db-timestring
                       (make-time :year year :month month :day day :hour hour
                                  :minute minute :second second))))

diff --git a/db-mysql/mysql.c b/db-mysql/mysql.c
index af359c670ce481996ea9ba03214fd0b353fd9ca9..d1bb084a7bf898eadab6a43683c89c9bd6d4dfd7 100644 (file)
--- a/db-mysql/mysql.c
+++ b/db-mysql/mysql.c
@@ -127,11 +127,11 @@ allocate_bind (unsigned int n)
 
 DLLEXPORT
 void
-bind_param (MYSQL_BIND* bind, unsigned int n, unsigned long length, unsigned short is_null, 
+bind_param (MYSQL_BIND bind[], unsigned int n, unsigned long length, unsigned short is_null, 
           void* buffer, unsigned short buffer_type, unsigned long buffer_length)
 {
-  bind[n].length = length;
-  bind[n].is_null = is_null;
+  *bind[n].length = length;
+  *bind[n].is_null = is_null;
   bind[n].buffer = buffer;
   bind[n].buffer_type = buffer_type;
   bind[n].buffer_length = buffer_length;

diff --git a/sql/base-classes.lisp b/sql/base-classes.lisp
index 87833fc3bf4ccae1145cb867a358a9a904684a03..8e0cc496a5e7c4b0714dddc9b4e17e14fa7c0aa2 100644 (file)
--- a/sql/base-classes.lisp
+++ b/sql/base-classes.lisp
@@ -50,7 +50,8 @@ are a list of ACTION specified for table and any cached value of list-attributes
            (if (slot-boundp object 'name)
                (database-name object)
              "<unbound>")
-           (database-state object))))
+           (database-state object)))
+  object)
 
 (setf (documentation 'database-name 'function)
       "Returns the name of a database.")

diff --git a/sql/expressions.lisp b/sql/expressions.lisp
index bcf1383189ff83a8c3ef47ce4a83ef4a674b6462..3a2532aafbb18e8c8e8d7ef502583deb42ab50a9 100644 (file)
--- a/sql/expressions.lisp
+++ b/sql/expressions.lisp
@@ -67,7 +67,8 @@
 (defmethod print-object ((self %sql-expression) stream)
   (print-unreadable-object
    (self stream :type t)
-   (write-string (sql-output self) stream)))
+   (write-string (sql-output self) stream))
+  self)
 
 ;; For straight up strings
 
@@ -91,7 +92,8 @@
 (defmethod print-object ((ident sql) stream)
   (format stream "#<~S \"~A\">"
           (type-of ident)
-          (sql-output ident nil)))
+          (sql-output ident nil))
+  ident)
 
 ;; For SQL Identifiers of generic type
 

diff --git a/sql/fdml.lisp b/sql/fdml.lisp
index 943a1577ccf3538e50261e4db344d9029706cff3..9b0e8b75a50e28dac3e968e90c6c04b7c87cc4d5 100644 (file)
--- a/sql/fdml.lisp
+++ b/sql/fdml.lisp
@@ -451,6 +451,7 @@ A type can be
   :int
   :double
   :null
+  (:blob n)
   (:string n)
 "
   (unless (db-type-has-prepared-stmt? (database-type database))

diff --git a/sql/ooddl.lisp b/sql/ooddl.lisp
index 79f6186a65b55caeebd30eef9575033717a4830b..3ec173a40576e7534e8145d67791322ef7824660 100644 (file)
--- a/sql/ooddl.lisp
+++ b/sql/ooddl.lisp
@@ -20,11 +20,6 @@
     :db-kind :virtual))
   (:metaclass standard-db-class)
   (:documentation "Superclass for all CLSQL View Classes."))
-#+clisp
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (make-instance 'standard-db-object) ;; clisp requires a made object before can use in this file
-  #+nil  (finalize-inheritance (find-class 'standard-db-object)) ;; this is not sufficient
-  )
 
 (defparameter *default-string-length* 255
   "The length of a string which does not have a user-specified length.")