X-Git-Url: http://git.kpe.io/?p=clsql.git;a=blobdiff_plain;f=tests%2Ftest-ooddl.lisp;h=0339179ba145f977e4f817d51acab6af273f80bb;hp=aed77007778a70765aa5db92f7d2a84fb8acf4de;hb=8a8ee2d7d791b7a3efaed06420802a925d16fca3;hpb=7f0e4a65d1b425f2fa58fc7cce8296c1a6c52c2f diff --git a/tests/test-ooddl.lisp b/tests/test-ooddl.lisp index aed7700..0339179 100644 --- a/tests/test-ooddl.lisp +++ b/tests/test-ooddl.lisp @@ -3,50 +3,53 @@ ;;;; File: test-ooddl.lisp ;;;; Author: Marcus Pearce ;;;; Created: 30/03/2004 -;;;; Updated: <04/04/2004 11:52:11 marcusp> -;;;; ====================================================================== -;;;; -;;;; Description ========================================================== -;;;; ====================================================================== +;;;; Updated: $Id$ ;;;; -;;;; Tests for the CLSQL-USQL Object Oriented Data Definition Language +;;;; Tests for the CLSQL Object Oriented Data Definition Language ;;;; (OODDL). ;;;; +;;;; This file is part of CLSQL. +;;;; +;;;; CLSQL users are granted the rights to distribute and use this software +;;;; as governed by the terms of the Lisp Lesser GNU Public License +;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL. ;;;; ====================================================================== -(in-package :clsql-usql-tests) +(in-package #:clsql-tests) -#.(usql:locally-enable-sql-reader-syntax) +#.(clsql:locally-enable-sql-reader-syntax) +(setq *rt-ooddl* + '( + ;; Ensure slots inherited from standard-classes are :virtual (deftest :ooddl/metaclass/1 (values - (usql-sys::view-class-slot-db-kind - (usql-sys::slotdef-for-slot-with-class 'extraterrestrial + (clsql-sys::view-class-slot-db-kind + (clsql-sys::slotdef-for-slot-with-class 'extraterrestrial (find-class 'person))) - (usql-sys::view-class-slot-db-kind - (usql-sys::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 'usql-sys::view-class-effective-slot-definition)) - (usql-sys::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 'usql-sys::view-class-effective-slot-definition)) - (usql-sys::class-slots (find-class 'employee))) + (typep slotd 'clsql-sys::view-class-effective-slot-definition)) + (clsql-sys::class-slots (find-class 'employee))) (every #'(lambda (slotd) - (typep slotd 'usql-sys::view-class-effective-slot-definition)) - (usql-sys::class-slots (find-class 'company)))) + (typep slotd 'clsql-sys::view-class-effective-slot-definition)) + (clsql-sys::class-slots (find-class 'company)))) t t 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 @@ -58,30 +61,35 @@ "Lenin") (deftest :ooddl/time/1 - (let* ((now (clsql-base:get-time))) - (when (member *test-database-type* '(:postgresql :postgresql-socket)) - (usql:execute-command "set datestyle to 'iso'")) - (usql:update-records [employee] :av-pairs `((birthday ,now)) + (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 (usql: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-type* '(:postgresql :postgresql-socket)) - (usql:execute-command "set datestyle to 'iso'")) + (when (member *test-database-underlying-type* '(:postgresql :postgresql-socket)) + (clsql:execute-command "set datestyle to 'iso'")) (dotimes (x 40) - (usql:update-records [employee] :av-pairs `((birthday ,now)) + (clsql:update-records [employee] :av-pairs `((birthday ,now)) :where [= [emplid] 1]) - (let ((dbobj (car (usql: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) -#.(usql:restore-sql-reader-syntax-state) +)) + +#.(clsql:restore-sql-reader-syntax-state) +