;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
;;;; ======================================================================
;;;; File: test-oodml.lisp
-;;;; Author: Marcus Pearce <m.t.pearce@city.ac.uk>
;;;; Created: 01/04/2004
;;;;
;;;; Tests for the CLSQL Object Oriented Data Definition Language
(in-package #:clsql-tests)
-#.(clsql:locally-enable-sql-reader-syntax)
+(clsql-sys:file-enable-sql-reader-syntax)
+
(setq *rt-oodml*
'(
+(deftest :oodml/read-symbol-value/1-into-this-package
+ (clsql-sys::read-sql-value
+ (clsql-sys::database-output-sql-as-type 'symbol 'clsql-tests::foo nil nil)
+ 'symbol nil nil)
+ 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)
+
+(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)
+
+(deftest :oodml/read-symbol-value/4-keyword-error
+ (handler-case
+ (clsql-sys::read-sql-value
+ (clsql-sys::database-output-sql-as-type 'keyword 'foo nil nil)
+ 'keyword nil nil)
+ (clsql-sys::sql-value-conversion-error (c) (declare (ignore c))
+ :error))
+ :error)
+
(deftest :oodml/select/1
(with-dataset *ds-employees*
(mapcar #'(lambda (e) (slot-value e 'last-name))
;; test retrieval of node, derived nodes etc
(deftest :oodml/select/12
(with-dataset *ds-nodes*
- (length (clsql:select 'node :where [node-id] :flatp t :caching nil)))
+ (length (clsql:select 'node :where [not [null [node-id]]] :flatp t :caching nil)))
11)
(deftest :oodml/select/13
(deftest :oodml/select/14
(with-dataset *ds-nodes*
- (length (clsql:select 'setting :where [setting-id] :flatp t :caching nil)))
+ (length (clsql:select 'setting :where [not [null [setting-id]]] :flatp t :caching nil)))
4)
(deftest :oodml/select/15
(deftest :oodml/select/16
(with-dataset *ds-nodes*
- (length (clsql:select 'user :where [user-id] :flatp t :caching nil)))
+ (length (clsql:select 'user :where [not [null [user-id]]] :flatp t :caching nil)))
2)
(deftest :oodml/select/17
(deftest :oodml/select/18
(with-dataset *ds-nodes*
- (length (clsql:select 'theme :where [theme-id] :flatp t :caching nil)))
+ (length (clsql:select 'theme :where [not [null [theme-id]]] :flatp t :caching nil)))
2)
(deftest :oodml/select/19
(deftest :oodml/select/22
(with-dataset *ds-nodes*
- (let ((a (car (clsql:select 'subloc :where [subloc-id] :flatp t :caching nil))))
+ (let ((a (car (clsql:select 'subloc :where [not [null [subloc-id]]] :flatp t :caching nil))))
(values
(slot-value a 'node-id)
(slot-value a 'subloc-id)
(slot-value a 'loc))))
10 10 "subloc-1" "a subloc")
+(deftest :oodml/select/23
+ (with-dataset *ds-artists*
+ (length (clsql:select 'artist :flatp t :caching nil)))
+ 0)
+
+
+
;; test retrieval is deferred
(deftest :oodm/retrieval/1
(with-dataset *ds-employees*
(deftest :oodm/retrieval/4
(with-dataset *ds-employees*
- (mapcar #'(lambda (ea) (typep (slot-value ea 'address) 'address))
+ (every #'(lambda (ea) (typep (slot-value ea 'address) 'address))
(select 'employee-address :flatp t :caching nil)))
- (t t t t t))
+ t)
(deftest :oodm/retrieval/5
(with-dataset *ds-employees*
- (mapcar #'(lambda (ea) (typep (slot-value ea 'address) 'address))
- (select 'deferred-employee-address :flatp t :caching nil)))
- (t t t t t))
+ (every #'(lambda (ea) (typep (slot-value ea 'address) 'address))
+ (select 'deferred-employee-address :flatp t :caching nil)))
+ t)
(deftest :oodm/retrieval/6
(with-dataset *ds-employees*
(with-dataset *ds-employees*
(mapcar #'(lambda (ea) (slot-value (slot-value ea 'address) 'street-number))
(select 'employee-address :flatp t :order-by [aaddressid] :caching nil)))
- (10 10 nil nil nil))
+ (10 10 nil nil nil nil))
(deftest :oodm/retrieval/9
(with-dataset *ds-employees*
(mapcar #'(lambda (ea) (slot-value (slot-value ea 'address) 'street-number))
(select 'deferred-employee-address :flatp t :order-by [aaddressid] :caching nil)))
- (10 10 nil nil 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
;; tests update-record-from-slot
(deftest :oodml/update-records/2
(with-dataset *ds-employees*
+ ;(start-sql-recording :type :both)
(values
(employee-email
(car (clsql:select 'employee
:where [= 1 [slot-value 'employee 'emplid]]
:flatp t
:caching nil)))
- (progn
- (setf (slot-value employee1 'email) "lenin-nospam@soviet.org")
- (clsql:update-record-from-slot employee1 'email)
+ (progn
+ (setf (slot-value employee1 'email) "lenin-nospam@soviet.org")
+ (clsql:update-record-from-slot employee1 'email)
(employee-email
(car (clsql:select 'employee
:where [= 1 [slot-value 'employee 'emplid]]
(format nil "~a ~a ~a"
(slot-value node 'setting-id)
(slot-value node 'title)
- (slot-value node 'vars)))))
+ (or (slot-value node 'vars) "NIL")))))
(values
(print-fresh-setting)
(let ((node (car (clsql:select 'setting
(with-slots (node-id setting-id theme-id title vars doc) node
(format nil "~a ~a ~a ~a ~a ~a"
node-id setting-id theme-id
- title vars doc)))))
+ title (or vars "NIL") doc)))))
(values
(print-fresh-theme)
(let ((node (car (clsql:select 'setting
(let ((sl (car (clsql:select 'subloc
:where [= 10 [slot-value 'subloc 'subloc-id]]
:flatp t :caching nil))))
+ (unless sl
+ (error "Couldn't find expected sublocation"))
(format nil "~a ~a ~a"
(slot-value sl 'subloc-id)
(slot-value sl 'title)
(let ((sl (car (clsql:select 'subloc
:where [= 10 [slot-value 'subloc 'subloc-id]]
:flatp t :caching nil))))
+ (unless sl
+ (error "In psfl: found no sublocation with id = 10"))
(format nil "~a ~a ~a"
(slot-value sl 'subloc-id)
(slot-value sl 'title)
(let ((sl (car (clsql:select 'subloc
:where [= 10 [slot-value 'subloc 'subloc-id]]
:flatp t :caching nil))))
+ (unless sl
+ (error "Select for modification: Found no sublocation with id = 10"))
(setf (slot-value sl 'title) "Altered subloc title")
(setf (slot-value sl 'loc) "Altered loc")
(clsql:update-record-from-slot sl 'title)
(let ((sl (car (clsql:select 'subloc
:where [= 10 [slot-value 'subloc 'subloc-id]]
:flatp t :caching nil))))
+ (unless sl
+ (error "Select for next modification: Found no sublocation with id = 10"))
(setf (slot-value sl 'title) "subloc-1")
(setf (slot-value sl 'loc) "a subloc")
- (clsql:update-record-from-slot sl '(title loc))
+ (clsql:update-record-from-slots sl '(title loc))
(print-fresh-subloc)))))
"10 subloc-1 a subloc"
"10 Altered subloc title Altered loc"
"10 subloc-1 a subloc")
+;; Verify that we can set a float to nil and then read it back
+;; (was failing in Postgresql at somepoint)
+(deftest :oodml/update-records/10
+ (with-dataset *ds-employees*
+ (let ((emp (first (clsql:select 'employee :where [= [emplid] 1] :flatp t))))
+ (setf (height emp) nil)
+ (clsql-sys:update-record-from-slot emp 'height)
+ (values
+ (clsql:select [height] :from [employee] :where [= [emplid] 1])
+ (progn
+ (setf (height emp) 42.0)
+ (clsql-sys:update-record-from-slot emp 'height)
+ (clsql:select [height] :from [employee] :where [= [emplid] 1]))
+ (progn
+ (setf (height emp) 24.13d0)
+ (clsql-sys:update-record-from-slot emp 'height)
+ (clsql:select [height] :from [employee] :where [= [emplid] 1])))))
+ ((nil))
+ ((42.0d0))
+ ((24.13d0)))
+
+(deftest :oodml/update-records/11
+ (with-dataset *ds-artists*
+ (clsql:update-records-from-instance artist1)
+ (list (name artist1) (artist_id artist1)))
+ ("Mogwai" 1))
+
+(deftest :oodml/update-records/12
+ (with-dataset *ds-artists*
+ (clsql:update-records-from-instance artist1)
+ (list (name artist1) (genre artist1)))
+ ("Mogwai" "Unknown"))
;; tests update-instance-from-records
(deftest :oodml/update-instance/1
(format out "~a ~a ~a ~a"
(slot-value theme2 'theme-id)
(slot-value theme2 'title)
- (slot-value theme2 'vars)
+ (or (slot-value theme2 'vars) "NIL")
(slot-value theme2 'doc)))
(progn
(clsql:update-records [node] :av-pairs '(([title] "Altered title"))
(progn
(clsql:update-records [node]
:av-pairs '(([title] "altered title"))
- :where [= [node-id] 9])
+ :where [= [node-id] (node-id loc2)])
(clsql:update-slot-from-record loc2 'title)
(print-loc loc2))
(progn
(clsql:update-records [subloc]
:av-pairs '(([loc] "altered loc"))
- :where [= [subloc-id] 11])
+ :where [= [subloc-id] (subloc-id subloc2)])
(clsql:update-slot-from-record subloc2 'loc)
(print-subloc subloc2)))))
"9: location-2" "11: second subloc"
(deftest :oodml/cache/1
(with-dataset *ds-employees*
- (progn
+ (let ((*default-caching* t))
(setf (clsql-sys:record-caches *default-database*) nil)
(let ((employees (select 'employee)))
(every #'(lambda (a b) (eq a b))
(deftest :oodml/cache/2
(with-dataset *ds-employees*
- (let ((employees (select 'employee)))
+ (let* ((*default-caching* t)
+ (employees (select 'employee)))
(equal employees (select 'employee :flatp t))))
nil)
(deftest :oodml/refresh/1
(with-dataset *ds-employees*
- (let ((addresses (select 'address)))
+ (let* ((clsql-sys:*default-caching* t)
+ (addresses (select 'address)))
(equal addresses (select 'address :refresh t))))
t)
(deftest :oodml/refresh/2
(with-dataset *ds-employees*
- (let* ((addresses (select 'address :order-by [addressid] :flatp t :refresh t))
+ (let* ((clsql-sys:*default-caching* t)
+ (addresses (select 'address :order-by [addressid] :flatp t :refresh t))
(city (slot-value (car addresses) 'city)))
(clsql:update-records [addr]
:av-pairs '((city_field "A new city"))
(deftest :oodml/refresh/3
(with-dataset *ds-employees*
- (let* ((addresses (select 'address :order-by [addressid] :flatp t)))
+ (let* ((clsql-sys:*default-caching* t)
+ (addresses (select 'address :order-by [addressid] :flatp t)))
(values
(equal addresses (select 'address :refresh t :flatp t))
(equal addresses (select 'address :flatp t)))))
(deftest :oodml/refresh/4
(with-dataset *ds-employees*
- (let* ((addresses (select 'address :order-by [addressid] :flatp t :refresh t))
+ (let* ((clsql-sys:*default-caching* t)
+ (addresses (select 'address :order-by [addressid] :flatp t :refresh t))
(*db-auto-sync* t))
(make-instance 'address :addressid 1000 :city "A new address city")
(let ((new-addresses (select 'address :order-by [addressid] :flatp t :refresh t)))
- (delete-records :from [addr] :where [= [addressid] 1000])
(values
(length addresses)
(length new-addresses)
(eq (first addresses) (first new-addresses))
(eq (second addresses) (second new-addresses))))))
- 2 3 t t)
+ 3 4 t t)
-(deftest :oodml/uoj/1
+(deftest :oodml/uoj/full-set
(with-dataset *ds-employees*
(progn
- (let* ((dea-list (select 'deferred-employee-address :caching nil :order-by ["ea_join" aaddressid]
- :flatp t))
+ (let* ((dea-list (select 'deferred-employee-address
+ :caching nil :order-by ["ea_join" aaddressid]
+ :flatp t))
(dea-list-copy (copy-seq dea-list))
(initially-unbound (every #'(lambda (dea) (not (slot-boundp dea 'address))) dea-list)))
- (update-objects-joins dea-list)
+ (update-objects-joins dea-list :slots 'address :max-len nil)
(values
initially-unbound
(equal dea-list dea-list-copy)
(every #'(lambda (dea) (slot-boundp dea 'address)) dea-list)
(every #'(lambda (dea) (typep (slot-value dea 'address) 'address)) dea-list)
(mapcar #'(lambda (dea) (slot-value (slot-value dea 'address) 'addressid)) dea-list)))))
- t t t t (1 1 2 2 2))
+ t t t t (1 1 2 2 2 3))
+
+(deftest :oodml/uoj/batched
+ (with-dataset *ds-employees*
+ (progn
+ (let* ((dea-list (select 'deferred-employee-address
+ :caching nil :order-by ["ea_join" aaddressid]
+ :flatp t))
+ (dea-list-copy (copy-seq dea-list))
+ (initially-unbound (every #'(lambda (dea) (not (slot-boundp dea 'address))) dea-list)))
+ (update-objects-joins dea-list :slots 'address :max-len 2)
+ (values
+ initially-unbound
+ (equal dea-list dea-list-copy)
+ (every #'(lambda (dea) (slot-boundp dea 'address)) dea-list)
+ (every #'(lambda (dea) (typep (slot-value dea 'address) 'address)) dea-list)
+ (mapcar #'(lambda (dea) (slot-value (slot-value dea 'address) 'addressid)) dea-list)))))
+ t t t t (1 1 2 2 2 3))
;; update-object-joins needs to be fixed for multiple keys
#+ignore
-(deftest :oodml/uoj/2
+(deftest :oodml/uoj/multi-key
(progn
(clsql:update-objects-joins (list company1))
(mapcar #'(lambda (e)
(values
(let ((inst (make-instance 'theme
:title "test-theme" :vars "test-vars"
- :doc "test-doc")))
+ :doc "test-doc"))
+ (*print-circle* nil))
(setf (slot-value inst 'title) "alternate-test-theme")
(format nil "~a ~a ~a ~a"
- (select [title] :from [node]
- :where [= [title] "test-theme"]
- :flatp t :field-names nil)
- (select [vars] :from [setting]
- :where [= [vars] "test-vars"]
- :flatp t :field-names nil)
- (select [doc] :from [theme]
- :where [= [doc] "test-doc"]
- :flatp t :field-names nil)
- (select [title] :from [node]
- :where [= [title] "alternate-test-theme"]
- :flatp t :field-names nil)))
+ (or (select [title] :from [node]
+ :where [= [title] "test-theme"]
+ :flatp t :field-names nil) "NIL")
+ (or (select [vars] :from [setting]
+ :where [= [vars] "test-vars"]
+ :flatp t :field-names nil) "NIL")
+ (or (select [doc] :from [theme]
+ :where [= [doc] "test-doc"]
+ :flatp t :field-names nil) "NIL")
+ (or (select [title] :from [node]
+ :where [= [title] "alternate-test-theme"]
+ :flatp t :field-names nil) "NIL")))
(let* ((*db-auto-sync* t)
(inst (make-instance 'theme
:title "test-theme" :vars "test-vars"
(setf (slot-value inst 'title) "alternate-test-theme")
(prog1
(format nil "~a ~a ~a ~a"
- (select [title] :from [node]
- :where [= [title] "test-theme"]
- :flatp t :field-names nil)
- (select [vars] :from [setting]
- :where [= [vars] "test-vars"]
- :flatp t :field-names nil)
- (select [doc] :from [theme]
- :where [= [doc] "test-doc"]
- :flatp t :field-names nil)
- (select [title] :from [node]
- :where [= [title] "alternate-test-theme"]
- :flatp t :field-names nil))
+ (or (select [title] :from [node]
+ :where [= [title] "test-theme"]
+ :flatp t :field-names nil) "NIL")
+ (or (select [vars] :from [setting]
+ :where [= [vars] "test-vars"]
+ :flatp t :field-names nil) "NIL")
+ (or (select [doc] :from [theme]
+ :where [= [doc] "test-doc"]
+ :flatp t :field-names nil) "NIL")
+ (or (select [title] :from [node]
+ :where [= [title] "alternate-test-theme"]
+ :flatp t :field-names nil) "NIL"))
(delete-records :from [node] :where [= [title] "alternate-test-theme"])
(delete-records :from [setting] :where [= [vars] "test-vars"])
(delete-records :from [theme] :where [= [doc] "test-doc"])))))
))
-
-#.(clsql:restore-sql-reader-syntax-state)