+3 May 2004 Kevin Rosenberg (kevin@rosenberg.net)
+ * Version 2.10.8
+ * base/conditions.lisp: Add *backend-warning-behavior*
+ special variable.
+ * db-postgresql-socket/postgresql-socket-sql.lisp:
+ Honor value of *backend-warning-behavior*
+ * tests/test-fdml.lisp: Remove test of raw boolean value
+ since different backends handle this differently.
+ * tests/test-oodml.lisp: Add test for boolean slot value
+ * tests/test-init.lisp: Use *backend-warning-behavior*
+ to suppress warnings from postgresql about implicitly
+ creating primary key in tables.
+
3 May 2004 Kevin Rosenberg (kevin@rosenberg.net)
* Version 2.10.7
* db-odbc/odbc-dbi.lisp: Convert TINYINT to integers when
"<unbound>")
(database-state object))))
+
(in-package #:clsql-base)
+(defvar *backend-warning-behavior* :warn
+ "Action to perform on warning messages from backend. Default is to :warn. May also be
+set to :error to signal an error or :ignore/nil to silently ignore the warning.")
+
;;; Conditions
(define-condition clsql-condition ()
())
(define-condition clsql-sql-error (clsql-error)
((database :initarg :database :reader clsql-sql-error-database)
- (expression :initarg :expression :reader clsql-sql-error-expression)
- (errno :initarg :errno :reader clsql-sql-error-errno)
- (error :initarg :error :reader clsql-sql-error-error))
+ (message :initarg :message :initarg nil :reader clsql-sql-error-message)
+ (expression :initarg :expression :initarg nil :reader clsql-sql-error-expression)
+ (errno :initarg :errno :initarg nil :reader clsql-sql-error-errno)
+ (error :initarg :error :initarg nil :reader clsql-sql-error-error))
(:report (lambda (c stream)
- (format stream "While accessing database ~A~% with expression ~S:~% Error ~D / ~A~% has occurred."
- (clsql-sql-error-database c)
- (clsql-sql-error-expression c)
- (clsql-sql-error-errno c)
- (clsql-sql-error-error c)))))
+ (if (clsql-sql-error-message c)
+ (format stream "While accessing database ~A~%, Error~% ~A~% has occurred."
+ (clsql-sql-error-database c)
+ (clsql-sql-error-message c))
+ (format stream "While accessing database ~A~% with expression ~S:~% Error ~D / ~A~% has occurred."
+ (clsql-sql-error-database c)
+ (clsql-sql-error-expression c)
+ (clsql-sql-error-errno c)
+ (clsql-sql-error-error c))))))
(define-condition clsql-database-warning (clsql-warning)
((database :initarg :database :reader clsql-database-warning-database)
(:report (lambda (c stream)
(format stream "Invalid SQL syntax: ~A"
(clsql-sql-syntax-error-reason c)))))
+
#:clsql-type-error
#:clsql-odbc-error
#:clsql-odbc-error-message
+ #:*backend-warning-behavior*
#:*loaded-database-types*
#:reload-database-types
:connection connection :message message))))
(#.+notice-response-message+
(let ((message (read-socket-value-string socket)))
- (warn 'postgresql-warning
- :connection connection :message message)))
+ (unless (eq :ignore clsql-base:*backend-warning-behavior*)
+ (warn 'postgresql-warning
+ :connection connection :message message))))
(#.+notification-response-message+
(let ((pid (read-socket-value-int32 socket))
(message (read-socket-value-string socket)))
(defun convert-to-clsql-warning (database condition)
- (warn 'clsql-database-warning :database database
- :message (postgresql-condition-message condition)))
+ (ecase *backend-warning-behavior*
+ (:warn
+ (warn 'clsql-database-warning :database database
+ :message (postgresql-condition-message condition)))
+ (:error
+ (error 'clsql-sql-error :database database
+ :message (format nil "Warning upgraded to error: ~A"
+ (postgresql-condition-message condition))))
+ ((:ignore nil)
+ ;; do nothing
+ )))
(defun convert-to-clsql-error (database expression condition)
(error 'clsql-sql-error :database database
(lambda (c)
(convert-to-clsql-error
,database-var ,expression-var c))))
- ;; KMR - removed double @@
,@body))))
(defmethod database-initialize-database-type ((database-type
(wait-for-query-results connection)
(when (eq status :cursor)
(loop
- (multiple-value-bind (row stuff)
- (skip-cursor-row result)
- (unless row
- (setq status :completed result stuff)
- (return)))))
+ (multiple-value-bind (row stuff)
+ (skip-cursor-row result)
+ (unless row
+ (setq status :completed result stuff)
+ (return)))))
(cond
- ((null status)
- t)
- ((eq status :completed)
- (unless (null (wait-for-query-results connection))
+ ((null status)
+ t)
+ ((eq status :completed)
+ (unless (null (wait-for-query-results connection))
(close-postgresql-connection connection)
(error 'clsql-sql-error
:database database
:expression expression
:errno 'multiple-results
:error "Received multiple results for command."))
- result)
+ result)
(t
(close-postgresql-connection connection)
(error 'clsql-sql-error
(string (if (string= "0" val) nil t))
(integer (if (zerop val) nil t))))
(:postgresql
- (if (database-type :odbc)
+ (if (eq :odbc (database-type database))
(if (string= "0" val) nil t)
- (equal "t" val)))
+ (equal "t" val)))
(t
(equal "t" val))))
#:clsql-closed-error-database
#:clsql-type-error
#:clsql-sql-syntax-error
-
+ #:*backend-warning-behavior*
+
;; db-interface
#:check-connection-spec
#:database-initialize-database-type
(destructuring-bind (int float bigint str) row
(push (list (integerp int)
(typep float 'double-float)
- (integerp bigint)
+ (if (and (eq :odbc *test-database-type*)
+ (eq :postgresql *test-database-underlying-type*))
+ ;; ODBC/Postgresql returns bigints as strings
+ (stringp bigint)
+ (integerp bigint))
(stringp str))
results))))
((t t t t) (t t t t) (t t t t) (t t t t) (t t t t) (t t t t) (t t t t) (t t t t) (t t t t) (t t t t) (t t t t)))
(deftest :fdml/select/13
(multiple-value-bind (results field-names)
- (clsql:select [emplid] [last-name] [married] :from [employee]
+ (clsql:select [emplid] [last-name] :from [employee]
:where [= [emplid] 1])
(values results (mapcar #'string-downcase field-names)))
- ((1 "Lenin" "t"))
- ("emplid" "last_name" "married"))
+ ((1 "Lenin"))
+ ("emplid" "last_name"))
(deftest :fdml/select/14
(floatp (car (clsql:select [height] :from [employee] :where [= [emplid] 1]
:flatp t)))
t)
-(deftest :fdml/select/15
- (clsql:select [married] :from [employee]
- :where [= [emplid] 4]
- :field-names nil)
- (("f")))
-
;(deftest :fdml/select/11
; (clsql:select [emplid] :from [employee]
; :where [= [emplid] [any [select [companyid] :from [company]]]]
(defun test-initialise-database ()
(test-basic-initialize)
- (clsql:create-view-from-class 'employee)
- (clsql:create-view-from-class 'company)
+ (let ((*backend-warning-behavior*
+ (if (member *test-database-type* '(:postgresql :postgresql-socket))
+ :ignore
+ :warn)))
+ (clsql:create-view-from-class 'employee)
+ (clsql:create-view-from-class 'company))
(setf company1 (make-instance 'company
:companyid 1
:first-name "Vladamir"
:last-name "Putin"
:email "putin@soviet.org"))
-
+
;; sleep to ensure birthdays are no longer at current time
(sleep 2)
:order-by [last-name]))
("Vladamir Lenin" "Vladamir Putin"))
-;; sqlite fails this because it is typeless
(deftest :oodml/select/5
(length (clsql:select 'employee :where [married] :flatp t))
3)
+(deftest :oodml/select/6
+ (slot-value (caar (clsql:select 'employee :where [= 1 [emplid]])) 'married)
+ t)
+
+(deftest :oodml/select/7
+ (slot-value (caar (clsql:select 'employee :where [= 4 [emplid]])) 'married)
+ nil)
+
;; tests update-records-from-instance
(deftest :oodml/update-records/1
(values