From 57611810fb1cbfed971acd450000d8cac0d177b8 Mon Sep 17 00:00:00 2001 From: "Kevin M. Rosenberg" Date: Mon, 30 Sep 2002 01:57:32 +0000 Subject: [PATCH] r2892: *** empty log message *** --- base/utils.cl | 19 ++++++++++++++++--- db-mysql/mysql-api.cl | 37 +++++++++++++++++++------------------ db-mysql/mysql-sql.cl | 10 +++++----- debian/changelog | 3 ++- test-suite/tester-clsql.cl | 6 ++---- 5 files changed, 44 insertions(+), 31 deletions(-) diff --git a/base/utils.cl b/base/utils.cl index 93d5ece..1a34f78 100644 --- a/base/utils.cl +++ b/base/utils.cl @@ -7,7 +7,7 @@ ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Mar 2002 ;;;; -;;;; $Id: utils.cl,v 1.6 2002/09/17 17:16:43 kevin Exp $ +;;;; $Id: utils.cl,v 1.7 2002/09/30 01:57:32 kevin Exp $ ;;;; ;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg ;;;; @@ -30,9 +30,22 @@ (defun float-to-sql-string (num) "Convert exponent character for SQL" - (substitute #\e #\f (substitute #\e #\d (write-to-string num :readably t)))) + (let ((str (write-to-string num :readably t))) + (cond + ((find #\f str) + (substitute #\e #\f str)) + ((find #\d str) + (substitute #\e #\d str)) + ((find #\F str) + (substitute #\e #\F str)) + ((find #\D str) + (substitute #\e #\D str)) + ((find #\S str) + (substitute #\e #\S str)) + (t + str)))) -(defun sql-escape (identifier) + (defun sql-escape (identifier) "Change hyphens to underscores, ensure string" (let* ((unescaped (etypecase identifier (symbol (symbol-name identifier)) diff --git a/db-mysql/mysql-api.cl b/db-mysql/mysql-api.cl index 59a395b..52b75a2 100644 --- a/db-mysql/mysql-api.cl +++ b/db-mysql/mysql-api.cl @@ -8,7 +8,7 @@ ;;;; Original code by Pierre R. Mai ;;;; Date Started: Feb 2002 ;;;; -;;;; $Id: mysql-api.cl,v 1.1 2002/09/18 07:43:40 kevin Exp $ +;;;; $Id: mysql-api.cl,v 1.2 2002/09/30 01:57:32 kevin Exp $ ;;;; ;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg ;;;; and Copyright (c) 1999-2001 by Pierre R. Mai @@ -75,9 +75,9 @@ (size :unsigned-int)) (uffi:def-struct mysql-mem-root - (free (* mysql-used-mem)) - (used (* mysql-used-mem)) - (pre-alloc (* mysql-used-mem)) + (free (:struct-pointer mysql-used-mem)) + (used (:struct-pointer mysql-used-mem)) + (pre-alloc (:struct-pointer mysql-used-mem)) (min-alloc :unsigned-int) (block-size :unsigned-int) (error-handler :pointer-void)) @@ -121,6 +121,7 @@ ;;; MYSQL-ROWS (uffi:def-array-pointer mysql-row (* :unsigned-char)) + (uffi:def-array-pointer mysql-field-vector (* mysql-field)) (uffi:def-foreign-type mysql-field-offset :unsigned-int) @@ -129,14 +130,14 @@ (next :pointer-self) (data mysql-row)) -(uffi:def-foreign-type mysql-row-offset (* mysql-rows)) +(uffi:def-foreign-type mysql-row-offset (:struct-pointer mysql-rows))) (uffi:def-struct mysql-data (rows-high32 :unsigned-long) (rows-low32 :unsigned-long) (fields :unsigned-int) - (data (* mysql-rows)) - (alloc mysql-mem-root)) + (data (:struct-pointer mysql-rows)) + (alloc (:struct mysql-mem-root))) ;;; MYSQL (uffi:def-struct mysql-options @@ -175,7 +176,7 @@ :use-result)) (uffi:def-struct mysql-mysql - (net mysql-net) + (net (:struct mysql-net)) (connected-fd (* :char)) (host (* :char)) (user (* :char)) @@ -200,11 +201,11 @@ (extra-info-low32 :unsigned-long) (packet-length :unsigned-long) (status mysql-status) - (fields (* mysql-field)) - (field-alloc mysql-mem-root) + (fields (:struct-pointer mysql-field)) + (field-alloc (:struct mysql-mem-root)) (free-me mysql-bool) (reconnect mysql-bool) - (options mysql-options) + (options (:struct mysql-options)) (scramble-buff (:array :char 9)) (charset :pointer-void) (server-language :unsigned-int)) @@ -216,14 +217,14 @@ (row-count-low32 :unsigned-long) (field-count :unsigned-int) (current-field :unsigned-int) - (fields (* mysql-field)) - (data (* mysql-data)) - (data-cursor (* mysql-rows)) - (field-alloc mysql-mem-root) + (fields (:struct-pointer mysql-field)) + (data (:struct-pointer mysql-data)) + (data-cursor (:struct-pointer mysql-rows)) + (field-alloc (:struct mysql-mem-root)) (row mysql-row) (current-row mysql-row) (lengths (* :unsigned-long)) - (handle (* mysql-mysql)) + (handle (:struct-pointer mysql-mysql)) (eof mysql-bool)) ;;;; The Foreign C routines @@ -436,7 +437,7 @@ (uffi:def-function "mysql_fetch_row" ((res (* mysql-mysql-res))) :module "mysql" - :returning mysql-row) + :returning (* :unsigned-char)) (declaim (inline mysql-fetch-lengths)) (uffi:def-function "mysql_fetch_lengths" @@ -454,7 +455,7 @@ (uffi:def-function "mysql_fetch_fields" ((res (* mysql-mysql-res))) :module "mysql" - :returning mysql-field-vector) + :returning (* mysql-field)) (declaim (inline mysql-fetch-field-direct)) (uffi:def-function "mysql_fetch_field_direct" diff --git a/db-mysql/mysql-sql.cl b/db-mysql/mysql-sql.cl index f3fb656..7edc058 100644 --- a/db-mysql/mysql-sql.cl +++ b/db-mysql/mysql-sql.cl @@ -8,7 +8,7 @@ ;;;; Original code by Pierre R. Mai ;;;; Date Started: Feb 2002 ;;;; -;;;; $Id: mysql-sql.cl,v 1.1 2002/09/18 07:43:40 kevin Exp $ +;;;; $Id: mysql-sql.cl,v 1.2 2002/09/30 01:57:32 kevin Exp $ ;;;; ;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg ;;;; and Copyright (c) 1999-2001 by Pierre R. Mai @@ -47,7 +47,7 @@ (dotimes (i num-fields) (declare (fixnum i)) (let* ( (field (mysql-fetch-field-direct res-ptr i)) - #+ignore (field (uffi:deref-array field-vec 'mysql-field-vector i)) + #+ignore (field (uffi:deref-array field-vec '(* mysql-field) i)) (type (uffi:get-slot-value field 'mysql-field 'type))) (push (case type @@ -154,13 +154,13 @@ types num-fields res-ptr)) (unwind-protect - (loop for row = (mysql-fetch-row res-ptr) + (loop for row = (mysql-fetch-row res-ptr) until (uffi:null-pointer-p row) collect (loop for i from 0 below num-fields collect (convert-raw-field - (uffi:deref-array row 'mysql-row i) + (uffi:deref-array row '(* (* :unsigned-char)) i) types i))) (mysql-free-result res-ptr))) (error 'clsql-sql-error @@ -249,7 +249,7 @@ do (setf (car rest) (convert-raw-field - (uffi:deref-array row 'mysql-row i) + (uffi:deref-array row '(* (* :unsigned-char)) i) types i))) list))) diff --git a/debian/changelog b/debian/changelog index 036f8df..4ea9273 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,7 +1,8 @@ cl-sql (0.9.5-1) unstable; urgency=low * Fix defgeneric form in db-interfaces.cl - * Fix load-libraris call in postgresql-socket-api.cl + * Fix load-libraries call in postgresql-socket-api.cl + * OpenMCL is now supported -- Kevin M. Rosenberg Fri, 27 Sep 2002 08:55:33 -0600 diff --git a/test-suite/tester-clsql.cl b/test-suite/tester-clsql.cl index 2cd2b02..ad121e4 100644 --- a/test-suite/tester-clsql.cl +++ b/test-suite/tester-clsql.cl @@ -7,7 +7,7 @@ ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Mar 2002 ;;;; -;;;; $Id: tester-clsql.cl,v 1.8 2002/06/12 17:47:13 kevin Exp $ +;;;; $Id: tester-clsql.cl,v 1.9 2002/09/30 01:57:32 kevin Exp $ ;;;; ;;;; This file, part of CLSQL, is Copyright (c) 2002 by Kevin M. Rosenberg ;;;; @@ -223,9 +223,7 @@ t)))) (defun drop-test-table (db) - (clsql:execute-command "DROP TABLE test_clsql")) - - + (clsql:execute-command "DROP TABLE test_clsql" :database db)) (defun do-test () (let ((specs (read-specs))) -- 2.34.1