Added tests for symbols valued slots, and better printer/reader bindings
authorRuss Tyndall <russ@acceleration.net>
Thu, 24 Apr 2014 18:12:52 +0000 (14:12 -0400)
committerRuss Tyndall <russ@acceleration.net>
Thu, 24 Apr 2014 18:12:52 +0000 (14:12 -0400)
ChangeLog
sql/conditions.lisp
sql/oodml.lisp
tests/ds-employees.lisp
tests/test-oodml.lisp

index 61d09c1..44b0567 100644 (file)
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,9 @@
+2014-04-24 Russ Tyndall <russ@acceleration.net>
+       * oodml.lisp, test-oodml.lisp Better handling of view-slots of
+       type symbol/keyword.  Better handling of printing and reading
+       bindings (per mailing list request, always read and write in base
+       10)
+
 2014-02-24 Russ Tyndall <russ@acceleration.net>
        * oodml.lisp bind *print-length* to nil before printing
        lists/arrays to the database.
index 6fc1af5..1969b96 100644 (file)
@@ -153,11 +153,11 @@ connection is no longer usable."))
   (restart-case 
       (error 'sql-value-conversion-error
              :expected-type type :value val :database database)
+    (continue ()
+      :report "Continue using the unconverted value"
+      (values val t))
     (use-value (new-val)
-      :report
-      (lambda (stream)
-        (write-sequence
-         "Use a different value instead of this failed conversion" stream))
+      :report "Use a different value instead of this failed conversion"
       (values new-val t)
       )))
 
index f2ed8c9..169fa89 100644 (file)
     (char (if args
               (format nil "CHAR(~D)" (first args))
               "CHAR(1)"))
-    ((varchar string)
+    ((varchar string symbol keyword)
      (if args
          (format nil "VARCHAR(~A)" (car args))
          (format nil "VARCHAR(~D)" *default-string-length*)))
                                  (*print-readably* t))
   (prin1-to-string in))
 
-(defmethod database-output-sql-as-type (type val database db-type)
-  (declare (ignore type database db-type))
-  val)
-
-(defmethod database-output-sql-as-type ((type symbol) val database db-type)
+(defmethod database-output-sql-as-type
+    (type val database db-type
+     &aux
+     (*print-circle* t) (*print-array* t)
+     (*print-length* nil) (*print-base* #10r10))
   (declare (ignore database))
-  (case type ;; booleans handle null differently
-    ((boolean generalized-boolean)
+  (cond 
+    ((null type) val)
+    ((member type '(boolean generalized-boolean))
+     ;; booleans handle null differently
      (case db-type
        ;; done here so it can be done once
        ((:mssql :mysql) (if val 1 0))
        (otherwise (if val "t" "f"))))
-    (otherwise
-     ;; in all other cases if we have nil give everyone else a shot at it,
-     ;; which by default returns nil
-     (if (null val)
-         (call-next-method)
-         (case type
-           ((or symbol keyword)
-            (print-readable-symbol val))
-           (string val)
-           (char (etypecase val
-                   (character (write-to-string val))
-                   (string val)))
-           (float (format nil "~F" val))
-           ((list vector array)
-            (let* ((*print-circle* t)
-                   (*print-array* t)
-                   (*print-length* nil)
-                   (value (prin1-to-string val)))
-              value))
-           (otherwise (call-next-method)))))))
+    ((null val)
+     (when (next-method-p)
+       (call-next-method)))
+    (t
+     (case type
+       ((or symbol keyword)
+        (print-readable-symbol val))
+       (string val)
+       (char (etypecase val
+               (character (write-to-string val))
+               (string val)))
+       (float (format nil "~F" val))
+       ((list vector array)
+        (prin1-to-string val))
+       (otherwise
+        (if (next-method-p)
+            (call-next-method)
+            val))))))
 
 
 (defmethod read-sql-value :around
     (val type database db-type
-     &aux *read-eval*)
+     ;; never eval while reading values, always read base 10
+     &aux *read-eval* (*read-base* #10r10))
   (declare (ignore db-type))
   (cond
     ;; null value or type
        (maybe-error-converting-value
         res val type database)))))
 
-(defmethod read-sql-value (val type database db-type
-                           ;; never eval while reading values
-                           &aux *read-eval*)
+(defmethod read-sql-value (val type database db-type)
   ;; errors, nulls and preconverted types are already handled in around
   (typecase type
     (symbol
index 1b1e36b..2611053 100644 (file)
     :db-constraints :not-null
     :type integer
     :initarg :groupid)
+   (title
+    :accessor title
+    :type symbol
+    :initarg :title)
    (first-name
     :accessor first-name
     :type (varchar 30)
                                    :emplid 1
                                    :groupid 1
                                    :married t
+                                   :title 'supplicant
                                    :height (1+ (random 1.00))
                                    :bd-utime *test-start-utime*
                                    :birthday now-time
           employee2 (make-instance 'employee
                                    :emplid 2
                                    :groupid 1
+                                   :title :adherent
                                    :height (1+ (random 1.00))
                                    :married t
                                    :bd-utime *test-start-utime*
           employee3 (make-instance 'employee
                                    :emplid 3
                                    :groupid 1
+                                   :title 'cl-user::novice
                                    :height (1+ (random 1.00))
                                    :married t
                                    :bd-utime *test-start-utime*
index 63e1d50..042fd48 100644 (file)
  (clsql-sys::read-sql-value
   (clsql-sys::database-output-sql-as-type 'symbol 'clsql-tests::foo nil nil)
   'symbol nil nil)
'(clsql-tests::foo))
clsql-tests::foo)
 
 (deftest :oodml/read-symbol-value/2-into-another-pacakge
  (clsql-sys::read-sql-value
   (clsql-sys::database-output-sql-as-type 'symbol 'clsql-sys::foo nil nil)
   'symbol nil nil)
'(clsql-sys::foo))
clsql-sys::foo)
 
 (deftest :oodml/read-symbol-value/3-keyword
  (clsql-sys::read-sql-value
   (clsql-sys::database-output-sql-as-type 'keyword ':foo nil nil)
   'keyword nil nil)
'(:foo))
:foo)
 
 (deftest :oodml/read-symbol-value/4-keyword-error
  (handler-case
@@ -46,7 +46,7 @@
       'keyword nil nil)
    (clsql-sys::sql-value-conversion-error (c) (declare (ignore c))
      :error))
'(:error))
:error)
 
 (deftest :oodml/select/1
     (with-dataset *ds-employees*
              (select 'deferred-employee-address :flatp t :order-by [aaddressid] :caching nil)))
   (10 10 nil nil nil nil))
 
+(deftest :oodm/retrieval/10-slot-columns
+ (with-dataset *ds-employees*
+   (mapcar #'title
+           (select 'employee :flatp t :caching nil
+                   :where [<= [emplid] 3]
+                   :order-by `((,[emplid]  :asc)))))
+ (supplicant :adherent cl-user::novice))
+
 ;; tests update-records-from-instance
 (deftest :oodml/update-records/1
     (with-dataset *ds-employees*