+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.
(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
: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*
(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
'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*