X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=tests%2Ftest-ooddl.lisp;h=7aec9817a03135f103a197e1a2b2420f472d4a58;hb=0e06463bcfc9e4f9d1eec15b7746eb7f07cf2f2b;hp=48d1630fd6a815acb8636d491f2e390170c2cafd;hpb=8972490fe6f9453c5b70dae4fb1141cf9a67f0db;p=clsql.git diff --git a/tests/test-ooddl.lisp b/tests/test-ooddl.lisp index 48d1630..7aec981 100644 --- a/tests/test-ooddl.lisp +++ b/tests/test-ooddl.lisp @@ -22,30 +22,55 @@ (setq *rt-ooddl* '( - + ;; Ensure slots inherited from standard-classes are :virtual (deftest :ooddl/metaclass/1 - (values - (clsql::view-class-slot-db-kind - (clsql::slotdef-for-slot-with-class 'extraterrestrial + (values + (clsql-sys::view-class-slot-db-kind + (clsql-sys::slotdef-for-slot-with-class 'extraterrestrial (find-class 'person))) - (clsql::view-class-slot-db-kind - (clsql::slotdef-for-slot-with-class 'hobby (find-class 'person)))) + (clsql-sys::view-class-slot-db-kind + (clsql-sys::slotdef-for-slot-with-class 'hobby (find-class 'person)))) :virtual :virtual) ;; Ensure all slots in view-class are view-class-effective-slot-definition (deftest :ooddl/metaclass/2 (values (every #'(lambda (slotd) - (typep slotd 'clsql::view-class-effective-slot-definition)) - (clsql::class-slots (find-class 'person))) + (typep slotd 'clsql-sys::view-class-effective-slot-definition)) + (clsql-sys::class-slots (find-class 'person))) + (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::view-class-effective-slot-definition)) - (clsql::class-slots (find-class 'employee))) + (typep slotd 'clsql-sys::view-class-effective-slot-definition)) + (clsql-sys::class-slots (find-class 'setting))) (every #'(lambda (slotd) - (typep slotd 'clsql::view-class-effective-slot-definition)) - (clsql::class-slots (find-class 'company)))) - t t t) + (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) + +;; 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 'ecompanyid)) @@ -60,14 +85,35 @@ (slot-value (employee-manager employee2) 'last-name) "Lenin") +(deftest :ooddl/big/1 + (let ((rows (clsql:select [*] :from [big] :order-by [i] :field-names nil))) + (values + (length rows) + (do ((i 0 (1+ i)) + (max (expt 2 60)) + (rest rows (cdr rest))) + ((= i (length rows)) t) + (let ((index (1+ i)) + (int (first (car rest))) + (bigint (second (car rest)))) + (when (and (or (eq *test-database-type* :oracle) + (and (eq *test-database-type* :odbc) + (eq *test-database-underlying-type* :postgresql))) + (stringp bigint)) + (setf bigint (parse-integer bigint))) + (unless (and (eql int index) + (eql bigint (truncate max index))) + (return nil)))))) + 555 t) + (deftest :ooddl/time/1 (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] - :flatp t)))) + (let ((dbobj (car (clsql:select 'employee :where [= [birthday] now] + :flatp t)))) (values (slot-value dbobj 'last-name) (clsql:time= (slot-value dbobj 'birthday) now)))) @@ -82,13 +128,25 @@ (clsql:update-records [employee] :av-pairs `((birthday ,now)) :where [= [emplid] 1]) (let ((dbobj (car (clsql:select 'employee :where [= [birthday] now] - :flatp t)))) + :flatp t)))) (unless (clsql:time= (slot-value dbobj 'birthday) now) (setf fail-index 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)