X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=tests%2Ftest-ooddl.lisp;h=d7a193385edd1944539cc4e00182e24de9e5f6b0;hb=a244caf265fff60cc9d00083e15951762dd7f1ca;hp=feb827ba707243859e5e046a6122026d69f8279e;hpb=23b76563b25a517ad20f29d6dc5a65c8b958a042;p=clsql.git diff --git a/tests/test-ooddl.lisp b/tests/test-ooddl.lisp index feb827b..d7a1933 100644 --- a/tests/test-ooddl.lisp +++ b/tests/test-ooddl.lisp @@ -22,10 +22,10 @@ (setq *rt-ooddl* '( - + ;; Ensure slots inherited from standard-classes are :virtual (deftest :ooddl/metaclass/1 - (values + (values (clsql-sys::view-class-slot-db-kind (clsql-sys::slotdef-for-slot-with-class 'extraterrestrial (find-class 'person))) @@ -42,15 +42,39 @@ (every #'(lambda (slotd) (typep slotd 'clsql-sys::view-class-effective-slot-definition)) (clsql-sys::class-slots (find-class 'employee))) + (every #'(lambda (slotd) + (typep slotd 'clsql-sys::view-class-effective-slot-definition)) + (clsql-sys::class-slots (find-class 'setting))) + (every #'(lambda (slotd) + (typep slotd 'clsql-sys::view-class-effective-slot-definition)) + (clsql-sys::class-slots (find-class 'theme))) + (every #'(lambda (slotd) + (typep slotd 'clsql-sys::view-class-effective-slot-definition)) + (clsql-sys::class-slots (find-class 'node))) (every #'(lambda (slotd) (typep slotd 'clsql-sys::view-class-effective-slot-definition)) (clsql-sys::class-slots (find-class 'company)))) - t t t) + t t t t t t) + +;; Ensure classes are correctly marked normalised or not, default not +;(deftest :ooddl/metaclass/3 +; (values +; (clsql-sys::normalisedp derivednode1) +; (clsql-sys::normalisedp basenode) +; (clsql-sys::normalisedp company1) +; (clsql-sys::normalisedp employee3) +; (clsql-sys::normalisedp derivednode-sc-2)) +; t nil nil nil t) + +;(deftest :ooddl/metaclass/3 +; (values +; (normalisedp (find-class 'baseclass)) +; (normalisedp (find-class 'normderivedclass))) +; nil t) (deftest :ooddl/join/1 - (mapcar #'(lambda (e) - (slot-value e 'companyid)) - (company-employees company1)) + (mapcar #'(lambda (e) (slot-value e 'ecompanyid)) + (company-employees company1)) (1 1 1 1 1 1 1 1 1 1)) (deftest :ooddl/join/2 @@ -62,32 +86,46 @@ "Lenin") (deftest :ooddl/time/1 - (let* ((now (clsql-base:get-time))) + (let* ((now (clsql:get-time))) (when (member *test-database-underlying-type* '(:postgresql :postgresql-socket)) (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)))) + (clsql:time= (slot-value dbobj 'birthday) now)))) "Lenin" t) (deftest :ooddl/time/2 - (let* ((now (clsql-base:get-time)) + (let* ((now (clsql:get-time)) (fail-index -1)) (when (member *test-database-underlying-type* '(:postgresql :postgresql-socket)) (clsql:execute-command "set datestyle to 'iso'")) (dotimes (x 40) (clsql:update-records [employee] :av-pairs `((birthday ,now)) :where [= [emplid] 1]) - (let ((dbobj (car (clsql:select 'employee :where [= [birthday] now])))) - (unless (clsql-base:time= (slot-value dbobj 'birthday) now) + (let ((dbobj (car (clsql:select 'employee :where [= [birthday] now] + :flatp t)))) + (unless (clsql:time= (slot-value dbobj 'birthday) now) (setf fail-index x)) - (setf now (clsql-base:roll now :day (* 10 x))))) + (setf now (clsql:roll now :day (* 10 x))))) fail-index) -1) +(deftest :ooddl/time/3 + (progn + (when (member *test-database-underlying-type* '(:postgresql :postgresql-socket)) + (clsql:execute-command "set datestyle to 'iso'")) + (let ((dbobj (car (clsql:select 'employee :where [= [emplid] 10] + :flatp t)))) + (list + (eql *test-start-utime* (slot-value dbobj 'bd-utime)) + (clsql:time= (slot-value dbobj 'birthday) + (clsql:utime->time (slot-value dbobj 'bd-utime)))))) + (t t)) + )) #.(clsql:restore-sql-reader-syntax-state)