1 ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
2 ;;;; *************************************************************************
3 ;;;; FILE IDENTIFICATION
5 ;;;; Name: test-ooddl.lisp
6 ;;;; Purpose: Tests for the CLSQL Object Oriented Data Definition Language
7 ;;;; Authors: Marcus Pearce and Kevin M. Rosenberg
8 ;;;; Created: March 2004
10 ;;;; This file is part of CLSQL.
12 ;;;; CLSQL users are granted the rights to distribute and use this software
13 ;;;; as governed by the terms of the Lisp Lesser GNU Public License
14 ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
15 ;;;; *************************************************************************
18 (in-package #:clsql-tests)
20 (clsql-sys:file-enable-sql-reader-syntax)
23 (def-view-class big ()
24 ((i :type integer :initarg :i)
25 (bi :type bigint :initarg :bi)))
29 (clsql-sys:create-view-from-class 'big)
30 (let ((max (expt 2 60)))
32 (update-records-from-instance
33 (make-instance 'big :i (1+ i) :bi (truncate max (1+ i))))))))
35 (lambda () (clsql-sys:drop-view-from-class 'big))))
40 ;; Ensure slots inherited from standard-classes are :virtual
41 (deftest :ooddl/metaclass/1
43 (clsql-sys::view-class-slot-db-kind
44 (clsql-sys::slotdef-for-slot-with-class 'extraterrestrial
45 (find-class 'person)))
46 (clsql-sys::view-class-slot-db-kind
47 (clsql-sys::slotdef-for-slot-with-class 'hobby (find-class 'person))))
50 ;; Ensure all slots in view-class are view-class-effective-slot-definition
51 (deftest :ooddl/metaclass/2
53 (every #'(lambda (slotd)
54 (typep slotd 'clsql-sys::view-class-effective-slot-definition))
55 (clsql-sys::class-slots (find-class 'person)))
56 (every #'(lambda (slotd)
57 (typep slotd 'clsql-sys::view-class-effective-slot-definition))
58 (clsql-sys::class-slots (find-class 'employee)))
59 (every #'(lambda (slotd)
60 (typep slotd 'clsql-sys::view-class-effective-slot-definition))
61 (clsql-sys::class-slots (find-class 'setting)))
62 (every #'(lambda (slotd)
63 (typep slotd 'clsql-sys::view-class-effective-slot-definition))
64 (clsql-sys::class-slots (find-class 'theme)))
65 (every #'(lambda (slotd)
66 (typep slotd 'clsql-sys::view-class-effective-slot-definition))
67 (clsql-sys::class-slots (find-class 'node)))
68 (every #'(lambda (slotd)
69 (typep slotd 'clsql-sys::view-class-effective-slot-definition))
70 (clsql-sys::class-slots (find-class 'company))))
73 ;; Ensure classes are correctly marked normalized or not, default not
74 ;(deftest :ooddl/metaclass/3
76 ; (clsql-sys::normalizedp derivednode1)
77 ; (clsql-sys::normalizedp basenode)
78 ; (clsql-sys::normalizedp company1)
79 ; (clsql-sys::normalizedp employee3)
80 ; (clsql-sys::normalizedp derivednode-sc-2))
83 ;(deftest :ooddl/metaclass/3
85 ; (normalizedp (find-class 'baseclass))
86 ; (normalizedp (find-class 'normderivedclass)))
89 (deftest :ooddl/join/1
90 (with-dataset *ds-employees*
91 (mapcar #'(lambda (e) (slot-value e 'ecompanyid))
92 (company-employees company1)))
93 (1 1 1 1 1 1 1 1 1 1))
95 (deftest :ooddl/join/2
96 (with-dataset *ds-employees*
97 (slot-value (president company1) 'last-name))
100 (deftest :ooddl/join/3
101 (with-dataset *ds-employees*
102 (slot-value (employee-manager employee2) 'last-name))
105 (deftest :ooddl/big/1
106 ;;tests that we can create-view-from-class with a bigint slot,
107 ;; and stick a value in there.
108 (progn (clsql-sys:create-view-from-class 'big)
110 (clsql:table-exists-p [big] )
112 (clsql:drop-table [big] :if-does-not-exist :ignore)
113 (clsql:table-exists-p [big] )))
117 (deftest :ooddl/big/2
118 (with-dataset *ds-big*
119 (let ((rows (clsql:select [*] :from [big] :order-by [i] :field-names nil)))
124 (rest rows (cdr rest)))
125 ((= i (length rows)) t)
127 (int (first (car rest)))
128 (bigint (second (car rest))))
129 (when (and (or (eq *test-database-type* :oracle)
130 (and (eq *test-database-type* :odbc)
131 (eq *test-database-underlying-type* :postgresql)))
133 (setf bigint (parse-integer bigint)))
134 (unless (and (eql int index)
135 (eql bigint (truncate max index)))
139 (deftest :ooddl/time/1
140 (with-dataset *ds-employees*
141 (sleep 1) ;force birthdays into the past
142 (let* ((now (clsql:get-time)))
143 (when (member *test-database-underlying-type* '(:postgresql :postgresql-socket))
144 (clsql:execute-command "set datestyle to 'iso'"))
145 (clsql:update-records [employee] :av-pairs `((birthday ,now))
146 :where [= [emplid] 1])
147 (let ((dbobj (car (clsql:select 'employee :where [= [birthday] now]
150 (slot-value dbobj 'last-name)
151 (clsql:time= (slot-value dbobj 'birthday) now)))))
154 (deftest :ooddl/time/2
155 (with-dataset *ds-employees*
156 (sleep 1) ;force birthdays into the past
157 (let* ((now (clsql:get-time))
159 (when (member *test-database-underlying-type* '(:postgresql :postgresql-socket))
160 (clsql:execute-command "set datestyle to 'iso'"))
162 (clsql:update-records [employee] :av-pairs `((birthday ,now))
163 :where [= [emplid] 1])
164 (let ((dbobj (car (clsql:select 'employee :where [= [birthday] now]
166 (unless (clsql:time= (slot-value dbobj 'birthday) now)
168 (setf now (clsql:roll now :day (* 10 x)))))
172 (deftest :ooddl/time/3
173 (with-dataset *ds-employees*
175 (when (member *test-database-underlying-type* '(:postgresql :postgresql-socket))
176 (clsql:execute-command "set datestyle to 'iso'"))
177 (let ((dbobj (car (clsql:select 'employee :where [= [emplid] 10]
180 (eql *test-start-utime* (slot-value dbobj 'bd-utime))
181 (clsql:time= (slot-value dbobj 'birthday)
182 (clsql:utime->time (slot-value dbobj 'bd-utime)))))))