From 5691bb90517d7c565a141d131da76c3de1f8d566 Mon Sep 17 00:00:00 2001 From: "Kevin M. Rosenberg" Date: Thu, 8 Apr 2004 23:28:19 +0000 Subject: [PATCH] r8885: pre 2.3.4 --- ChangeLog | 12 ++++ base/basic-sql.lisp | 26 ++++----- base/db-interface.lisp | 20 +++---- classic-tests/tables.lisp | 34 +++++------ classic-tests/tests.lisp | 57 +++++++++---------- clsql-classic.asd | 6 +- clsql-tests.asd | 19 +++++-- clsql.asd | 10 +++- db-aodbc/aodbc-sql.lisp | 14 ++--- db-mysql/mysql-sql.lisp | 22 +++---- db-oracle/oracle-constants.lisp | 2 +- db-oracle/oracle-sql.lisp | 2 +- db-oracle/oracle.lisp | 2 +- .../postgresql-socket-api.lisp | 19 +++++-- .../postgresql-socket-sql.lisp | 17 +++--- db-postgresql/postgresql-api.lisp | 3 +- db-postgresql/postgresql-loader.lisp | 3 +- db-postgresql/postgresql-sql.lisp | 12 ++-- db-sqlite/sqlite-api-clisp.lisp | 8 +-- db-sqlite/sqlite-sql.lisp | 8 +-- debian/changelog | 6 ++ doc/ref_clsql.xml | 18 +++--- sql/basic-cmds.lisp | 32 ----------- sql/sql.lisp | 4 +- 24 files changed, 180 insertions(+), 176 deletions(-) delete mode 100644 sql/basic-cmds.lisp diff --git a/ChangeLog b/ChangeLog index 30f84de..af27bf2 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,15 @@ +08 Apr 2004 Kevin Rosenberg (kevin@rosenberg.net) + * Version 2.3.4 released + * db-mysql/mysql-sql.lisp: Fix array dereferencing + * classic-tests/tests.lisp: Fix package name of + number-to-sql-string. + * clsql.asd/clsql-tests.asd: Add support for asdf:test-op + * Finish renaming of :types keyword to :result-types for + greater CommonSQL compatibility, including documentation + * sql/basic-cmds.lisp: Remove obsolete file + * All tests for clsql-classic now finish correctly on + Allegro, Lispworks, CMUCL, SBCL + 08 Apr 2004 Kevin Rosenberg (kevin@rosenberg.net) * Version 2.3.3 released * Fixes for sequences on mysql and sqlite [Marcus Pearce] diff --git a/base/basic-sql.lisp b/base/basic-sql.lisp index 4610c42..61a932e 100644 --- a/base/basic-sql.lisp +++ b/base/basic-sql.lisp @@ -61,7 +61,7 @@ pair.")) (defmacro do-query (((&rest args) query-expression - &key (database '*default-database*) (types nil)) + &key (database '*default-database*) (result-types nil)) &body body) "Repeatedly executes BODY within a binding of ARGS on the attributes of each record resulting from QUERY. The return value is determined by @@ -74,7 +74,7 @@ the result of executing BODY. The default value of DATABASE is `(let ((,db ,database)) (multiple-value-bind (,result-set ,columns) (database-query-result-set ,query-expression ,db - :full-set nil :types ,types) + :full-set nil :result-types ,result-types) (when ,result-set (unwind-protect (do ((,row (make-list ,columns))) @@ -86,7 +86,7 @@ the result of executing BODY. The default value of DATABASE is (defun map-query (output-type-spec function query-expression &key (database *default-database*) - (types nil)) + (result-types nil)) "Map the function over all tuples that are returned by the query in query-expression. The results of the function are collected as specified in output-type-spec and returned like in MAP." @@ -94,21 +94,21 @@ specified in output-type-spec and returned like in MAP." `(if (atom ,type) ,type (car ,type)))) (case (type-specifier-atom output-type-spec) ((nil) - (map-query-for-effect function query-expression database types)) + (map-query-for-effect function query-expression database result-types)) (list - (map-query-to-list function query-expression database types)) + (map-query-to-list function query-expression database result-types)) ((simple-vector simple-string vector string array simple-array bit-vector simple-bit-vector base-string simple-base-string) - (map-query-to-simple output-type-spec function query-expression database types)) + (map-query-to-simple output-type-spec function query-expression database result-types)) (t (funcall #'map-query (cmucl-compat:result-type-or-lose output-type-spec t) - function query-expression :database database :types types))))) + function query-expression :database database :result-types result-types))))) -(defun map-query-for-effect (function query-expression database types) +(defun map-query-for-effect (function query-expression database result-types) (multiple-value-bind (result-set columns) (database-query-result-set query-expression database :full-set nil - :types types) + :result-types result-types) (when result-set (unwind-protect (do ((row (make-list columns))) @@ -117,10 +117,10 @@ specified in output-type-spec and returned like in MAP." (apply function row)) (database-dump-result-set result-set database))))) -(defun map-query-to-list (function query-expression database types) +(defun map-query-to-list (function query-expression database result-types) (multiple-value-bind (result-set columns) (database-query-result-set query-expression database :full-set nil - :types types) + :result-types result-types) (when result-set (unwind-protect (let ((result (list nil))) @@ -132,10 +132,10 @@ specified in output-type-spec and returned like in MAP." (database-dump-result-set result-set database))))) -(defun map-query-to-simple (output-type-spec function query-expression database types) +(defun map-query-to-simple (output-type-spec function query-expression database result-types) (multiple-value-bind (result-set columns rows) (database-query-result-set query-expression database :full-set t - :types types) + :result-types result-types) (when result-set (unwind-protect (if rows diff --git a/base/db-interface.lisp b/base/db-interface.lisp index 93e3973..2904f3d 100644 --- a/base/db-interface.lisp +++ b/base/db-interface.lisp @@ -56,12 +56,12 @@ was called with the connection-spec.")) (signal-nodb-error database)) (:documentation "Internal generic implementation of disconnect.")) -(defgeneric database-query (query-expression database types) - (:method (query-expression (database closed-database) types) - (declare (ignore query-expression types)) +(defgeneric database-query (query-expression database result-types) + (:method (query-expression (database closed-database) result-types) + (declare (ignore query-expression result-types)) (signal-closed-database-error database)) - (:method (query-expression (database t) types) - (declare (ignore query-expression types)) + (:method (query-expression (database t) result-types) + (declare (ignore query-expression result-types)) (signal-nodb-error database)) (:documentation "Internal generic implementation of query.")) @@ -77,13 +77,13 @@ was called with the connection-spec.")) ;;; Mapping and iteration (defgeneric database-query-result-set - (query-expression database &key full-set types) - (:method (query-expression (database closed-database) &key full-set types) - (declare (ignore query-expression full-set types)) + (query-expression database &key full-set result-types) + (:method (query-expression (database closed-database) &key full-set result-types) + (declare (ignore query-expression full-set result-types)) (signal-closed-database-error database) (values nil nil nil)) - (:method (query-expression (database t) &key full-set types) - (declare (ignore query-expression full-set types)) + (:method (query-expression (database t) &key full-set result-types) + (declare (ignore query-expression full-set result-types)) (signal-nodb-error database) (values nil nil nil)) (:documentation diff --git a/classic-tests/tables.lisp b/classic-tests/tables.lisp index 48fe295..44d7ad2 100644 --- a/classic-tests/tables.lisp +++ b/classic-tests/tables.lisp @@ -76,29 +76,29 @@ (unwind-protect (progn (create-test-table db) - (dolist (row (query "select * from test_clsql" :database db :types :auto)) + (dolist (row (query "select * from test_clsql" :database db :result-types :auto)) (test-table-row row :auto type)) - (dolist (row (query "select * from test_clsql" :database db :types nil)) + (dolist (row (query "select * from test_clsql" :database db :result-types nil)) (test-table-row row nil type)) (loop for row across (map-query 'vector #'list "select * from test_clsql" - :database db :types :auto) + :database db :result-types :auto) do (test-table-row row :auto type)) (loop for row across (map-query 'vector #'list "select * from test_clsql" - :database db :types nil) + :database db :result-types nil) do (test-table-row row nil type)) (loop for row in (map-query 'list #'list "select * from test_clsql" - :database db :types nil) + :database db :result-types nil) do (test-table-row row nil type)) (loop for row in (map-query 'list #'list "select * from test_clsql" - :database db :types :auto) + :database db :result-types :auto) do (test-table-row row :auto type)) (test (map-query nil #'list "select * from test_clsql" - :database db :types :auto) + :database db :result-types :auto) nil :fail-info "Expected NIL result from map-query nil") (do-query ((int float bigint str) "select * from test_clsql") (test-table-row (list int float bigint str) nil type)) - (do-query ((int float bigint str) "select * from test_clsql" :types :auto) + (do-query ((int float bigint str) "select * from test_clsql" :result-types :auto) (test-table-row (list int float bigint str) :auto type)) (drop-test-table db) ) @@ -211,7 +211,7 @@ i (clsql:number-to-sql-string (sqrt i)) (clsql:number-to-sql-string (sqrt i))) db)) - (let ((res (clsql-mysql::database-query-result-set "select * from test_clsql" db :full-set t :types nil))) + (let ((res (clsql-mysql::database-query-result-set "select * from test_clsql" db :full-set t :result-types nil))) (setq result (mysql:mysql-num-rows (clsql-mysql::mysql-result-set-res-ptr res))) (clsql-mysql::database-dump-result-set res db)) @@ -233,29 +233,29 @@ (unwind-protect (progn (create-test-table db) - (dolist (row (query "select * from test_clsql" :database db :types :auto)) + (dolist (row (query "select * from test_clsql" :database db :result-types :auto)) (test-table-row row :auto type)) - (dolist (row (query "select * from test_clsql" :database db :types nil)) + (dolist (row (query "select * from test_clsql" :database db :result-types nil)) (test-table-row row nil type)) (loop for row across (map-query 'vector #'list "select * from test_clsql" - :database db :types :auto) + :database db :result-types :auto) do (test-table-row row :auto type)) (loop for row across (map-query 'vector #'list "select * from test_clsql" - :database db :types nil) + :database db :result-types nil) do (test-table-row row nil type)) (loop for row in (map-query 'list #'list "select * from test_clsql" - :database db :types nil) + :database db :result-types nil) do (test-table-row row nil type)) (loop for row in (map-query 'list #'list "select * from test_clsql" - :database db :types :auto) + :database db :result-types :auto) do (test-table-row row :auto type)) (test (map-query nil #'list "select * from test_clsql" - :database db :types :auto) + :database db :result-types :auto) nil :fail-info "Expected NIL result from map-query nil") (do-query ((int float bigint str) "select * from test_clsql") (test-table-row (list int float bigint str) nil type)) - (do-query ((int float bigint str) "select * from test_clsql" :types :auto) + (do-query ((int float bigint str) "select * from test_clsql" :result-types :auto) (test-table-row (list int float bigint str) :auto type)) (drop-test-table db) ) diff --git a/classic-tests/tests.lisp b/classic-tests/tests.lisp index 2087617..3faed38 100644 --- a/classic-tests/tests.lisp +++ b/classic-tests/tests.lisp @@ -83,29 +83,29 @@ (unwind-protect (progn (create-test-table db) - (dolist (row (query "select * from test_clsql" :database db :types :auto)) + (dolist (row (query "select * from test_clsql" :database db :result-types :auto)) (test-table-row row :auto type)) - (dolist (row (query "select * from test_clsql" :database db :types nil)) + (dolist (row (query "select * from test_clsql" :database db :result-types nil)) (test-table-row row nil type)) (loop for row across (map-query 'vector #'list "select * from test_clsql" - :database db :types :auto) + :database db :result-types :auto) do (test-table-row row :auto type)) (loop for row across (map-query 'vector #'list "select * from test_clsql" - :database db :types nil) + :database db :result-types nil) do (test-table-row row nil type)) (loop for row in (map-query 'list #'list "select * from test_clsql" - :database db :types nil) + :database db :result-types nil) do (test-table-row row nil type)) (loop for row in (map-query 'list #'list "select * from test_clsql" - :database db :types :auto) + :database db :result-types :auto) do (test-table-row row :auto type)) (test (map-query nil #'list "select * from test_clsql" - :database db :types :auto) + :database db :result-types :auto) nil :fail-info "Expected NIL result from map-query nil") (do-query ((int float bigint str) "select * from test_clsql") (test-table-row (list int float bigint str) nil type)) - (do-query ((int float bigint str) "select * from test_clsql" :types :auto) + (do-query ((int float bigint str) "select * from test_clsql" :result-types :auto) (test-table-row (list int float bigint str) :auto type)) (drop-test-table db) ) @@ -120,13 +120,13 @@ (unwind-protect (progn (create-test-table db) - (dolist (row (query "select * from test_clsql" :database db :types nil)) + (dolist (row (query "select * from test_clsql" :database db :result-types nil)) (test-table-row row nil type)) (loop for row across (map-query 'vector #'list "select * from test_clsql" - :database db :types nil) + :database db :result-types nil) do (test-table-row row nil type)) (loop for row in (map-query 'list #'list "select * from test_clsql" - :database db :types nil) + :database db :result-types nil) do (test-table-row row nil type)) (do-query ((int float bigint str) "select * from test_clsql") @@ -146,10 +146,10 @@ (dotimes (i 10) (clsql-mysql::database-execute-command (format nil "INSERT INTO test_clsql VALUES (~d,~d,'~a')" - i (clsql:number-to-sql-string (sqrt i)) - (clsql:number-to-sql-string (sqrt i))) + i (clsql-base:number-to-sql-string (sqrt i)) + (clsql-base:number-to-sql-string (sqrt i))) db)) - (let ((res (clsql-mysql::database-query-result-set "select * from test_clsql" db :full-set t :types nil))) + (let ((res (clsql-mysql::database-query-result-set "select * from test_clsql" db :full-set t :result-types nil))) (test (mysql:mysql-num-rows (clsql-mysql::mysql-result-set-res-ptr res)) 10 @@ -182,9 +182,9 @@ (clsql:execute-command (format nil "INSERT INTO test_clsql VALUES (~a,~a,~a,'~a')" test-int - (number-to-sql-string test-flt) + (clsql-base:number-to-sql-string test-flt) (transform-bigint-1 test-int) - (number-to-sql-string test-flt) + (clsql-base:number-to-sql-string test-flt) ) :database db)))) @@ -254,17 +254,16 @@ (clsql:execute-command "DROP TABLE test_clsql" :database db)) (defun run-tests () - (let ((specs (read-specs))) - (unless specs - (warn "Not running test because test configuration file is missing") - (return-from run-tests :skipped)) - (with-tests (:name "CLSQL") - (mysql-low-level specs) - (mysql-table-test specs) - (pgsql-table-test specs) - (pgsql-socket-table-test specs) - (aodbc-table-test specs) - (sqlite-table-test specs) + (let ((specs (read-specs))) + (unless specs + (warn "Not running test because test configuration file is missing") + (return-from run-tests :skipped)) + (with-tests (:name "CLSQL") + (mysql-low-level specs) + (mysql-table-test specs) + (pgsql-table-test specs) + (pgsql-socket-table-test specs) + (aodbc-table-test specs) + (sqlite-table-test specs) )) - t) - + t) diff --git a/clsql-classic.asd b/clsql-classic.asd index d104388..a700cfd 100644 --- a/clsql-classic.asd +++ b/clsql-classic.asd @@ -38,6 +38,6 @@ (:file "functional" :depends-on ("sql")))))) #+(or allegro lispworks cmu sbcl openmcl mcl scl) -(defmethod perform ((o test-op) (c (eql (find-system :clsql-classic)))) - (oos 'load-op 'clsql-classic-tests) - (oos 'test-op 'clsql-classic-tests)) +(defmethod perform ((o test-op) (c (eql (find-system 'clsql-classic)))) + (operate 'load-op 'clsql-classic-tests) + (operate 'test-op 'clsql-classic-tests)) diff --git a/clsql-tests.asd b/clsql-tests.asd index d48b25e..7a7d6d9 100644 --- a/clsql-tests.asd +++ b/clsql-tests.asd @@ -2,10 +2,10 @@ ;;;; ************************************************************************* ;;;; FILE IDENTIFICATION ;;;; -;;;; File: clsql-tests.asd -;;;; Author: Marcus Pearce -;;;; Created: 30/03/2004 -;;;; Updated: <04/04/2004 12:34:41 marcusp> +;;;; File: clsql-tests.asd +;;;; Authors: Marcus Pearce and Kevin Rosenberg +;;;; Created: 30/03/2004 +;;;; Updated: $Id$ ;;;; ;;;; $Id$ ;;;; @@ -16,8 +16,10 @@ ;;;; ====================================================================== (in-package #:cl-user) +(defpackage #:clsql-classic-tests-system (:use #:asdf #:cl)) +(in-package #:clsql-classic-tests-system) -(asdf:defsystem clsql-tests +(defsystem clsql-tests :name "CLSQL Tests" :author "" :maintainer "" @@ -36,3 +38,10 @@ (:file "test-ooddl") (:file "test-oodml") (:file "test-syntax"))))) + +(defmethod perform ((o test-op) (c (eql (find-system 'clsql-tests)))) + (error "Automated performing of test-op is not yet supported.") + #+ignore + (unless (funcall (intern (symbol-name '#:run-tests) + (find-package '#:clsql-tests))) + (error "test-op failed"))) diff --git a/clsql.asd b/clsql.asd index f74e884..f7c9d36 100644 --- a/clsql.asd +++ b/clsql.asd @@ -14,7 +14,11 @@ ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL. ;;;; ************************************************************************* -(asdf:defsystem #:clsql +(in-package #:cl-user) +(defpackage #:clsql-system (:use #:asdf #:cl)) +(in-package #:clsql-system) + +(defsystem #:clsql :name "CLSQL" :author "" :maintainer "" @@ -50,3 +54,7 @@ a functional and an object oriented interface." (:file "objects" :depends-on ("metaclasses"))) :depends-on (:functional)))))) + +(defmethod perform ((o test-op) (c (eql (find-system 'clsql)))) + (operate 'load-op 'clsql-tests) + (operate 'test-op 'clsql-tests)) diff --git a/db-aodbc/aodbc-sql.lisp b/db-aodbc/aodbc-sql.lisp index 5647211..24a6e47 100644 --- a/db-aodbc/aodbc-sql.lisp +++ b/db-aodbc/aodbc-sql.lisp @@ -16,9 +16,7 @@ ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL. ;;;; ************************************************************************* -(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0))) -(in-package :clsql-aodbc) - +(in-package #:clsql-aodbc) ;; interface foreign library loading routines (defmethod clsql-base-sys:database-type-library-loaded ((database-type (eql :aodbc))) @@ -72,11 +70,11 @@ (setf (database-aodbc-conn database) nil) t) -(defmethod database-query (query-expression (database aodbc-database) types) +(defmethod database-query (query-expression (database aodbc-database) result-types) #+aodbc-v2 (handler-case (dbi:sql query-expression :db (database-aodbc-conn database) - :types types) + :types result-types) (error () (error 'clsql-sql-error :database database @@ -103,7 +101,7 @@ (defmethod database-query-result-set ((query-expression string) (database aodbc-database) - &key full-set types) + &key full-set result-types) #+aodbc-v2 (handler-case (multiple-value-bind (query column-names) @@ -112,11 +110,11 @@ :row-count nil :column-names t :query t - :types types + :types result-types ) (values (make-aodbc-result-set :query query :full-set full-set - :types types) + :types result-types) (length column-names) nil ;; not able to return number of rows with aodbc )) diff --git a/db-mysql/mysql-sql.lisp b/db-mysql/mysql-sql.lisp index 75b81a8..0f50e6c 100644 --- a/db-mysql/mysql-sql.lisp +++ b/db-mysql/mysql-sql.lisp @@ -124,7 +124,7 @@ (defmethod database-query (query-expression (database mysql-database) - types) + result-types) (declare (optimize (speed 3) (safety 0) (debug 0) (space 0))) (let ((mysql-ptr (database-mysql-ptr database))) (uffi:with-cstring (query-native query-expression) @@ -135,8 +135,8 @@ (unwind-protect (let ((num-fields (mysql-num-fields res-ptr))) (declare (fixnum num-fields)) - (setq types (canonicalize-types - types num-fields + (setq result-types (canonicalize-types + result-types num-fields res-ptr)) (loop for row = (mysql-fetch-row res-ptr) for lengths = (mysql-fetch-lengths res-ptr) @@ -152,7 +152,7 @@ (uffi:deref-array row '(:array (* :unsigned-char)) i) - types i + result-types i (uffi:deref-array lengths '(:array :unsigned-long) i)))))) (mysql-free-result res-ptr)) @@ -169,7 +169,7 @@ #+ignore (defmethod database-query (query-expression (database mysql-database) - types) + result-types) (declare (optimize (speed 3) (safety 0) (debug 0) (space 0))) (let ((mysql-ptr (database-mysql-ptr database))) (uffi:with-cstring (query-native query-expression) @@ -179,8 +179,8 @@ (unwind-protect (let ((num-fields (mysql-num-fields res-ptr))) (declare (fixnum num-fields)) - (setq types (canonicalize-types - types num-fields + (setq result-types (canonicalize-types + result-types num-fields res-ptr)) (loop for row = (mysql-fetch-row res-ptr) until (uffi:null-pointer-p row) @@ -191,7 +191,7 @@ (uffi:deref-array row '(:array (* :unsigned-char)) i) - types i)))) + result-types i)))) (mysql-free-result res-ptr)) (error 'clsql-sql-error :database database @@ -227,7 +227,7 @@ (defmethod database-query-result-set ((query-expression string) (database mysql-database) - &key full-set types) + &key full-set result-types) (uffi:with-cstring (query-native query-expression) (let ((mysql-ptr (database-mysql-ptr database))) (declare (type mysql-mysql-ptr-def mysql-ptr)) @@ -245,7 +245,7 @@ :full-set full-set :types (canonicalize-types - types num-fields + result-types num-fields res-ptr)))) (if full-set (values result-set @@ -285,7 +285,7 @@ (uffi:deref-array row '(:array (* :unsigned-char)) i) types i - (uffi:deref-array lengths :unsigned-long i)))) + (uffi:deref-array lengths '(:array :unsigned-long) i)))) list))) diff --git a/db-oracle/oracle-constants.lisp b/db-oracle/oracle-constants.lisp index ae139aa..02bf412 100644 --- a/db-oracle/oracle-constants.lisp +++ b/db-oracle/oracle-constants.lisp @@ -1,7 +1,7 @@ ;;; -*- Mode: Lisp -*- ;;; $Id$ -(in-package :clsql-oracle) +(in-package #:clsql-oracle) (defconstant +oci-default+ #x00) ; default value for parameters and attributes (defconstant +oci-threaded+ #x01) ; application is in threaded environment diff --git a/db-oracle/oracle-sql.lisp b/db-oracle/oracle-sql.lisp index 3a898e1..6b55836 100644 --- a/db-oracle/oracle-sql.lisp +++ b/db-oracle/oracle-sql.lisp @@ -8,7 +8,7 @@ ;;; ;;; derived from postgresql.lisp -(in-package :clsql-oracle) +(in-package #:clsql-oracle) (defmethod database-initialize-database-type ((database-type (eql :oracle))) diff --git a/db-oracle/oracle.lisp b/db-oracle/oracle.lisp index a243c58..94c933d 100644 --- a/db-oracle/oracle.lisp +++ b/db-oracle/oracle.lisp @@ -9,7 +9,7 @@ ;;; The present content of this file is orented specifically towards ;;; Oracle 8.0.5.1 under Linux, linking against libclntsh.so -(in-package :clsql-oracle) +(in-package #:clsql-oracle) ;; diff --git a/db-postgresql-socket/postgresql-socket-api.lisp b/db-postgresql-socket/postgresql-socket-api.lisp index 8e8cb3d..13ce8e9 100644 --- a/db-postgresql-socket/postgresql-socket-api.lisp +++ b/db-postgresql-socket/postgresql-socket-api.lisp @@ -29,8 +29,7 @@ ;;;; - Added field type processing -(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0))) -(in-package :postgresql-socket) +(in-package #:postgresql-socket) (uffi:def-enum pgsql-ftype ((:bytea 17) @@ -332,6 +331,15 @@ socket interface" :buffering :none :timeout *postgresql-server-socket-timeout*)) + +#+sbcl +(defun open-postgresql-socket-stream (host port) + (sb-sys:make-fd-stream + (open-postgresql-socket host port) + :input t :output t :element-type '(unsigned-byte 8) + :buffering :none + :timeout *postgresql-server-socket-timeout*)) + #+allegro (defun open-postgresql-socket-stream (host port) (etypecase host @@ -347,8 +355,7 @@ socket interface" (mp:with-timeout (*postgresql-server-socket-timeout* (error "connect failed")) (socket:make-socket :type :stream :address-family :internet :remote-port port :remote-host host - :connect :active :nodelay t)))) - )) + :connect :active :nodelay t)))))) #+lispworks (defun open-postgresql-socket-stream (host port) @@ -849,12 +856,12 @@ connection, if it is still open." (error 'postgresql-fatal-error :connection connection :message "Received garbled message from backend"))))))) -(defun run-query (connection query &optional (types nil)) +(defun run-query (connection query &optional (result-types nil)) (start-query-execution connection query) (multiple-value-bind (status cursor) (wait-for-query-results connection) (assert (eq status :cursor)) - (loop for row = (read-cursor-row cursor types) + (loop for row = (read-cursor-row cursor result-types) while row collect row finally diff --git a/db-postgresql-socket/postgresql-socket-sql.lisp b/db-postgresql-socket/postgresql-socket-sql.lisp index 5546017..7cb1eba 100644 --- a/db-postgresql-socket/postgresql-socket-sql.lisp +++ b/db-postgresql-socket/postgresql-socket-sql.lisp @@ -18,15 +18,14 @@ ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL. ;;;; ************************************************************************* -(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0))) -(in-package :cl-user) +(in-package #:cl-user) (defpackage :clsql-postgresql-socket - (:use :common-lisp :clsql-base-sys :postgresql-socket) + (:use #:common-lisp #:clsql-base-sys #:postgresql-socket) (:export #:postgresql-socket-database) (:documentation "This is the CLSQL socket interface to PostgreSQL.")) -(in-package :clsql-postgresql-socket) +(in-package #:clsql-postgresql-socket) ;; interface foreign library loading routines @@ -200,7 +199,7 @@ doesn't depend on UFFI." (close-postgresql-connection (database-connection database)) t) -(defmethod database-query (expression (database postgresql-socket-database) types) +(defmethod database-query (expression (database postgresql-socket-database) result-types) (let ((connection (database-connection database))) (with-postgresql-handlers (database expression) (start-query-execution connection expression) @@ -213,8 +212,8 @@ doesn't depend on UFFI." :expression expression :errno 'missing-result :error "Didn't receive result cursor for query.")) - (setq types (canonicalize-types types cursor)) - (loop for row = (read-cursor-row cursor types) + (setq result-types (canonicalize-types result-types cursor)) + (loop for row = (read-cursor-row cursor result-types) while row collect row finally @@ -267,7 +266,7 @@ doesn't depend on UFFI." (defmethod database-query-result-set ((expression string) (database postgresql-socket-database) - &key full-set types) + &key full-set result-types) (declare (ignore full-set)) (let ((connection (database-connection database))) (with-postgresql-handlers (database expression) @@ -284,7 +283,7 @@ doesn't depend on UFFI." (values (make-postgresql-socket-result-set :done nil :cursor cursor - :types (canonicalize-types types cursor)) + :types (canonicalize-types result-types cursor)) (length (postgresql-cursor-fields cursor))))))) (defmethod database-dump-result-set (result-set diff --git a/db-postgresql/postgresql-api.lisp b/db-postgresql/postgresql-api.lisp index 06aedc6..69719da 100644 --- a/db-postgresql/postgresql-api.lisp +++ b/db-postgresql/postgresql-api.lisp @@ -18,8 +18,7 @@ ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL. ;;;; ************************************************************************* -(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0))) -(in-package :postgresql) +(in-package #:postgresql) ;;;; This file implements as little of the FFI bindings to the diff --git a/db-postgresql/postgresql-loader.lisp b/db-postgresql/postgresql-loader.lisp index e46ec77..48dd433 100644 --- a/db-postgresql/postgresql-loader.lisp +++ b/db-postgresql/postgresql-loader.lisp @@ -16,8 +16,7 @@ ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL. ;;;; ************************************************************************* -(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0))) -(in-package :postgresql) +(in-package #:postgresql) (defvar *postgresql-supporting-libraries* '("crypt" "c") diff --git a/db-postgresql/postgresql-sql.lisp b/db-postgresql/postgresql-sql.lisp index 394c0d6..373d55c 100644 --- a/db-postgresql/postgresql-sql.lisp +++ b/db-postgresql/postgresql-sql.lisp @@ -141,7 +141,7 @@ (setf (database-conn-ptr database) nil) t) -(defmethod database-query (query-expression (database postgresql-database) types) +(defmethod database-query (query-expression (database postgresql-database) result-types) (let ((conn-ptr (database-conn-ptr database))) (declare (type pgsql-conn-def conn-ptr)) (uffi:with-cstring (query-native query-expression) @@ -158,8 +158,8 @@ nil) (#.pgsql-exec-status-type#tuples-ok (let ((num-fields (PQnfields result))) - (setq types - (canonicalize-types types num-fields + (setq result-types + (canonicalize-types result-types num-fields result)) (loop for tuple-index from 0 below (PQntuples result) collect @@ -168,7 +168,7 @@ (if (zerop (PQgetisnull result tuple-index i)) (convert-raw-field (PQgetvalue result tuple-index i) - types i) + result-types i) nil))))) (t (error 'clsql-sql-error @@ -218,7 +218,7 @@ (defmethod database-query-result-set ((query-expression string) (database postgresql-database) - &key full-set types) + &key full-set result-types) (let ((conn-ptr (database-conn-ptr database))) (declare (type pgsql-conn-def conn-ptr)) (uffi:with-cstring (query-native query-expression) @@ -237,7 +237,7 @@ :num-fields (PQnfields result) :num-tuples (PQntuples result) :types (canonicalize-types - types + result-types (PQnfields result) result)))) (if full-set diff --git a/db-sqlite/sqlite-api-clisp.lisp b/db-sqlite/sqlite-api-clisp.lisp index a8c18ff..7e57fa2 100644 --- a/db-sqlite/sqlite-api-clisp.lisp +++ b/db-sqlite/sqlite-api-clisp.lisp @@ -19,10 +19,10 @@ ;; $Id$ -(in-package :cl-user) +(in-package #:cl-user) -(defpackage :sqlite - (:use :common-lisp :ffi) +(defpackage #:sqlite + (:use #:common-lisp #:ffi) (:export ;;; Conditions #:sqlite-error @@ -348,4 +348,4 @@ ;;;; Mode: lisp ;;;; Syntax: ANSI-Common-Lisp ;;;; Package: sqlite -;;;; End: \ No newline at end of file +;;;; End: diff --git a/db-sqlite/sqlite-sql.lisp b/db-sqlite/sqlite-sql.lisp index 63edf07..805597b 100644 --- a/db-sqlite/sqlite-sql.lisp +++ b/db-sqlite/sqlite-sql.lisp @@ -73,8 +73,8 @@ :error (sqlite:sqlite-error-message err)))) t) -(defmethod database-query (query-expression (database sqlite-database) types) - (declare (ignore types)) ; SQLite is typeless! +(defmethod database-query (query-expression (database sqlite-database) result-types) + (declare (ignore result-types)) ; SQLite is typeless! (handler-case (multiple-value-bind (data row-n col-n) (sqlite:sqlite-get-table (sqlite-db database) query-expression) @@ -112,8 +112,8 @@ (n-col 0 :type fixnum)) (defmethod database-query-result-set - ((query-expression string) (database sqlite-database) &key full-set types) - (declare (ignore full-set types)) + ((query-expression string) (database sqlite-database) &key full-set result-types) + (declare (ignore full-set result-types)) (handler-case (let* ((vm (sqlite:sqlite-compile (sqlite-db database) query-expression)) diff --git a/debian/changelog b/debian/changelog index 043ac49..7ede4ea 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,3 +1,9 @@ +cl-sql (2.3.4-1) unstable; urgency=low + + * New upstream + + -- Kevin M. Rosenberg Thu, 8 Apr 2004 15:17:20 -0600 + cl-sql (2.3.3-1) unstable; urgency=low * New upstream diff --git a/doc/ref_clsql.xml b/doc/ref_clsql.xml index 4d1c9d5..6fadbae 100644 --- a/doc/ref_clsql.xml +++ b/doc/ref_clsql.xml @@ -1868,7 +1868,7 @@ The default is &nil;. Syntax - query query-expression &key database types => result + query query-expression &key database result-types => result Arguments and Values @@ -1892,11 +1892,11 @@ The default is &nil;. - types + result-types A field type - specififier. The default is &nil;. + specifier. The default is &nil;. The purpose of this argument is cause &clsql; to @@ -2019,7 +2019,7 @@ The default is &nil;. Syntax - map-query output-type-spec function query-expression &key database types => result + map-query output-type-spec function query-expression &key database result-types => result Arguments and Values @@ -2060,10 +2060,10 @@ The default is &nil;. - types + result-types - A field type specififier. + A field type specifier. The default is &nil;. See query for the semantics of this argument. @@ -2190,7 +2190,7 @@ The default is &nil;. Syntax - do-query ((&rest args) query-expression &key database types) &body body => nil + do-query ((&rest args) query-expression &key database result-types) &body body => nil Arguments and Values @@ -2221,10 +2221,10 @@ The default is &nil;. - types + result-types - A field type specififier. + A field type specifier. The default is &nil;. See query for the semantics of this argument. diff --git a/sql/basic-cmds.lisp b/sql/basic-cmds.lisp deleted file mode 100644 index a8241b9..0000000 --- a/sql/basic-cmds.lisp +++ /dev/null @@ -1,32 +0,0 @@ - -(defmethod database-query (query-expression (database closed-database) types) - (declare (ignore query-expression types)) - (signal-closed-database-error database)) - -(defmethod database-query (query-expression (database t) types) - (declare (ignore query-expression types)) - (signal-no-database-error)) - -(defmethod database-execute-command (sql-expression (database closed-database)) - (declare (ignore sql-expression)) - (signal-closed-database-error database)) - -(defmethod database-execute-command (sql-expression (database t)) - (declare (ignore sql-expression)) - (signal-no-database-error)) - -(defgeneric execute-command (expression &key database) - (:documentation - "Executes the SQL command specified by EXPRESSION for the database -specified by DATABASE, which has a default value of -*DEFAULT-DATABASE*. The argument EXPRESSION may be any SQL statement -other than a query. To run a stored procedure, pass an appropriate -string. The call to the procedure needs to be wrapped in a BEGIN END -pair.")) - -(defmethod execute-command ((sql-expression string) - &key (database *default-database*)) - (record-sql-command sql-expression database) - (let ((res (database-execute-command sql-expression database))) - (record-sql-result res database)) - (values)) diff --git a/sql/sql.lisp b/sql/sql.lisp index d154aee..6d1e375 100644 --- a/sql/sql.lisp +++ b/sql/sql.lisp @@ -18,9 +18,9 @@ (defmethod database-query-result-set ((expr %sql-expression) database - &key full-set types) + &key full-set result-types) (database-query-result-set (sql-output expr database) database - :full-set full-set :types types)) + :full-set full-set :result-types result-types)) (defmethod execute-command ((expr %sql-expression) &key (database *default-database*)) -- 2.34.1