r9211: add *backend-warning-behavior

diff --git a/ChangeLog b/ChangeLog
index 70b20ca2500410737dfcd234a4ebd59beffe42db..5881d6d2f47f95408ff8f03f5438836aed1bc9e3 100644 (file)
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,16 @@
+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

diff --git a/base/classes.lisp b/base/classes.lisp
index 292bb6ba22b9804934877620acf2a4c72e363778..f2220f69cbe82ac9a29f07effe0b2da3ac0e1aa9 100644 (file)
--- a/base/classes.lisp
+++ b/base/classes.lisp
@@ -52,3 +52,4 @@ are a list of ACTION specified for table and any cached value of list-attributes
              "<unbound>")
            (database-state object))))
 
+

diff --git a/base/conditions.lisp b/base/conditions.lisp
index 25d4623605396b0bdbd8b75e39b53f7b9d24e093..4954eced7fdbb07dddd02794da93c59484ab3fad 100644 (file)
--- a/base/conditions.lisp
+++ b/base/conditions.lisp
@@ -20,6 +20,10 @@
 
 (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 ()
   ())
@@ -94,15 +98,20 @@ and signal an clsql-invalid-spec-error if they don't match."
 
 (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)
@@ -198,3 +207,4 @@ and signal an clsql-invalid-spec-error if they don't match."
   (:report (lambda (c stream)
             (format stream "Invalid SQL syntax: ~A"
                     (clsql-sql-syntax-error-reason c)))))
+

diff --git a/base/package.lisp b/base/package.lisp
index faefebd9ee95ceeaf945936b2b7eaa8277062c6f..241d0348c778cd940fadf1547725ed11828e4424 100644 (file)
--- a/base/package.lisp
+++ b/base/package.lisp
@@ -119,6 +119,7 @@
      #:clsql-type-error
      #:clsql-odbc-error
      #:clsql-odbc-error-message
+     #:*backend-warning-behavior*
      
      #:*loaded-database-types*
      #:reload-database-types

diff --git a/db-postgresql-socket/postgresql-socket-api.lisp b/db-postgresql-socket/postgresql-socket-api.lisp
index 5630f04eceb3c2254a2a3c2253586583201a7fed..69496c27b33369622dd9c893515a4f88f2c84334 100644 (file)
--- a/db-postgresql-socket/postgresql-socket-api.lisp
+++ b/db-postgresql-socket/postgresql-socket-api.lisp
@@ -600,8 +600,9 @@ connection, if it is still open."
                                   :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)))

diff --git a/db-postgresql-socket/postgresql-socket-sql.lisp b/db-postgresql-socket/postgresql-socket-sql.lisp
index 180b036904613be3a0fa5529737b8dc08e53ffde..24597c0d6459f8cd0c4c77afcbaa02a1a2a3b626 100644 (file)
--- a/db-postgresql-socket/postgresql-socket-sql.lisp
+++ b/db-postgresql-socket/postgresql-socket-sql.lisp
@@ -104,8 +104,17 @@ doesn't depend on UFFI."
 
 
 (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
@@ -127,7 +136,6 @@ doesn't depend on UFFI."
                       (lambda (c)
                         (convert-to-clsql-error
                          ,database-var ,expression-var c))))
-        ;; KMR - removed double @@
         ,@body))))
 
 (defmethod database-initialize-database-type ((database-type
@@ -239,23 +247,23 @@ doesn't depend on UFFI."
          (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

diff --git a/sql/objects.lisp b/sql/objects.lisp
index 9598ea643d3172bf8acdd209be7fd443e42b52a6..cb158d296957b4aea192dd8859c0451ebf8fb388 100644 (file)
--- a/sql/objects.lisp
+++ b/sql/objects.lisp
@@ -665,9 +665,9 @@ superclass of the newly-defined View Class."
        (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))))
 

diff --git a/sql/package.lisp b/sql/package.lisp
index b1e39f27e4b37a9e0996858a6dcf460724dc24f0..4db6fe7d1edebcf4c10eb19fce46441a0043b04c 100644 (file)
--- a/sql/package.lisp
+++ b/sql/package.lisp
@@ -132,7 +132,8 @@
        #:clsql-closed-error-database
        #:clsql-type-error
        #:clsql-sql-syntax-error
-
+       #:*backend-warning-behavior*
+       
        ;; db-interface
        #:check-connection-spec
        #:database-initialize-database-type

diff --git a/tests/test-basic.lisp b/tests/test-basic.lisp
index c551b0d16049efca5407ebbfff4166787323985a..85874a4d4ed3015ed25b2b035117b5666d0de9cd 100644 (file)
--- a/tests/test-basic.lisp
+++ b/tests/test-basic.lisp
@@ -45,7 +45,11 @@
            (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)))

diff --git a/tests/test-fdml.lisp b/tests/test-fdml.lisp
index f7ee00504df2bddb8dba1c3f803a06c092a931be..53bc3faff6301b8f27b837fd1f204ae9118d83b8 100644 (file)
--- a/tests/test-fdml.lisp
+++ b/tests/test-fdml.lisp
@@ -276,23 +276,17 @@
 
 (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]]]]

diff --git a/tests/test-init.lisp b/tests/test-init.lisp
index c13f545a0452eec526df868c51b2bdcd4b131ba2..eef4f888c44009906ae2c074951702cf83c3dfe9 100644 (file)
--- a/tests/test-init.lisp
+++ b/tests/test-init.lisp
@@ -156,8 +156,12 @@
 (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
@@ -255,7 +259,7 @@
                     :first-name "Vladamir"
                     :last-name "Putin"
                     :email "putin@soviet.org"))
-
+  
   ;; sleep to ensure birthdays are no longer at current time
   (sleep 2) 
 

diff --git a/tests/test-oodml.lisp b/tests/test-oodml.lisp
index 6ea820a615a97e3f92678cf5831955717ac37679..7cac6feae92ebfcf34d62ca10246ee518e68c271 100644 (file)
--- a/tests/test-oodml.lisp
+++ b/tests/test-oodml.lisp
@@ -54,11 +54,18 @@
                          :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