r2892: *** empty log message ***
authorKevin M. Rosenberg <kevin@rosenberg.net>
Mon, 30 Sep 2002 01:57:32 +0000 (01:57 +0000)
committerKevin M. Rosenberg <kevin@rosenberg.net>
Mon, 30 Sep 2002 01:57:32 +0000 (01:57 +0000)
base/utils.cl
db-mysql/mysql-api.cl
db-mysql/mysql-sql.cl
debian/changelog
test-suite/tester-clsql.cl

index 93d5ecec303fb552394ccc67d1f0100aa8231680..1a34f78513a2c039b121b362e5a45ec15e2b2e3e 100644 (file)
@@ -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
 ;;;;
 
 (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))
index 59a395b0b46c570bfd3be372e4f2772e34202f6f..52b75a20f9b024a8f512d930cd89da309951baf0 100644 (file)
@@ -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))
 ;;; 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)
     (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
      :use-result))
 
 (uffi:def-struct mysql-mysql
-    (net mysql-net)
+    (net (:struct mysql-net))
   (connected-fd (* :char))
   (host (* :char))
   (user (* :char))
   (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))
   (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
 (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"
 (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"
index f3fb656fa6d7e85892575b2db88cd236202231b3..7edc058628352305f0592df99af801d14853d28b 100644 (file)
@@ -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
                                      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
            do
            (setf (car rest) 
                  (convert-raw-field
-                  (uffi:deref-array row 'mysql-row i)
+                  (uffi:deref-array row '(* (* :unsigned-char)) i)
                   types
                   i)))
       list)))
index 036f8df35468cfb836e48e5cc723b706085293b5..4ea927358e26a4091a918b52505ca39b730b6e0a 100644 (file)
@@ -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 <kmr@debian.org>  Fri, 27 Sep 2002 08:55:33 -0600
 
index 2cd2b029efa2057558a40048f0435f81e2dfe4de..ad121e4cba2596068f3388352c944decf3c34c2a 100644 (file)
@@ -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
 ;;;;
            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)))