call bug with a reproduction case of the error.
All result sets from a mysql query are now returned as values EG:
rows0 names0 rows1 names1 ...
fix UnwashedMeme/clsql#4
Ryan Davis, Nathan Bird, & Russ Tyndall (sponsored by http://www.acceleration.net/programming/)
Victor (vityok@github), sqlite3 backend updates and clsql_uffi long-long support
Aaron Burrow, clsql_uffi unsigned integer bugs
+Ilya Khaprov deadtrickster@github - mysql backend stored-procedure / multiple result set support
+2014-07-29 Russ Tyndall <russ@acceleration.net>
+ * mysql-api.lisp, mysql-sql.lisp, test-connection.lisp
+ Added code to the mysql backend to pull all result sets as
+ multiple args. This fixes a bug in the mysql backend where trying
+ to query after executing a stored procedure (even on a pooled
+ connection) would raise an error about the connection being out of
+ sync. The second result set for the stored procedure seems to be
+ empty, so not sure why we need to iterate past it.
+
+ patch / bugreport provided by: Ilya Khaprov deadtrickster@github
+
2014-06-11 Russ Tyndall <russ@acceleration.net>
* databases.lisp, sqlite3-sql.lisp
Similar to and overriding the patch 2014-01-30 937a3d, adds a
:module "mysql"
:returning :void)
+(declaim (inline mysql-next-result))
+(uffi:def-function "mysql_next_result"
+ ((mysql mysql-mysql))
+ :module "mysql"
+ :returning :int)
+
(declaim (inline mysql-fetch-row))
(uffi:def-function "mysql_fetch_row"
((res mysql-mysql-res))
#:mysql-use-result
#:mysql-options
#:mysql-free-result
+ #:mysql-next-result
#:mysql-row-seek
#:mysql-field-seek
#:mysql-fetch-row
(defmethod database-query (query-expression (database mysql-database)
result-types field-names)
- (declare (optimize (speed 3) (safety 0) (debug 0) (space 0)))
- (let ((mysql-ptr (database-mysql-ptr database)))
- (declare (type mysql-mysql-ptr-def mysql-ptr))
+ (declare (optimize (speed 3)))
+ (let ((mysql-ptr (database-mysql-ptr database))
+ (results nil) ;; all the results and column-names in reverse-order
+ res-ptr (num-fields 0))
+ (declare (type mysql-mysql-ptr-def mysql-ptr res-ptr)
+ (fixnum num-fields))
(when (database-execute-command query-expression database)
- (let ((res-ptr (mysql-use-result mysql-ptr)))
- (declare (type mysql-mysql-res-ptr-def res-ptr))
- (if (and res-ptr (not (uffi:null-pointer-p res-ptr)))
- (unwind-protect
- (let ((num-fields (mysql-num-fields res-ptr)))
- (declare (fixnum num-fields))
- (setq result-types (canonicalize-types
- result-types res-ptr))
- (values
- (loop for row = (mysql-fetch-row res-ptr)
- for lengths = (mysql-fetch-lengths res-ptr)
- until (uffi:null-pointer-p row)
- collect
- (do* ((rlist (make-list num-fields))
- (i 0 (1+ i))
- (pos rlist (cdr pos)))
- ((= i num-fields) rlist)
- (declare (fixnum i))
- (setf (car pos)
- (convert-raw-field
- (uffi:deref-array row '(:array
- (* :unsigned-char))
- i)
- (nth i result-types)
- :length
- (uffi:deref-array lengths '(:array :unsigned-long) i)
- :encoding (encoding database)))))
- (when field-names
- (result-field-names res-ptr))))
- (mysql-free-result res-ptr))
- (unless (zerop (mysql-errno mysql-ptr))
- ;;from http://dev.mysql.com/doc/refman/5.0/en/mysql-field-count.html
- ;; if mysql_use_result or mysql_store_result return a null ptr,
- ;; we use a mysql_errno check to see if it had a problem or just
- ;; was a query without a result. If no error, just return nil.
- (error 'sql-database-data-error
- :database database
- :expression query-expression
- :error-id (mysql-errno mysql-ptr)
- :message (mysql-error-string mysql-ptr))))))))
+ (labels
+ ((get-row (row lengths)
+ "Pull a single row value from the results"
+ (loop for i from 0 below num-fields
+ collect
+ (convert-raw-field
+ (uffi:deref-array row '(:array (* :unsigned-char))
+ (the fixnum i))
+ (nth i result-types)
+ :length
+ (uffi:deref-array lengths '(:array :unsigned-long)
+ (the fixnum i))
+ :encoding (encoding database))))
+ (get-result-rows ()
+ "get all the rows out of the now valid results set"
+ (loop for row = (mysql-fetch-row res-ptr)
+ for lengths = (mysql-fetch-lengths res-ptr)
+ until (uffi:null-pointer-p row)
+ collect (get-row row lengths)))
+ (do-result-set ()
+ "for a mysql-ptr, grab and return a results set"
+ (setf res-ptr (mysql-use-result mysql-ptr))
+ (cond
+ ((or (null res-ptr) (uffi:null-pointer-p res-ptr))
+ (unless (zerop (mysql-errno mysql-ptr))
+ ;;from http://dev.mysql.com/doc/refman/5.0/en/mysql-field-count.html
+ ;; if mysql_use_result or mysql_store_result return a null ptr,
+ ;; we use a mysql_errno check to see if it had a problem or just
+ ;; was a query without a result. If no error, just return nil.
+ (error 'sql-database-data-error
+ :database database
+ :expression query-expression
+ :error-id (mysql-errno mysql-ptr)
+ :message (mysql-error-string mysql-ptr))))
+ (t
+ (unwind-protect
+ (progn (setf num-fields (mysql-num-fields res-ptr)
+ result-types (canonicalize-types
+ result-types res-ptr))
+ (push (get-result-rows) results)
+ (push (when field-names
+ (result-field-names res-ptr))
+ results))
+ (mysql-free-result res-ptr))))))
+
+ (loop
+ do (do-result-set)
+ while (let ((next (mysql-next-result mysql-ptr)))
+ (case next
+ (0 t) ;Successful and there are more results
+ (-1 nil) ;Successful and there are no more results
+ (t nil) ;errors
+ )))
+ (values-list (nreverse results))))))
(defstruct mysql-result-set
(defmethod database-query-result-set ((query-expression string)
(database mysql-database)
&key full-set result-types)
+ ;; TODO: REFACTOR THIS IN TERMS OF database-query or vice-versa
+ ;; This doesnt seem to free database results reliably, dont think
+ ;; that we should allow that particularly, OTOH, dont know how
+ ;; we support cursoring without it
(let ((mysql-ptr (database-mysql-ptr database)))
(declare (type mysql-mysql-ptr-def mysql-ptr))
(when (database-execute-command query-expression database)
(clsql-sys:query "DROP TABLE DUMMY"))
nil nil)
+(deftest :connection/pool/procedure-mysql
+ (unwind-protect
+ (progn
+ (clsql-sys:disconnect)
+ (test-connect :pool t)
+ (clsql-sys:execute-command
+ "CREATE PROCEDURE prTest () BEGIN SELECT 1 \"a\",2 \"b\",3 \"c\" ,4 \"d\" UNION SELECT 5,6,7,8; END;")
+ (clsql-sys:disconnect)
+ (test-connect :pool t)
+ (let ((p0 (clsql-sys:query "CALL prTest();" :flatp t)))
+ (clsql-sys:disconnect)
+ (test-connect :pool t)
+ (let ((p1 (clsql-sys:query "CALL prTest();" :flatp t)))
+ (clsql-sys:disconnect)
+ (test-connect :pool t)
+ (values p0 p1))))
+ (ignore-errors
+ (clsql-sys:execute-command "DROP PROCEDURE prTest;"))
+ (test-connect))
+ ((1 2 3 4) (5 6 7 8))
+ ((1 2 3 4) (5 6 7 8)))
+
))
(db-type-spec db-type (read-specs))))
(defun test-connect
- (db-type
- &key position pool
- (spec (find-test-connection-spec db-type :position position))
- )
- (setf *test-database-type* db-type)
- (setf *test-database-user*
+ (&key
+ (db-type *test-database-type* db-type-p)
+ position pool spec)
+ (unless spec
+ (setf spec
+ (or (and (null db-type-p) *test-connection-spec*)
+ (find-test-connection-spec db-type :position position))))
+ (when *default-database*
+ (disconnect :database *default-database*))
+ (setf *test-database-type* db-type
+ *test-database-user*
(cond
((member db-type '(:oracle :odbc :aodbc)) (second spec))
- ((>= (length spec) 3) (third spec))))
- (let ((*default-database* (clsql:connect
- spec
- :database-type db-type
- :make-default t
- :if-exists :old
- :pool pool)))
- (setf *test-database-underlying-type*
- (clsql-sys:database-underlying-type *default-database*))
- *default-database*))
+ ((>= (length spec) 3) (third spec)))
+ *test-connection-spec* spec
+ *default-database*
+ (clsql:connect
+ spec
+ :database-type db-type
+ :make-default t
+ :if-exists :old
+ :pool pool)
+ *test-database-underlying-type*
+ (clsql-sys:database-underlying-type *default-database*))
+ *default-database*)
(defun test-setup-database (db-type &key (spec (find-test-connection-spec db-type)))
(when (clsql-sys:db-backend-has-create/destroy-db? db-type)
(ignore-errors (create-database spec :database-type db-type)))
;; Connect to the database
- (test-connect db-type :spec spec)
-
+ (test-connect :db-type db-type :spec spec)
;; Ensure database is empty
(truncate-database :database *default-database*)
(let ((suites (intersection suites (default-suites))))
(when suites
(dolist (db-type +all-db-types+)
- (dolist (spec (db-type-spec db-type specs))
- (let ((*test-connection-spec* spec)
- (*test-connection-db-type* db-type))
- (format report-stream "~%~%Start Running Tests Against: ~A ~A~%~%" db-type (ignore-errors (subseq spec 0 2)))
- (do-tests-for-backend db-type spec :suites suites)
- (format report-stream "~%~%Finished Running Tests Against: ~A ~A~%~%" db-type (ignore-errors (subseq spec 0 2))))))))
+ (dolist (spec (db-type-spec db-type specs))
+ (format report-stream "~%~%Start Running Tests Against: ~A ~A~%~%" db-type (ignore-errors (subseq spec 0 2)))
+ (do-tests-for-backend db-type spec :suites suites)
+ (format report-stream "~%~%Finished Running Tests Against: ~A ~A~%~%" db-type (ignore-errors (subseq spec 0 2)))))))
(zerop *error-count*)))
(defun load-necessary-systems (specs)
(cond
((and (not (eql db-underlying-type :mysql))
(clsql-sys:in test :connection/query-command
- :basic/reallybigintegers/1))
+ :basic/reallybigintegers/1
+ :connection/pool/procedure-mysql))
(push (cons test "known to work only in MySQL as yet.") skip-tests))
((and (null (clsql-sys:db-type-has-views? db-underlying-type))
(clsql-sys:in test :fddl/view/1 :fddl/view/2 :fddl/view/3 :fddl/view/4))
(defun rapid-load (type &optional (position 0))
"Rapid load for interactive testing."
- (when *default-database*
- (disconnect :database *default-database*))
(test-setup-database
type
:spec (find-test-connection-spec type :position position))
(eq p (clsql-sys::find-or-create-connection-pool nil :dummy))
(eq p (clsql-sys::find-or-create-connection-pool :spec :dummy))))
nil T nil)
-
))
projects / clsql.git / commitdiff