+2 May 2004 Marcus Pearce (m.t.pearce@city.ac.uk)
+ * sql/objects.lisp: fix bug in FIND-ALL when SELECT called with 2
+ or more View Classes.
+ * sql/objects.lisp: make the :flatp argument to SELECT work with
+ object queries.
+ * sql/objects.lisp: make SELECT accept a :result-types argument
+ (defaults to :auto) which is passed on to QUERY.
+ * sql/objects.lisp: SELECT returns field-names as a second value.
+ * tests/test-ooddl.lisp: add flatp arg to SELECT calls as appropriate.
+ * tests/test-fdml.lisp: add flatp/result-types arguments to calls
+ to SELECT and take only first value as appropriate.
+ * tests/test-fdml.lisp: add two new tests for query result coercion
+ and the field-names returned as a second value from SELECT.
+ * tests/test-oodml.lisp: add flatp arg to SELECT calls as appropriate.
+
1 May 2004 Kevin Rosenberg (kevin@rosenberg.net)
* Version 2.10.6-pre1
* sql/metaclasses.lisp: Add void-value slot
(sels (generate-selection-list view-class))
(res (apply #'select (append (mapcar #'cdr sels)
(list :from view-table
- :where view-qual)))))
+ :where view-qual)
+ (list :result-types nil)))))
(when res
(get-slot-values-from-view instance (mapcar #'car sels) (car res)))))
(view-qual (key-qualifier-for-instance instance :database vd))
(slot-def (slotdef-for-slot-with-class slot view-class))
(att-ref (generate-attribute-reference view-class slot-def))
- (res (select att-ref :from view-table :where view-qual)))
+ (res (select att-ref :from view-table :where view-qual
+ :result-types nil)))
(when res
(get-slot-values-from-view instance (list slot-def) (car res)))))
(jc (gethash :join-class dbi)))
(let ((jq (join-qualifier class object slot-def)))
(when jq
- (select jc :where jq)))))
+ (select jc :where jq :flatp t :result-types nil)))))
(defun fault-join-slot (class object slot-def)
(let* ((dbi (view-class-slot-db-info slot-def))
(defun find-all (view-classes &rest args &key all set-operation distinct from
where group-by having order-by order-by-descending offset limit
- refresh (database *default-database*))
- "tweeze me apart someone pleeze"
+ refresh flatp (database *default-database*))
+ "Called by SELECT to generate object query results when the
+ View Classes VIEW-CLASSES are passed as arguments to SELECT."
(declare (ignore all set-operation group-by having offset limit)
(optimize (debug 3) (speed 1)))
(remf args :from)
+ (remf args :flatp)
+ (remf args :result-types)
(labels ((table-sql-expr (table)
(sql-expression :table (view-table table)))
(ref-equal (ref1 ref2)
obj))
(build-objects (vals sclasses sels)
(let ((objects (mapcar #'(lambda (sclass sel)
- (build-object vals sclass sel))
+ (prog1 (build-object vals sclass sel)
+ (setf vals (nthcdr (list-length sel)
+ vals))))
sclasses sels)))
- (if (= (length sclasses) 1)
+ (if (and flatp (= (length sclasses) 1))
(car objects)
objects))))
(let* ((*db-deserializing* t)
(append (mapcar #'cdr fullsels)
(cons :from
(list (append (when from (listify from))
- (listify tables)))) args)))
+ (listify tables))))
+ (list :result-types nil)
+ args)))
(mapcar #'(lambda (r) (build-objects r sclasses sels)) res))))
(defmethod instance-refreshed ((instance standard-db-object)))
(apply #'find-all target-args qualifier-args)
(let ((expr (apply #'make-query select-all-args)))
(destructuring-bind (&key (flatp nil)
+ (result-types :auto)
(database *default-database*)
&allow-other-keys)
qualifier-args
- (let ((res (query expr :database database)))
- (if (and flatp
- (= (length (slot-value expr 'selections)) 1))
- (mapcar #'car res)
- res))))))))
+ (query expr :flatp flatp :result-types result-types
+ :database database)))))))
+
(let ((max (clsql:select [function "floor"
[/ [* [max [height]] 100] 2.54]]
:from [employee]
+ :result-types nil
:flatp t))
(min (clsql:select [function "floor"
[/ [* [min [height]] 100] 2.54]]
:from [employee]
+ :result-types nil
:flatp t))
(avg (clsql:select [function "floor"
[avg [/ [* [height] 100] 2.54]]]
:from [employee]
+ :result-types nil
:flatp t)))
(apply #'< (mapcar #'(lambda (s) (parse-integer s :junk-allowed t))
- (append min avg max))))
- t)
+ (append min avg max))))
+ t)
(deftest :fdml/select/2
- (clsql:select [first-name] :from [employee] :flatp t :distinct t
- :order-by [first-name])
- ("Boris" "Josef" "Konstantin" "Leon" "Leonid" "Mikhail" "Nikita" "Vladamir"
- "Yuri"))
+ (values (clsql:select [first-name] :from [employee] :flatp t :distinct t
+ :result-types nil
+ :order-by [first-name]))
+ ("Boris" "Josef" "Konstantin" "Leon" "Leonid" "Mikhail" "Nikita" "Vladamir"
+ "Yuri"))
(deftest :fdml/select/3
- (clsql:select [first-name] [count [*]] :from [employee]
- :group-by [first-name]
- :order-by [first-name])
- (("Boris" "1") ("Josef" "1") ("Konstantin" "1") ("Leon" "1") ("Leonid" "1")
- ("Mikhail" "1") ("Nikita" "1") ("Vladamir" "2") ("Yuri" "1")))
+ (values (clsql:select [first-name] [count [*]] :from [employee]
+ :result-types nil
+ :group-by [first-name]
+ :order-by [first-name]))
+ (("Boris" "1") ("Josef" "1") ("Konstantin" "1") ("Leon" "1") ("Leonid" "1")
+ ("Mikhail" "1") ("Nikita" "1") ("Vladamir" "2") ("Yuri" "1")))
(deftest :fdml/select/4
- (clsql:select [last-name] :from [employee] :where [like [email] "%org"]
- :order-by [last-name]
- :flatp t)
- ("Andropov" "Brezhnev" "Chernenko" "Gorbachev" "Kruschev" "Lenin" "Putin"
- "Stalin" "Trotsky" "Yeltsin"))
+ (values (clsql:select [last-name] :from [employee]
+ :where [like [email] "%org"]
+ :order-by [last-name]
+ :result-types nil
+ :flatp t))
+ ("Andropov" "Brezhnev" "Chernenko" "Gorbachev" "Kruschev" "Lenin" "Putin"
+ "Stalin" "Trotsky" "Yeltsin"))
(deftest :fdml/select/5
- (clsql:select [email] :from [employee] :flatp t
- :where [in [employee emplid]
- [select [managerid] :from [employee]]])
- ("lenin@soviet.org"))
+ (values (clsql:select [email] :from [employee] :flatp t :result-types nil
+ :where [in [employee emplid]
+ [select [managerid] :from [employee]]]))
+ ("lenin@soviet.org"))
(deftest :fdml/select/6
(if (db-type-has-fancy-math? *test-database-underlying-type*)
(mapcar #'(lambda (s) (parse-integer s :junk-allowed t))
- (clsql:select [function "trunc" [height]] :from [employee]
- :flatp t))
- (mapcar #'(lambda (s) (truncate (parse-integer s :junk-allowed t)))
- (clsql:select [height] :from [employee] :flatp t)))
- (1 1 1 1 1 1 1 1 1 1))
+ (clsql:select [function "trunc" [height]] :from [employee]
+ :result-types nil
+ :flatp t))
+ (mapcar #'(lambda (s) (truncate (parse-integer s :junk-allowed t)))
+ (clsql:select [height] :from [employee] :flatp t
+ :result-types nil)))
+ (1 1 1 1 1 1 1 1 1 1))
(deftest :fdml/select/7
- (clsql:select [max [emplid]] :from [employee] :flatp t)
- ("10"))
+ (values
+ (clsql:select [max [emplid]] :from [employee] :flatp t :result-types nil))
+ ("10"))
(deftest :fdml/select/8
- (clsql:select [min [emplid]] :from [employee] :flatp t)
- ("1"))
+ (values
+ (clsql:select [min [emplid]] :from [employee] :flatp t :result-types nil))
+ ("1"))
(deftest :fdml/select/9
- (subseq (car (clsql:select [avg [emplid]] :from [employee] :flatp t)) 0 3)
- "5.5")
+ (subseq
+ (car
+ (clsql:select [avg [emplid]] :from [employee] :flatp t :result-types nil))
+ 0 3)
+ "5.5")
(deftest :fdml/select/10
- (clsql:select [last-name] :from [employee]
- :where [not [in [emplid]
- [select [managerid] :from [company]]]]
- :flatp t
- :order-by [last-name])
- ("Andropov" "Brezhnev" "Chernenko" "Gorbachev" "Kruschev" "Putin" "Stalin"
- "Trotsky" "Yeltsin"))
+ (values (clsql:select [last-name] :from [employee]
+ :where [not [in [emplid]
+ [select [managerid] :from [company]]]]
+ :result-types nil
+ :flatp t
+ :order-by [last-name]))
+ ("Andropov" "Brezhnev" "Chernenko" "Gorbachev" "Kruschev" "Putin" "Stalin"
+ "Trotsky" "Yeltsin"))
(deftest :fdml/select/11
- (clsql:select [last-name] :from [employee] :where [married] :flatp t
- :order-by [emplid])
- ("Lenin" "Stalin" "Trotsky"))
+ (values (clsql:select [last-name] :from [employee] :where [married] :flatp t
+ :order-by [emplid] :result-types nil))
+ ("Lenin" "Stalin" "Trotsky"))
(deftest :fdml/select/12
(let ((v 1))
- (clsql:select [last-name] :from [employee] :where [= [emplid] v]))
- (("Lenin")))
+ (values (clsql:select [last-name] :from [employee] :where [= [emplid] v]
+ :result-types nil)))
+ (("Lenin")))
+
+(deftest :fdml/select/13
+ (multiple-value-bind (results field-names)
+ (clsql:select [emplid] [last-name] [married] :from [employee]
+ :where [= [emplid] 1])
+ (values results (mapcar #'string-downcase field-names)))
+ ((1 "Lenin" "t"))
+ ("emplid" "last_name" "married"))
+
+(deftest :fdml/select/14
+ (floatp (car (clsql:select [height] :from [employee] :where [= [emplid] 1]
+ :flatp t)))
+ t)
;(deftest :fdml/select/11
; (clsql:select [emplid] :from [employee]
(clsql:execute-command "set datestyle to 'iso'"))
(clsql:update-records [employee] :av-pairs `((birthday ,now))
:where [= [emplid] 1])
- (let ((dbobj (car (clsql:select 'employee :where [= [birthday] now]))))
+ (let ((dbobj (car (clsql:select 'employee :where [= [birthday] now]
+ :flatp t))))
(values
(slot-value dbobj 'last-name)
(clsql-base:time= (slot-value dbobj 'birthday) now))))
(dotimes (x 40)
(clsql:update-records [employee] :av-pairs `((birthday ,now))
:where [= [emplid] 1])
- (let ((dbobj (car (clsql:select 'employee :where [= [birthday] now]))))
+ (let ((dbobj (car (clsql:select 'employee :where [= [birthday] now]
+ :flatp t))))
(unless (clsql-base:time= (slot-value dbobj 'birthday) now)
(setf fail-index x))
(setf now (clsql-base:roll now :day (* 10 x)))))
(deftest :oodml/select/1
(mapcar #'(lambda (e) (slot-value e 'last-name))
- (clsql:select 'employee :order-by [last-name]))
+ (clsql:select 'employee :order-by [last-name] :flatp t))
("Andropov" "Brezhnev" "Chernenko" "Gorbachev" "Kruschev" "Lenin" "Putin"
"Stalin" "Trotsky" "Yeltsin"))
(deftest :oodml/select/2
(mapcar #'(lambda (e) (slot-value e 'name))
- (clsql:select 'company))
+ (clsql:select 'company :flatp t))
("Widgets Inc."))
(deftest :oodml/select/3
(mapcar #'(lambda (e) (slot-value e 'companyid))
(clsql:select 'employee
- :where [and [= [slot-value 'employee 'companyid]
- [slot-value 'company 'companyid]]
- [= [slot-value 'company 'name]
- "Widgets Inc."]]))
+ :where [and [= [slot-value 'employee 'companyid]
+ [slot-value 'company 'companyid]]
+ [= [slot-value 'company 'name]
+ "Widgets Inc."]]
+ :flatp t))
(1 1 1 1 1 1 1 1 1 1))
(deftest :oodml/select/4
(slot-value e 'last-name)))
(clsql:select 'employee :where [= [slot-value 'employee 'first-name]
"Vladamir"]
+ :flatp t
: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]))
+ (length (clsql:select 'employee :where [married] :flatp t))
3)
;; tests update-records-from-instance
(progn
(let ((lenin (car (clsql:select 'employee
:where [= [slot-value 'employee 'emplid]
- 1]))))
+ 1]
+ :flatp t))))
(concatenate 'string
(first-name lenin)
" "
(clsql:update-records-from-instance employee1)
(let ((lenin (car (clsql:select 'employee
:where [= [slot-value 'employee 'emplid]
- 1]))))
+ 1]
+ :flatp t))))
(concatenate 'string
(first-name lenin)
" "
(clsql:update-records-from-instance employee1)
(let ((lenin (car (clsql:select 'employee
:where [= [slot-value 'employee 'emplid]
- 1]))))
+ 1]
+ :flatp t))))
(concatenate 'string
(first-name lenin)
" "
(values
(employee-email
(car (clsql:select 'employee
- :where [= [slot-value 'employee 'emplid] 1])))
+ :where [= [slot-value 'employee 'emplid] 1]
+ :flatp t)))
(progn
(setf (slot-value employee1 'email) "lenin-nospam@soviet.org")
(clsql:update-record-from-slot employee1 'email)
(employee-email
(car (clsql:select 'employee
- :where [= [slot-value 'employee 'emplid] 1]))))
+ :where [= [slot-value 'employee 'emplid] 1]
+ :flatp t))))
(progn
(setf (slot-value employee1 'email) "lenin@soviet.org")
(clsql:update-record-from-slot employee1 'email)
(employee-email
(car (clsql:select 'employee
- :where [= [slot-value 'employee 'emplid] 1])))))
+ :where [= [slot-value 'employee 'emplid] 1]
+ :flatp t)))))
"lenin@soviet.org" "lenin-nospam@soviet.org" "lenin@soviet.org")
;; tests update-record-from-slots
(values
(let ((lenin (car (clsql:select 'employee
:where [= [slot-value 'employee 'emplid]
- 1]))))
+ 1]
+ :flatp t))))
(concatenate 'string
(first-name lenin)
" "
(clsql:update-record-from-slots employee1 '(first-name last-name email))
(let ((lenin (car (clsql:select 'employee
:where [= [slot-value 'employee 'emplid]
- 1]))))
+ 1]
+ :flatp t))))
(concatenate 'string
(first-name lenin)
" "
(clsql:update-record-from-slots employee1 '(first-name last-name email))
(let ((lenin (car (clsql:select 'employee
:where [= [slot-value 'employee 'emplid]
- 1]))))
+ 1]
+ :flatp t))))
(concatenate 'string
(first-name lenin)
" "
projects / clsql.git / commitdiff